let first args p var f =
- let rec aux = function
+ let rec aux k = function
| [] ->
raise (Backtrack ("no more alternatives for " ^ string_of_var p.var_names var))
- | i::is -> try
- f p i
+ | i::is as ii -> try
+ f p i k
with Backtrack s ->
prerr_endline (">>>>>> BACKTRACK (reason: " ^ s ^") measure=$ ");
-prerr_endline("Now trying var="^string_of_var p.var_names var^" i="^string_of_int (i+1));
- aux is
- in aux args
+(* prerr_endline("Now trying var="^string_of_var p.var_names var^" i="^string_of_int (i+1)); *)
+ if k = 0 then aux p.initialSpecialK is else aux (k-1) ii
+ in aux p.initialSpecialK args
let all_terms p = p.div :: p.conv ;;
let subst_in_problem x inst ({div; conv} as p) =
prerr_endline ("# INST0: " ^ string_of_var p.var_names x ^ " := " ^ string_of_term p inst);
- let aux t = match t with
- | #i_var as t -> t
- | `Lam _ | `Bottom | `Pacman -> assert false (* ??? *) in
- let div = (aux ++ (subst false false x inst)) (div :> nf) in
+ let div = subst false false x inst (div :> nf) in
let conv = List.map (subst false false x inst) (conv :> nf list) in
- let conv = List.filter (function `Lam _ -> false | _ -> true) conv in
- let conv = List.map aux conv in
- {p with div; conv}
+ let conv = Util.filter_map (function `Lam _ | `Pacman -> None | `Bottom -> raise (Backtrack "bottom in conv") | #i_var as t -> Some t) conv in
+ match div with
+ | `Lam _ | `Pacman | `Var _ -> raise (Backtrack "lam in div")
+ | `Bottom -> `Finished p
+ | `I _ as div -> `Continue {p with div; conv}
;;
exception Dangerous;;
List.fold_left (fun acc t -> Pervasives.min acc (aux t)) max_int tms
;; *)
-let instantiate p x perm =
- let n = (prerr_endline ("WARNING: using constant initialSpecialK=" ^ string_of_int p.initialSpecialK)); p.initialSpecialK in
+let instantiate p x perm n =
+ (* let n = (prerr_endline ("WARNING: using constant initialSpecialK=" ^ string_of_int p.initialSpecialK)); p.initialSpecialK in *)
let arities = Array.to_list (Array.make (n+1) min_int) in
let p,vars = make_fresh_vars p arities in
(* manual lifting of vars by perm in next line *)
if x = hd then
if Listx.length args' >= n then
(let diff = intersect args args' in
- if diff <> [] then raise (Difference diff));
+ raise (if diff = [] then Backtrack "div in conv" else Difference diff));
List.iter aux ((Listx.to_list args') :> nf list) in
try
List.iter aux (p.conv :> nf list) ;
let rec auto_eat p =
prerr_endline (string_of_problem "auto_eat" p);
- prerr_endline "{{{{{{{{ Computing measure before auto_instantiate }}}}}}";
+ (* prerr_endline "{{{{{{{{ Computing measure before auto_instantiate }}}}}}"; *)
match eat p with
| `Finished p -> prerr_endline "finished"; p
| `Continue (x,positions) ->
let m = problem_measure p in
- first positions p x (fun p j ->
- let p = instantiate p x j in
- prerr_endline "{{{{{{{{ Computing measure inafter auto_instantiate }}}}}}";
+ first positions p x (fun p j k ->
+ match instantiate p x j k with
+ `Continue p ->
+ (* prerr_endline "{{{{{{{{ Computing measure inafter auto_instantiate }}}}}}"; *)
let delta = problem_measure p - m in
if delta >= 0
then
(prerr_endline
("Measure did not decrease (+=" ^ string_of_int delta ^ ")"))
else prerr_endline ("$ Measure decreased: " ^ string_of_int delta);
- auto_eat p)
+ auto_eat p
+ | `Finished p -> p)
;;
(******************************************************************************)