From 640e7671fac6bebe8debe37dba052018c3b4c76f Mon Sep 17 00:00:00 2001 From: acondolu Date: Thu, 7 Jun 2018 10:02:19 +0200 Subject: [PATCH] Removed B and C from t, stepped from problem --- ocaml/simple.ml | 38 +++++++++----------------------------- 1 file changed, 9 insertions(+), 29 deletions(-) diff --git a/ocaml/simple.ml b/ocaml/simple.ml index e5e829a..154992d 100644 --- a/ocaml/simple.ml +++ b/ocaml/simple.ml @@ -11,8 +11,6 @@ type t = | V of var | A of t * t | L of t - | B (* bottom *) - | C of int ;; let delta = L(A(V 0, V 0));; @@ -23,7 +21,6 @@ let eta_eq' = | L t1, t2 -> aux l1 (l2+1) t1 t2 | t1, L t2 -> aux (l1+1) l2 t1 t2 | V a, V b -> a + l1 = b + l2 - | C a, C b -> a = b | A(t1,t2), A(u1,u2) -> aux l1 l2 t1 u1 && aux l1 l2 t2 u2 | _, _ -> false in aux ;; @@ -49,10 +46,8 @@ let string_of_t = let rec string_of_term_w_pars level = function | V v -> if v >= level then "`" ^ string_of_int (v-level) else string_of_bvar (level - v-1) - | C n -> "c" ^ string_of_int n | A _ | L _ as t -> "(" ^ string_of_term_no_pars level t ^ ")" - | B -> "BOT" and string_of_term_no_pars_app level = function | A(t1,t2) -> string_of_term_no_pars_app level t1 ^ " " ^ string_of_term_w_pars level t2 | _ as t -> string_of_term_w_pars level t @@ -68,19 +63,18 @@ type problem = { ; div : t ; conv : t ; sigma : (var * t) list (* substitutions *) - ; stepped : var list ; phase : [`One | `Two] (* :'( *) } let string_of_problem p = let lines = [ - "[stepped] " ^ String.concat " " (List.map string_of_int p.stepped); "[DV] " ^ string_of_t p.div; "[CV] " ^ string_of_t p.conv; ] in String.concat "\n" lines ;; +exception B;; exception Done of (var * t) list (* substitution *);; exception Fail of int * string;; @@ -98,8 +92,7 @@ let rec is_inert = function | A(t,_) -> is_inert t | V _ -> true - | C _ - | L _ | B -> false + | L _ -> false ;; let is_var = function V _ -> true | _ -> false;; @@ -117,7 +110,6 @@ let rec no_leading_lambdas v n = function | L t -> 1 + no_leading_lambdas (v+1) n t | A _ as t -> let v', m = get_inert t in if v = v' then max 0 (n - m) else 0 | V v' -> if v = v' then n else 0 - | B | C _ -> 0 ;; let rec subst level delift sub = @@ -128,11 +120,8 @@ let rec subst level delift sub = let t1 = subst level delift sub t1 in let t2 = subst level delift sub t2 in mk_app t1 t2 - | C _ as t -> t - | B -> B -and mk_app t1 t2 = if t2 = B || (t1 = delta && t2 = delta) then B +and mk_app t1 t2 = if t1 = delta && t2 = delta then raise B else match t1 with - | B -> B | L t1 -> subst 0 true (0, t2) t1 | _ -> A (t1, t2) and lift n = @@ -141,25 +130,21 @@ and lift n = | V m -> V (if m >= lev then m + n else m) | L t -> L (aux (lev+1) t) | A (t1, t2) -> A (aux lev t1, aux lev t2) - | C _ as t -> t - | B -> B in aux 0 ;; let subst = subst 0 false;; let subst_in_problem ((v, t) as sub) p = print_endline ("-- SUBST " ^ string_of_t (V v) ^ " |-> " ^ string_of_t t); - {p with - div=subst sub p.div; - conv=subst sub p.conv; - stepped=v::p.stepped; - sigma=sub::p.sigma} + let sigma = sub::p.sigma in + let div = try subst sub p.div with B -> raise (Done sigma) in + let conv = try subst sub p.conv with B -> raise (Fail(-1,"p.conv diverged")) in + {p with div; conv; sigma} ;; let get_subterm_with_head_and_args hd_var n_args = let rec aux lev = function - | C _ - | V _ | B -> None + | V _ -> None | L t -> aux (lev+1) t | A(t1,t2) as t -> let hd_var', n_args' = get_inert t1 in @@ -176,8 +161,6 @@ let rec purify = function | L t -> Pure.L (purify t) | A (t1,t2) -> Pure.A (purify t1, purify t2) | V n -> Pure.V n - | C _ -> Pure.V max_int (* FIXME *) - | B -> Pure.B ;; let check p sigma = @@ -196,8 +179,6 @@ let check p sigma = let sanity p = print_endline (string_of_problem p); (* non cancellare *) - if p.conv = B then problem_fail p "p.conv diverged"; - if p.div = B then raise (Done p.sigma); if p.phase = `Two && p.div = delta then raise (Done p.sigma); if not (is_inert p.div) then problem_fail p "p.div converged"; p @@ -244,7 +225,6 @@ let compute_max_lambdas_at hd_var j = else id) (max (aux hd t1) (aux hd t2)) | L t -> aux (hd+1) t | V _ -> 0 - | _ -> assert false in aux hd_var ;; @@ -332,7 +312,7 @@ let problem_of (label, div, convs, ps, var_names) = | Some div -> aux (div :> Num.nf) | None -> assert false in let varno = List.length var_names in - let p = {orig_freshno=varno; freshno=1+varno; div; conv; sigma=[]; stepped=[]; phase=`One} in + let p = {orig_freshno=varno; freshno=1+varno; div; conv; sigma=[]; phase=`One} in (* initial sanity check *) sanity p ;; -- 2.39.2