X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fhelena%2Fsrc%2Fxml%2FxmlCrg.ml;h=34c78dd9e0a1b78c591ae832cb2d3feca3b60ecc;hb=88977b2d546e547e23b046792fe2ad8f6ff192a4;hp=f04930851035d2d323499eef96a046e0477a5f2d;hpb=1be981691870cca039b1af1fb954491c2020d483;p=helm.git diff --git a/helm/software/helena/src/xml/xmlCrg.ml b/helm/software/helena/src/xml/xmlCrg.ml index f04930851..34c78dd9e 100644 --- a/helm/software/helena/src/xml/xmlCrg.ml +++ b/helm/software/helena/src/xml/xmlCrg.ml @@ -17,71 +17,73 @@ module R = Alpha module XL = XmlLibrary module D = Crg +IFDEF OBJECTS THEN + (* internal functions *******************************************************) let lenv_iter map_bind map_appl map_proj st e lenv out tab = let rec aux = function - | D.ESort -> e - | D.EBind (e, a, b) -> + | D.ESort -> e + | D.EBind (e, a, y, b) -> let e = aux e in (* NOTE: the inner binders are alpha-converted first *) - let a = R.alpha D.mem e a in - map_bind st e a b out tab; D.EBind (e, a, b) - | D.EAppl (e, a, v) -> + let y = R.alpha D.mem e y in + map_bind st e a y b out tab; D.EBind (e, a, y, b) + | D.EAppl (e, a, v) -> let e = aux e in map_appl st e a v out tab; D.EAppl (e, a, v) - | D.EProj (e, a, d) -> + | D.EProj (e, d) -> let e = aux e in - map_proj st e a d out tab; D.EProj (e, a, d) + map_proj st e d out tab; D.EProj (e, d) in ignore (aux lenv) let rec exp_term st e t out tab = match t with - | D.TSort (a, l) -> - let a = - let err _ = a in - let f s = {a with E.n_name = Some (s, true)} in - H.string_of_sort err f l + | D.TSort k -> + let y = + let err _ = E.empty_bind in + let f s = E.bind_attrs ~name:(s, true) () in + H.string_of_sort err f k in - let attrs = [XL.position l; XL.name a] in + let attrs = [XL.position k; XL.name y] in XL.tag XL.sort attrs out tab - | D.TLRef (a, i) -> - let a = - let err _ = a in - let f n r = {a with E.n_name = Some (n, r)} in + | D.TLRef (_, i) -> + let y = + let err _ = E.empty_bind in + let f s r = E.bind_attrs ~name:(s, r) () in D.get_name err f i e in - let attrs = [XL.position i; XL.name a] in + let attrs = [XL.depth i; XL.name y] in XL.tag XL.lref attrs out tab - | D.TGRef (a, n) -> - let a = {a with E.n_name = Some (U.name_of_uri n, true)} in - let attrs = [XL.uri n; XL.name a; XL.apix a] in + | D.TGRef (_, n) -> + let y = E.bind_attrs ~name:(U.name_of_uri n, true) () in + let attrs = [XL.uri n; XL.name y] in XL.tag XL.gref attrs out tab - | D.TCast (a, u, t) -> + | D.TCast (u, t) -> let attrs = [] in XL.tag XL.cast attrs ~contents:(exp_term st e u) out tab; exp_term st e t out tab - | D.TAppl (a, v, t) -> - let attrs = [] in + | D.TAppl (a, v, t) -> + let attrs = XL.restricted a.E.a_rest :: XL.side a.E.a_side @ XL.main a.E.a_main in XL.tag XL.appl attrs ~contents:(exp_term st e v) out tab; exp_term st e t out tab - | D.TProj (a, lenv, t) -> + | D.TProj (lenv, t) -> let attrs = [] in XL.tag XL.proj attrs ~contents:(lenv_iter exp_bind exp_appl exp_proj st e lenv) out tab; - exp_term st (D.push_proj C.start a lenv e) t out tab + exp_term st (D.push_proj C.start lenv e) t out tab | D.TBind (a, b, t) -> (* NOTE: the inner binders are alpha-converted first *) let a = R.alpha D.mem e a in - exp_bind st e a b out tab; - exp_term st (D.push_bind C.start a b e) t out tab + exp_bind st e E.empty_node a b out tab; + exp_term st (D.push_bind C.start E.empty_node a b e) t out tab and exp_appl st e a v out tab = - let attrs = [] in + let attrs = XL.restricted a.E.a_rest :: XL.side a.E.a_side @ XL.main a.E.a_main in XL.tag XL.appl attrs ~contents:(exp_term st e v) out tab; -and exp_bind st e a b out tab = match b with +and exp_bind st e y a b out tab = match b with | D.Abst (_, n, w) -> - let attrs = [XL.layer st n; XL.name a; XL.kind a] in + let attrs = XL.layer st n :: XL.name a :: XL.side a.E.b_side @ XL.main a.E.b_main in XL.tag XL.abst attrs ~contents:(exp_term st e w) out tab | D.Abbr v -> let attrs = [XL.name a] in @@ -90,10 +92,12 @@ and exp_bind st e a b out tab = match b with let attrs = [XL.name a] in XL.tag XL.void attrs out tab -and exp_proj st e a lenv out tab = +and exp_proj st e lenv out tab = let attrs = [] in XL.tag XL.proj attrs ~contents:(lenv_iter exp_bind exp_appl exp_proj st e lenv) out tab (* interface functions ******************************************************) let export_term st = exp_term st D.empty_lenv + +END