type value = [ `NodeSet of Automaton.BST.t
| `Int of int | `String of string
| `Bool of bool | `True | `False ]
+
type expr = [ value | `Call of (string*(expr list))
- | `Auto of Automaton.t ]
+ | `Auto of Automaton.t | `Contains of expr list ]
let count = function [`NodeSet(s) ] -> `Int(Automaton.BST.cardinal s)
| _ -> failwith "count"
-
+ let contains_old = function [`NodeSet(s) ; `String(str) ] ->
+ `Bool(Automaton.BST.exists (fun tree -> Tree.Binary.contains_old tree str
+ ) s)
+ | _ -> failwith "contains_old"
+
let equal = function [ `Int i; `Int j ] -> `Bool (i == j)
|_ -> failwith "equal"
("count",count);
("equal",equal);
+ ("contains_old",contains_old);
]
let text t = Tree.Binary.string (Tree.Binary.left t)
let rec eval_expr tree (e:expr) : value = match e with
| `Call (f,args) -> (List.assoc f globals) (List.map (eval_expr tree) args)
- | `Auto(a) -> `NodeSet(ignore (Automaton.dump Format.err_formatter a;
- Tree.Binary.print_xml_fast stderr tree;
- Printf.eprintf "\n=======================\n%!";
- Automaton.TopDown.run a tree);
- Printf.eprintf "Results : %i\n%!"
- (Automaton.BST.cardinal a.Automaton.result);
- Automaton.BST.iter (fun t -> Tree.Binary.print_xml_fast stderr t;
- Printf.eprintf "^^^^^^^^^^^^^^^^^^^^^^^^\n%!")
- a.Automaton.result;
- a.Automaton.result)
+ | `Auto(a) -> `NodeSet(ignore (Automaton.BottomUp.accept a tree);
+ a.Automaton.result)
+ | `Contains(args) ->
+ begin
+ match args with
+ [ `Auto(a); `String(s) ] ->
+ let docs = Tree.Binary.contains tree s
+ in
+ let _ = Automaton.BottomUp.accept ~strings:(Some docs) a tree
+ in `NodeSet(a.Automaton.result)
+ | _ -> failwith "contains invalid"
+ end
| #value as x -> x
let truth_value =
| Expr e -> match compile_expr e with
| `True -> `Label (TagSet.Xml.any)
| `False -> `Label (TagSet.Xml.empty)
- | e -> `Fun (fun t -> let r = Functions.truth_value (Functions.eval_expr t e)
- in Printf.eprintf "Truth value is %b\n%!" r;r)
+ | e -> `Fun (fun t -> Functions.truth_value (Functions.eval_expr t e))
in match pred_rec p with
`Fun f -> mk_pred_trs f tkeep tchange
| Path p -> `Auto(compile p)
| Int i -> `Int i
| String s -> `String s
+ | Function ("contains",elist) ->`Contains(List.map compile_expr elist)
| Function (f,elist) -> `Call(f,List.map compile_expr elist)
and cup a b = match a,b with