X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fsrc%2Fautomath%2FautCrg.ml;h=bba3fc26578c50329d1685a8caac32549cb3b93c;hb=651d745df2454a9e232aff3c9d8bf3e77653936d;hp=66de6c3d3c2c8145c2e205a05221afe0bbef5231;hpb=fb6fee82bb9172e15b1a7bc7e20641627f593fcc;p=helm.git diff --git a/helm/software/lambda-delta/src/automath/autCrg.ml b/helm/software/lambda-delta/src/automath/autCrg.ml index 66de6c3d3..bba3fc265 100644 --- a/helm/software/lambda-delta/src/automath/autCrg.ml +++ b/helm/software/lambda-delta/src/automath/autCrg.ml @@ -44,12 +44,12 @@ let hcnt = K.create hcnt_size (* optimized context *) (* Internal functions *******************************************************) -let empty_cnt = [], [], [] +let empty_cnt = [], [] -let add_abst (a, ws, ns) id w n = - E.Name (id, true) :: a, w :: ws, N.succ n :: ns +let add_abst (a, ws) id w = + E.Name (id, true) :: a, w :: ws -let mk_lref f n i j k = f n (D.TLRef ([E.Apix k], i, j)) +let mk_lref f i j k = f (D.TLRef ([E.Apix k], i, j)) let id_of_name (id, _, _) = id @@ -82,7 +82,7 @@ let relax_opt_qid f st = function | Some qid -> let f qid = f (Some qid) in relax_qid f st qid let resolve_gref err f st qid = - try let n, cnt = K.find henv (uri_of_qid qid) in f n qid cnt + try let cnt = K.find henv (uri_of_qid qid) in f qid cnt with Not_found -> err qid let resolve_gref_relaxed f st qid = @@ -103,37 +103,32 @@ let get_cnt_relaxed f st = (****************************************************************************) -let push_abst f (lenv, ns) a n w = +let push_abst f lenv a w = let bw = D.Abst (N.infinite, [w]) in - let f lenv = f (lenv, N.succ n :: ns) in + let f lenv = f lenv in D.push_bind f lenv a bw -let resolve_lref err f id (lenv, ns) = - let f i j k = f (List.nth ns k) i j k in - D.resolve_lref err f id lenv - -let lenv_of_cnt (a, ws, ns) = - D.push_bind C.start D.empty_lenv a (D.Abst (N.infinite, ws)), ns +let lenv_of_cnt (a, ws) = + D.push_bind C.start D.empty_lenv a (D.Abst (N.infinite, ws)) (* this is not tail recursive in the GRef branch *) let rec xlate_term f st lenv = function | A.Sort s -> - let f h = f (N.finite 0) (D.TSort ([], h)) in + let f h = f (D.TSort ([], h)) in if s then f 0 else f 1 | A.Appl (v, t) -> - let f vv n tt = f n (D.TAppl ([], [vv], tt)) in - let f _ vv = xlate_term (f vv) st lenv t in + let f vv tt = f (D.TAppl ([], [vv], tt)) in + let f vv = xlate_term (f vv) st lenv t in xlate_term f st lenv v | A.Abst (name, w, t) -> - let f nw ww = + let f ww = let a = [E.Name (name, true)] in - let f nt tt = - let nnt = N.infinite (* if N.is_zero nt then N.infinite else nt *) in - let b = D.Abst (nnt, [ww]) in - f nt (D.TBind (a, b, tt)) + let f tt = + let b = D.Abst (N.infinite, [ww]) in + f (D.TBind (a, b, tt)) in let f lenv = xlate_term f st lenv t in - push_abst f lenv a nw ww + push_abst f lenv a ww in xlate_term f st lenv w | A.GRef (name, args) -> @@ -141,22 +136,20 @@ let rec xlate_term f st lenv = function | E.Name (id, _) -> f (A.GRef ((id, true, []), [])) | _ -> C.err () in - let map2 f t = - let f _ tt = f tt in xlate_term f st lenv t - in - let g n qid (a, _, _) = + let map2 f t = xlate_term f st lenv t in + let g qid (a, _) = let gref = D.TGRef ([], uri_of_qid qid) in match args, a with - | [], [] -> f n gref + | [], [] -> f gref | _ -> - let f args = f n (D.TAppl ([], args, gref)) in + let f args = f (D.TAppl ([], args, gref)) in let f args = C.list_rev_map f map2 args in let f a = C.list_rev_map_append f map1 a ~tail:args in C.list_sub_strict f a args in let g qid = resolve_gref_relaxed g st qid in let err () = complete_qid g st name in - resolve_lref err (mk_lref f) (id_of_name name) lenv + D.resolve_lref err (mk_lref f) (id_of_name name) lenv let xlate_entity err f st = function | A.Section (Some (_, name)) -> @@ -176,8 +169,8 @@ let xlate_entity err f st = function let f qid = let f cnt = let lenv = lenv_of_cnt cnt in - let f nw ww = - K.add hcnt (uri_of_qid qid) (add_abst cnt name ww nw); + let f ww = + K.add hcnt (uri_of_qid qid) (add_abst cnt name ww); err {st with node = Some qid} in xlate_term f st lenv w @@ -187,11 +180,11 @@ let xlate_entity err f st = function complete_qid f st (name, true, []) | A.Decl (name, w) -> let f cnt = - let a, ws, _ = cnt in + let a, ws = cnt in let lenv = lenv_of_cnt cnt in let f qid = - let f nw ww = - K.add henv (uri_of_qid qid) (N.succ nw, cnt); + let f ww = + K.add henv (uri_of_qid qid) cnt; let t = match ws with | [] -> ww | _ -> D.TBind (a, D.Abst (N.infinite, ws), ww) @@ -210,13 +203,12 @@ let xlate_entity err f st = function get_cnt_relaxed f st | A.Def (name, w, trans, v) -> let f cnt = - let a, ws, _ = cnt in + let a, ws = cnt in let lenv = lenv_of_cnt cnt in let f qid = - let f nw ww = - let f nv vv = - assert (nv = N.succ nw); (**) - K.add henv (uri_of_qid qid) (nv, cnt); + let f ww = + let f vv = + K.add henv (uri_of_qid qid) cnt; let t = match ws with | [] -> D.TCast ([], ww, vv) | _ -> D.TBind (a, D.Abst (N.infinite, ws), D.TCast ([], ww, vv))