2 ||M|| This file is part of HELM, an Hypertextual, Electronic
3 ||A|| Library of Mathematics, developed at the Computer Science
4 ||T|| Department, University of Bologna, Italy.
6 ||T|| HELM is free software; you can redistribute it and/or
7 ||A|| modify it under the terms of the GNU General Public License
8 \ / version 2 or (at your option) any later version.
9 \ / This software is distributed as is, NO WARRANTY.
10 V_______________________________________________________________ *)
17 module XL = XmlLibrary
20 (* internal functions *******************************************************)
22 let lenv_iter map_bind map_appl map_proj e lenv out tab =
23 let rec aux = function
25 | D.EBind (e, a, b) ->
27 map_bind e a b out tab; D.EBind (e, a, b)
28 | D.EAppl (e, a, v) ->
30 map_appl e a v out tab; D.EAppl (e, a, v)
31 | D.EProj (e, a, d) ->
33 map_proj e a d out tab; D.EProj (e, a, d)
37 let rec exp_term e t out tab = match t with
41 let f s = Y.Name (s, true) :: a in
42 H.string_of_sort err f l
44 let attrs = [XL.position l; XL.name a] in
45 XL.tag XL.sort attrs out tab
49 let f n r = Y.Name (n, r) :: a in
52 let attrs = [XL.position i; XL.name a] in
53 XL.tag XL.lref attrs out tab
55 let a = Y.Name (U.name_of_uri n, true) :: a in
56 let attrs = [XL.uri n; XL.name a; XL.apix a] in
57 XL.tag XL.gref attrs out tab
58 | D.TCast (a, u, t) ->
60 XL.tag XL.cast attrs ~contents:(exp_term e u) out tab;
62 | D.TAppl (a, v, t) ->
64 XL.tag XL.appl attrs ~contents:(exp_term e v) out tab;
66 | D.TProj (a, lenv, t) ->
68 XL.tag XL.proj attrs ~contents:(lenv_iter exp_bind exp_appl exp_proj e lenv) out tab;
69 exp_term (D.push_proj C.start a lenv e) t out tab
70 | D.TBind (a, b, t) ->
71 (* NOTE: the inner binders are alpha-converted first *)
72 let a = R.alpha (D.names_of_lenv [] e) a in
73 exp_bind e a b out tab;
74 exp_term (D.push_bind C.start a b e) t out tab
76 and exp_appl e a v out tab =
78 XL.tag XL.appl attrs ~contents:(exp_term e v) out tab;
80 and exp_bind e a b out tab = match b with
82 let attrs = [XL.level n; XL.name a; XL.mark a] in
83 XL.tag XL.abst attrs ~contents:(exp_term e w) out tab
85 let attrs = [XL.name a] in
86 XL.tag XL.abbr attrs ~contents:(exp_term e v) out tab
88 let attrs = [XL.name a] in
89 XL.tag XL.void attrs out tab
91 and exp_proj e a lenv out tab =
93 XL.tag XL.proj attrs ~contents:(lenv_iter exp_bind exp_appl exp_proj e lenv) out tab
95 (* interface functions ******************************************************)
97 let export_term = exp_term D.empty_lenv