X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Ftoplevel%2FmetaAut.ml;h=d686c0f2c3e4abbe0476d3633eedd8b5787c0879;hb=28430d599505ac26b51e4887e5196d9b380c898a;hp=75aaa71e6508d61949795300082bfb0b0afe9225;hpb=cd798346d31b14b8947e5801b87dc4f363607862;p=helm.git diff --git a/helm/software/lambda-delta/toplevel/metaAut.ml b/helm/software/lambda-delta/toplevel/metaAut.ml index 75aaa71e6..d686c0f2c 100644 --- a/helm/software/lambda-delta/toplevel/metaAut.ml +++ b/helm/software/lambda-delta/toplevel/metaAut.ml @@ -19,14 +19,10 @@ module A = Aut (* qualified identifier: uri, name, qualifiers *) type qid = M.uri * M.id * M.id list -type environment = M.pars H.t - type context_node = qid option (* context node: None = root *) type status = { - henv: environment; (* optimized global environment *) path: M.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 *) @@ -38,11 +34,15 @@ type resolver = Local of int let henv_size, hcnt_size = 7000, 4300 (* hash tables initial sizes *) +let henv = H.create henv_size (* optimized global environment *) + +let hcnt = H.create hcnt_size (* optimized context *) + (* Internal functions *******************************************************) -let initial_status cover = { +let initial_status cover = + H.clear henv; H.clear hcnt; { path = []; node = None; nodes = []; line = 1; cover = cover; - henv = H.create henv_size; hcnt = H.create hcnt_size } let id_of_name (id, _, _) = id @@ -93,10 +93,11 @@ let resolve_lref_strict f st l lenv id = resolve_lref f st l lenv id let resolve_gref f st qid = - try let args = H.find st.henv (uri_of_qid qid) in f qid (Some args) + try let args = H.find henv (uri_of_qid qid) in f qid (Some args) with Not_found -> f qid None let resolve_gref_relaxed f st qid = +(* this is not tail recursive *) let rec g qid = function | None -> relax_qid (resolve_gref g st) st qid | Some args -> f qid args @@ -106,16 +107,18 @@ let resolve_gref_relaxed f st qid = let get_pars f st = function | None -> f [] None | Some qid as node -> - try let pars = H.find st.hcnt (uri_of_qid qid) in f pars None + try let pars = H.find hcnt (uri_of_qid qid) in f pars None with Not_found -> f [] (Some node) let get_pars_relaxed f st = +(* this is not tail recursive *) let rec g pars = function | None -> f pars | Some node -> relax_opt_qid (get_pars g st) st node in get_pars g st st.node +(* this is not tail recursive on the GRef branch *) let rec xlate_term f st lenv = function | A.Sort sort -> f (M.Sort sort) @@ -165,7 +168,7 @@ let xlate_entity err f st = function let f qid = let f pars = let f ww = - H.add st.hcnt (uri_of_qid qid) ((name, ww) :: pars); + H.add hcnt (uri_of_qid qid) ((name, ww) :: pars); err {st with node = Some qid} in xlate_term f st pars w @@ -177,7 +180,7 @@ let xlate_entity err f st = function let f pars = let f qid = let f ww = - H.add st.henv (uri_of_qid qid) pars; + H.add henv (uri_of_qid qid) pars; let a = [Y.Mark st.line] in let entry = pars, ww, None in let entity = a, uri_of_qid qid, Y.Abst entry in @@ -192,7 +195,7 @@ let xlate_entity err f st = function let f pars = let f qid = let f ww vv = - H.add st.henv (uri_of_qid qid) pars; + H.add henv (uri_of_qid qid) pars; let a = Y.Mark st.line :: if trans then [] else [Y.Priv] in let entry = pars, ww, Some vv in let entity = a, uri_of_qid qid, Y.Abbr entry in