-let env_of_sigma freshno sigma should_explode =
- let rec aux n =
- if n > freshno then
- []
- else
- let e = aux (n+1) in
- (try
- e,Pure.lift (-n-1) (snd (List.find (fun (i,_) -> i = n) sigma)),[]
- with
- Not_found ->
- if should_explode && n = hd_of_i_var (cast_to_i_var !bomb)
- then ([], (let f t = Pure.A(t,t) in f (Pure.L (f (Pure.V 0)))), [])
- else ([],Pure.V n,[]))::e
- in aux 0
-;;
-
-let solve p =
- bomb := `Var(-1,-666);
- if List.for_all (function `N _ -> true | _ -> false) p.ps && p.div = None
- then (prerr_endline "Initial problem is already completed, nothing to do")
- else (
- Console.print_hline();
- prerr_endline (string_of_problem "main" p);
- let p_finale = auto p p.initialSpecialK in
- let freshno,sigma = p_finale.freshno, p_finale.sigma in
- prerr_endline ("------- <DONE> ------ measure=. \n ");
- (* prerr_endline (string_of_problem "Original problem" p); *)
- (* prerr_endline "---------------------"; *)
- let l = Array.to_list (Array.init (freshno + 1) string_of_var) in
- (* prerr_endline "---------------------"; *)
- List.iter (fun (x,inst) -> prerr_endline (string_of_var x ^ " := " ^ print ~l inst)) sigma;
-(*
- prerr_endline "----------------------";
- let ps =
- List.fold_left (fun ps (x,inst) ->
- (* CSC: XXXX Is the subst always sorted correctly? Otherwise, implement a recursive subst *)
- (* In this non-recursive version, the intermediate states may containt Matchs *)
- List.map (fun t -> let t = subst false x inst (t :> nf) in cast_to_i_num_var t) ps)
- (p.ps :> i_num_var list) sigma in
- prerr_endline (string_of_problem {p with ps= List.map (function t -> cast_to_i_n_var t) ps; freshno});
- List.iteri (fun i (n,more_args) -> assert (more_args = 0 && n = `N i)) ps ;
-*)
- prerr_endline "---------<OPT>----------";
- let sigma = optimize_numerals p_finale in (* optimize numerals *)
- let l = Array.to_list (Array.init (freshno + 1) string_of_var) in
- List.iter (fun (x,inst) -> prerr_endline (string_of_var x ^ " := " ^ print ~l inst)) sigma;
-
- prerr_endline "---------<PURE>---------";
- let t_of_nf t = ToScott.t_of_nf (t :> nf) in
- let div = option_map t_of_nf p.div in
- let conv = List.map t_of_nf p.conv in
- let ps = List.map t_of_nf p.ps in
-
- let sigma' = List.map (fun (x,inst) -> x, ToScott.t_of_nf inst) sigma in
- let e' = env_of_sigma freshno sigma' false (* FIXME shoudl_explode *) in
-
-(*
- prerr_endline "---------<PPP>---------";
-let rec print_e e =
-"[" ^ String.concat ";" (List.map (fun (e,t,[]) -> print_e e ^ ":" ^ Pure.print t) e) ^ "]"
-in
- prerr_endline (print_e e);
- List.iter (fun (t,t_ok) ->
- prerr_endline ("T0= " ^ Pure.print t ^ "\nTM= " ^ Pure.print (Pure.unwind (e,t,[])) ^ "\nOM= " ^ Pure.print t_ok);
- (*assert (Pure.unwind (e,t,[]) = t_ok)*)
- ) (List.combine ps ps_ok);
-*)
- prerr_endline "--------<REDUCE>---------";
- let pure_bomb = ToScott.t_of_nf (!bomb) in (* Pure.B *)
- (function Some div ->
- print_endline (Pure.print div);
- let t = Pure.mwhd (e',div,[]) in
- prerr_endline ("*:: " ^ (Pure.print t));
- assert (t = pure_bomb)
- | None -> ()) div;
- List.iter (fun n ->
- verbose ("_::: " ^ (Pure.print n));
- let t = Pure.mwhd (e',n,[]) in
- verbose ("_:: " ^ (Pure.print t));
- assert (t <> pure_bomb)
- ) conv ;
- List.iteri (fun i n ->
- verbose ((string_of_int i) ^ "::: " ^ (Pure.print n));
- let t = Pure.mwhd (e',n,[]) in
- verbose ((string_of_int i) ^ ":: " ^ (Pure.print t));
- assert (t = Scott.mk_n i)
- ) ps ;
- prerr_endline "-------- </DONE> --------"
- )