X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fdual_rg%2FdrgAut.ml;h=bf42cc2abaab83252857ffc32b9c0e4eaa857f50;hb=f7bb626faf6b9d89c0ee5ac48b1d97c69d189f8a;hp=b6d8b166c472a6f8f7f3f2194f0da8fd3db202d2;hpb=cd798346d31b14b8947e5801b87dc4f363607862;p=helm.git diff --git a/helm/software/lambda-delta/dual_rg/drgAut.ml b/helm/software/lambda-delta/dual_rg/drgAut.ml index b6d8b166c..bf42cc2ab 100644 --- a/helm/software/lambda-delta/dual_rg/drgAut.ml +++ b/helm/software/lambda-delta/dual_rg/drgAut.ml @@ -25,14 +25,14 @@ type environment = context H.t type context_node = qid option (* context node: None = root *) -type 'a status = { +type status = { henv: environment; (* optimized global environment *) path: D.id list; (* current section path *) hcnt: environment; (* optimized context *) node: context_node; (* current context node *) nodes: context_node list; (* context node list *) line: int; (* line number *) - mk_uri:'a Y.uri_generator (* uri generator *) + mk_uri:Y.uri_generator (* uri generator *) } type resolver = Local of int @@ -53,9 +53,9 @@ let add_abst (a, ws) id w = Y.Name (id, true) :: a, w :: ws let lenv_of_cnt (a, ws) = - D.push C.start D.empty_lenv a (D.Abst ws) + D.push_bind C.start D.empty_lenv a (D.Abst ws) -let mk_lref f i j k = f (D.LRef ([Y.Apix k], i, j)) +let mk_lref f i j k = f (D.TLRef ([Y.Apix k], i, j)) let id_of_name (id, _, _) = id @@ -63,7 +63,7 @@ let mk_qid f st id path = let str = String.concat "/" path in let str = Filename.concat str id in let f str = f (U.uri_of_string str, id, path) in - st.mk_uri f str + f (st.mk_uri str) let uri_of_qid (uri, _, _) = uri @@ -89,10 +89,11 @@ let relax_opt_qid f st = function let resolve_gref err f st qid = try let cnt = H.find st.henv (uri_of_qid qid) in f qid cnt - with Not_found -> err () + with Not_found -> err qid let resolve_gref_relaxed f st qid = - let rec err () = relax_qid (resolve_gref err f st) st qid in +(* this is not tail recursive *) + let rec err qid = relax_qid (resolve_gref err f st) st qid in resolve_gref err f st qid let get_cnt err f st = function @@ -102,34 +103,40 @@ let get_cnt err f st = function with Not_found -> err node let get_cnt_relaxed f st = +(* this is not tail recursive *) let rec err node = relax_opt_qid (get_cnt err f st) st node in get_cnt err f st st.node +(* this is not tail recursive in the GRef branch *) let rec xlate_term f st lenv = function | A.Sort s -> - let f h = f (D.Sort ([], 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 tt = f (D.Appl ([], [vv], tt)) 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 ww = let a, b = [Y.Name (name, true)], (D.Abst [ww]) in - let f tt = f (D.Bind (a, b, tt)) in + let f tt = f (D.TBind (a, b, tt)) in let f lenv = xlate_term f st lenv t in - D.push f lenv a b + D.push_bind f lenv a b in xlate_term f st lenv w | A.GRef (name, args) -> let g qid (a, _) = + let gref = D.TGRef ([], uri_of_qid qid) in let map1 f = xlate_term f st lenv in let map2 f = function | Y.Name (id, _) -> D.resolve_lref Cps.err (mk_lref f) id lenv | _ -> assert false in let f tail = - let f args = f (D.Appl ([], args, D.GRef ([], uri_of_qid qid))) in + let f = function + | [] -> f gref + | args -> f (D.TAppl ([], args, gref)) + in let f a = C.list_rev_map_append f map2 a ~tail in C.list_sub_strict f a args in @@ -173,7 +180,7 @@ let xlate_entity err f st = function let f qid = let f ww = H.add st.henv (uri_of_qid qid) cnt; - let b = Y.Abst (D.Bind (a, D.Abst ws, ww)) in + let b = Y.Abst (D.TBind (a, D.Abst ws, ww)) in let entity = [Y.Mark st.line], uri_of_qid qid, b in f {st with line = succ st.line} entity in @@ -189,7 +196,7 @@ let xlate_entity err f st = function let f qid = let f ww vv = H.add st.henv (uri_of_qid qid) cnt; - let b = Y.Abbr (D.Bind (a, D.Abst ws, D.Cast ([], ww, vv))) in + let b = Y.Abbr (D.TBind (a, D.Abst ws, D.TCast ([], ww, vv))) in let a = if trans then [Y.Mark st.line] else [Y.Mark st.line; Y.Priv] in