X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=ocaml%2Flambda4.ml;h=83c1b1dab20be45651ca6ead3406f005f173c7b9;hb=b8b634b6e8907bb7c5e1a228ec173fab2b7b6546;hp=c6cecec5c0c064f972071344d4c6381559a4b120;hpb=417e6bbe7973c9413216a87dff01f920d39e4657;p=fireball-separation.git diff --git a/ocaml/lambda4.ml b/ocaml/lambda4.ml index c6cecec..83c1b1d 100644 --- a/ocaml/lambda4.ml +++ b/ocaml/lambda4.ml @@ -3,7 +3,7 @@ open Util.Vars open Pure open Num -let bomb = ref(`Var(-1,-666));; +let divergent = ref(`Var(-1, -666));; (* The number of arguments which can applied to numbers @@ -39,7 +39,7 @@ let label_of_problem {label} = label;; let string_of_var l x = try List.nth l x - with Failure "nth" -> "`" ^ string_of_int x + with Failure _ -> "`" ^ string_of_int x ;; let string_of_term p t = print ~l:p.var_names (t :> nf);; @@ -436,21 +436,8 @@ prerr_endline ("# INST_IN_EAT: " ^ string_of_var p.var_names hd ^ " := " ^ strin | Some div -> if List.mem (hd_of_i_var div) inedible then p - else - let n = match div with `I(_,args) -> Listx.length args | `Var _ -> 0 in - let p, bomb' = make_fresh_var p (-666) in - (if !bomb <> `Var (-1,-666) then - failwithProblem p - ("Bomb was duplicated! It was " ^ string_of_nf !bomb ^ - ", tried to change it to " ^ string_of_nf bomb')); - bomb := bomb'; - prerr_endline ("Just created bomb var: " ^ string_of_nf !bomb); - let x = hd_of_i_var div in - let inst = make_lams !bomb n in - let p = {p with div=None} in - (* subst_in_problem (hd_of_i_var div) inst p in *) - {p with sigma=p.sigma@[x,inst]} in - let dangerous_conv = showstoppers_conv in + else (divergent := `Var(hd_of_i_var div, -666); {p with div=None}) in + let dangerous_conv = showstoppers_conv in prerr_endline ("dangerous_conv lenght:" ^ string_of_int (List.length dangerous_conv)); List.iter (fun l -> prerr_endline (String.concat " " (List.map (string_of_var p.var_names) l))) dangerous_conv; let conv = @@ -486,8 +473,6 @@ List.iter (fun l -> prerr_endline (String.concat " " (List.map (string_of_var p. `Continue p let instantiate p x n = - (if hd_of_i_var (cast_to_i_var !bomb) = x - then failwithProblem p ("BOMB (" ^ string_of_nf !bomb ^ ") cannot be instantiated!")); let arity_of_x = max_arity_tms x (all_terms p) in (if arity_of_x = None then failwithProblem p "step on var non occurring in problem"); (if Util.option_get(arity_of_x) = min_int then failwithProblem p "step on fake variable"); @@ -647,21 +632,6 @@ let optimize_numerals p = replace_in_sigma (List.rev perm) p.sigma ;; -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 n = hd_of_i_var (cast_to_i_var !bomb) - then ([], Pure.omega should_explode, []) - else ([], Pure.V n, []) ) :: e - in aux 0 -;; (* ************************************************************************** *) type result = [ @@ -692,7 +662,6 @@ let solve p = match check p with | Some s -> `Unseparable s | None -> - bomb := `Var(-1,-666); Console.print_hline(); let p_finale = auto p p.initialSpecialK in let freshno,sigma = p_finale.freshno, p_finale.sigma in @@ -706,14 +675,14 @@ let solve p = (string_of_var p_finale.var_names x ^ " := " ^ string_of_term p_finale inst)) sigma; prerr_endline "------------------"; + ToScott.bomb := !divergent; let scott_of_nf t = ToScott.t_of_nf (t :> nf) in let div = option_map scott_of_nf p.div in let conv = List.map scott_of_nf p.conv in let ps = List.map scott_of_nf p.ps in let sigma' = List.map (fun (x,inst) -> x, scott_of_nf inst) sigma in - let e' = env_of_sigma freshno sigma' false in - let e'' = env_of_sigma freshno sigma' true in + let e' = Pure.env_of_sigma freshno sigma' in prerr_endline "-----------------"; (function @@ -725,7 +694,7 @@ let solve p = | None -> ()) div; List.iter (fun n -> verbose ("_::: " ^ (Pure.print n)); - let t = Pure.mwhd (e'',n,[]) in + let t = Pure.mwhd (e',n,[]) in verbose ("_:: " ^ (Pure.print t)); assert (not (Pure.diverged t)) ) conv ; @@ -750,3 +719,14 @@ let problem_of (label, div, conv, ps, var_names) = [ ref (Array.to_list (Array.init (List.length ps) (fun i -> i, dummy))) ] in {freshno; div; conv; ps; sigma=[]; deltas; initialSpecialK; var_names; label} ;; + +(* assert_depends solves the problem, and checks if the result was expected *) +let assert_depends x = + let c = String.sub (label_of_problem x) 0 1 in + match solve x with + | `Unseparable s when c = "!" -> + failwith ("assert_depends: unseparable because: " ^ s ^ ".") + | `Separable _ when c = "?" -> + failwith ("assert_depends: separable.") + | _ -> () in +Problems.main (assert_depends ++ problem_of);