From: acondolu Date: Wed, 30 May 2018 13:29:30 +0000 (+0200) Subject: Added check with purification to andrea.ml X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=c5231b43a7f3f6c4b8f4d449cbae210a528c3e86;p=fireball-separation.git Added check with purification to andrea.ml Note! It now diverges because it uses B (bottoms) --- diff --git a/ocaml/andrea.ml b/ocaml/andrea.ml index 8535988..7493905 100644 --- a/ocaml/andrea.ml +++ b/ocaml/andrea.ml @@ -4,6 +4,8 @@ let rec fold_nat f x n = if n = 0 then x else f (fold_nat f x (n-1)) n ;; let print_hline = Console.print_hline;; +open Pure + type var = int;; type t = | V of var @@ -145,6 +147,24 @@ let get_subterm_with_head_and_args hd_var n_args = in aux 0 ;; +let rec purify = function + | L t -> Pure.L (purify t) + | A (t1,t2) -> Pure.A (purify t1, purify t2) + | V n -> Pure.V n + | B -> Pure.B +;; + +let check p sigma = + let div = purify p.div in + let conv = purify p.conv in + let sigma = List.map (fun (v,t) -> v, purify t) sigma in + let freshno = List.fold_right (fun (x,_) -> max x) sigma 0 in + let env = Pure.env_of_sigma freshno sigma in + assert (Pure.diverged (Pure.mwhd (env,div,[]))); + assert (not (Pure.diverged (Pure.mwhd (env,conv,[])))); + () +;; + let sanity p = print_endline (string_of_problem p); (* non cancellare *) if p.conv = B then problem_fail p "p.conv diverged"; @@ -252,7 +272,7 @@ let rec auto p = let hd_var, n_args = get_inert p.div in match get_subterm_with_head_and_args hd_var n_args p.conv with | None -> - (try problem_fail (eat p) "Auto did not complete the problem" with Done _ -> ()) + (try problem_fail (eat p) "Auto did not complete the problem" with Done sigma -> sigma) | Some t -> let j = find_eta_difference p t n_args - 1 in let k = 1 + max @@ -291,7 +311,11 @@ let rec conv_join = function | x::xs -> conv_join xs ^ " ("^ x ^")" ;; -let auto' a b = auto (problem_of a (conv_join b));; +let auto' a b = + let p = problem_of a (conv_join b) in + let sigma = auto p in + check p sigma +;; (* Example usage of exec, interactive: