X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_notation%2FcicNotationPres.ml;h=633d702a90c554c3acc6bf02a6802658579ac66c;hb=33a02e0b639217093eb63f30169aaa6ac8c78907;hp=7c87dedce0168ecc76d7d954d782d592fe48b6e4;hpb=206f96afb7097c20b3cc8bd144825467b4fde7ae;p=helm.git diff --git a/helm/ocaml/cic_notation/cicNotationPres.ml b/helm/ocaml/cic_notation/cicNotationPres.ml index 7c87dedce..633d702a9 100644 --- a/helm/ocaml/cic_notation/cicNotationPres.ml +++ b/helm/ocaml/cic_notation/cicNotationPres.ml @@ -23,9 +23,10 @@ * http://helm.cs.unibo.it/ *) -module P = Mpresentation +module Ast = CicNotationPt +module Mpres = Mpresentation -type mathml_markup = boxml_markup Mpresentation.mpres +type mathml_markup = boxml_markup Mpres.mpres and boxml_markup = mathml_markup Box.box type markup = mathml_markup @@ -36,19 +37,26 @@ let to_unicode = Utf8Macro.unicode_of_tex let rec make_attributes l1 = function | [] -> [] - | None :: tl -> make_attributes (List.tl l1) tl - | Some s :: tl -> - let p,n = List.hd l1 in - (p,n,s) :: make_attributes (List.tl l1) tl + | hd :: tl -> + (match !hd with + | None -> make_attributes (List.tl l1) tl + | Some s -> + let p,n = List.hd l1 in + hd := None; + (p,n,s) :: make_attributes (List.tl l1) tl) let box_of_mpres = function - Mpresentation.Mobject (_, box) -> box + | Mpresentation.Mobject (attrs, box) -> + assert (attrs = []); + box | mpres -> Box.Object ([], mpres) let mpres_of_box = function - Box.Object (_, mpres) -> mpres + | Box.Object (attrs, mpres) -> + assert (attrs = []); + mpres | box -> Mpresentation.Mobject ([], box) let rec genuine_math = @@ -74,9 +82,19 @@ let rec promote_to_math = let small_skip = Mpresentation.Mspace (RenderingAttrs.small_skip_attributes `MathML) +let rec add_mpres_attributes new_attr = function + | Mpresentation.Mobject (attr, box) -> + Mpresentation.Mobject (attr, add_box_attributes new_attr box) + | mpres -> + Mpresentation.set_attr (new_attr @ Mpresentation.get_attr mpres) mpres +and add_box_attributes new_attr = function + | Box.Object (attr, mpres) -> + Box.Object (attr, add_mpres_attributes new_attr mpres) + | box -> Box.set_attr (new_attr @ Box.get_attr box) box + let box_of mathonly spec attrs children = match children with - | [t] -> t + | [t] -> add_mpres_attributes attrs t | _ -> let kind, spacing, indent = spec in let dress children = @@ -93,22 +111,22 @@ let box_of mathonly spec attrs children = @ attrs in match kind with - | CicNotationPt.H -> + | Ast.H -> if List.for_all eligible_math children then Mpresentation.Mrow (attrs', dress (List.map promote_to_math children)) else mpres_of_box (Box.H (attrs', List.map box_of_mpres children)) -(* | CicNotationPt.H when List.for_all genuine_math children -> +(* | Ast.H when List.for_all genuine_math children -> Mpresentation.Mrow (attrs', dress children) *) - | CicNotationPt.V -> + | Ast.V -> mpres_of_box (Box.V (attrs', List.map box_of_mpres children)) - | CicNotationPt.HV -> + | Ast.HV -> mpres_of_box (Box.HV (attrs', List.map box_of_mpres children)) - | CicNotationPt.HOV -> + | Ast.HOV -> mpres_of_box (Box.HOV (attrs', List.map box_of_mpres children)) @@ -140,15 +158,15 @@ let pp_pos = let is_atomic t = let rec aux_mpres = function - | P.Mi _ - | P.Mo _ - | P.Mn _ - | P.Ms _ - | P.Mtext _ - | P.Mspace _ -> true - | P.Mobject (_, box) -> aux_box box - | P.Maction (_, [mpres]) - | P.Mrow (_, [mpres]) -> aux_mpres mpres + | Mpres.Mi _ + | Mpres.Mo _ + | Mpres.Mn _ + | Mpres.Ms _ + | Mpres.Mtext _ + | Mpres.Mspace _ -> true + | Mpres.Mobject (_, box) -> aux_box box + | Mpres.Maction (_, [mpres]) + | Mpres.Mrow (_, [mpres]) -> aux_mpres mpres | _ -> false and aux_box = function | Box.Space _ @@ -182,7 +200,7 @@ let add_parens child_prec child_assoc child_pos curr_prec t = t let render ids_to_uris = - let module A = CicNotationPt in + let module A = Ast in let module P = Mpresentation in let use_unicode = true in let lookup_uri = function @@ -190,8 +208,8 @@ let render ids_to_uris = | Some id -> (try Some (Hashtbl.find ids_to_uris id) with Not_found -> None) in let make_href xmlattrs xref uris = - let xref_uri = lookup_uri xref in - let raw_uris = List.map UriManager.string_of_uri uris in + let xref_uri = lookup_uri !xref in + let raw_uris = List.map UriManager.string_of_uri !uris in let uri = match xref_uri, raw_uris with | None, [] -> None @@ -199,11 +217,14 @@ let render ids_to_uris = | None, raw_uris -> Some (String.concat " " raw_uris) | Some uri, raw_uris -> Some (String.concat " " (uri :: raw_uris)) in + uris := []; xmlattrs - @ make_attributes [Some "helm", "xref"; Some "xlink", "href"] [xref; uri] + @ make_attributes [Some "helm", "xref"; Some "xlink", "href"] + [xref; ref uri] in let make_xref xref = make_attributes [Some "helm","xref"] [xref] in (* when mathonly is true no boxes should be generated, only mrows *) + (* "xref" is *) let rec aux xmlattrs mathonly xref pos prec uris t = match t with | A.AttributedTerm _ -> @@ -213,20 +234,20 @@ let render ids_to_uris = (RenderingAttrs.number_attributes `MathML) @ make_href xmlattrs xref uris in - P.Mn (attrs, literal) + Mpres.Mn (attrs, literal) | A.Symbol (literal, _) -> let attrs = (RenderingAttrs.symbol_attributes `MathML) @ make_href xmlattrs xref uris in - P.Mo (attrs, to_unicode literal) + Mpres.Mo (attrs, to_unicode literal) | A.Ident (literal, subst) | A.Uri (literal, subst) -> let attrs = (RenderingAttrs.ident_attributes `MathML) - @ make_href xmlattrs xref [] + @ make_href xmlattrs xref uris in - let name = P.Mi (attrs, to_unicode literal) in + let name = Mpres.Mi (attrs, to_unicode literal) in (match subst with | Some [] | None -> name @@ -238,8 +259,8 @@ let render ids_to_uris = (List.map (fun (name, t) -> box_of mathonly (A.H, false, false) [] [ - P.Mi ([], name); - P.Mo ([], to_unicode "\\def"); + Mpres.Mi ([], name); + Mpres.Mo ([], to_unicode "\\def"); aux [] mathonly xref pos prec uris t ]) substs)) @ [ closed_brace ]) @@ -250,15 +271,15 @@ let render ids_to_uris = let var_name = UriManager.name_of_uri var_uri in let href_attr = Some "xlink", "href", var in box_of mathonly (A.H, false, false) [] [ - P.Mi ([href_attr], var_name); - P.Mo ([], to_unicode "\\def"); + Mpres.Mi ([href_attr], var_name); + Mpres.Mo ([], to_unicode "\\def"); aux [] mathonly xref pos prec uris t ]) substs)) *) in let substs_maction = toggle_action [ hidden_substs; substs' ] in box_of mathonly (A.H, false, false) [] [ name; substs_maction ]) | A.Literal l -> aux_literal xmlattrs xref prec uris l - | A.UserInput -> P.Mtext ([], "%") + | A.UserInput -> Mpres.Mtext ([], "%") | A.Layout l -> aux_layout mathonly xref pos prec uris l | A.Magic _ | A.Variable _ -> assert false (* should have been instantiated *) @@ -284,10 +305,10 @@ let render ids_to_uris = aux_attribute t | t -> (match !new_level with - | None -> aux !new_xmlattrs mathonly !new_xref pos prec !new_uris t + | None -> aux !new_xmlattrs mathonly new_xref pos prec new_uris t | Some (child_prec, child_assoc) -> let t' = - aux !new_xmlattrs mathonly !new_xref pos child_prec !new_uris t + aux !new_xmlattrs mathonly new_xref pos child_prec new_uris t in add_parens child_prec child_assoc pos prec t') in @@ -304,23 +325,23 @@ let render ids_to_uris = and aux_literal xmlattrs xref prec uris l = let attrs = make_href xmlattrs xref uris in (match l with - | `Symbol s -> P.Mo (attrs, to_unicode s) - | `Keyword s -> P.Mo (attrs, to_unicode s) - | `Number s -> P.Mn (attrs, to_unicode s)) + | `Symbol s -> Mpres.Mo (attrs, to_unicode s) + | `Keyword s -> Mpres.Mo (attrs, to_unicode s) + | `Number s -> Mpres.Mn (attrs, to_unicode s)) and aux_layout mathonly xref pos prec uris l = let attrs = make_xref xref in - let invoke' t = aux [] true None pos prec uris t in + let invoke' t = aux [] true (ref None) pos prec uris t in match l with - | A.Sub (t1, t2) -> P.Msub (attrs, invoke' t1, invoke' t2) - | A.Sup (t1, t2) -> P.Msup (attrs, invoke' t1, invoke' t2) - | A.Below (t1, t2) -> P.Munder (attrs, invoke' t1, invoke' t2) - | A.Above (t1, t2) -> P.Mover (attrs, invoke' t1, invoke' t2) + | A.Sub (t1, t2) -> Mpres.Msub (attrs, invoke' t1, invoke' t2) + | A.Sup (t1, t2) -> Mpres.Msup (attrs, invoke' t1, invoke' t2) + | A.Below (t1, t2) -> Mpres.Munder (attrs, invoke' t1, invoke' t2) + | A.Above (t1, t2) -> Mpres.Mover (attrs, invoke' t1, invoke' t2) | A.Frac (t1, t2) - | A.Over (t1, t2) -> P.Mfrac (attrs, invoke' t1, invoke' t2) + | A.Over (t1, t2) -> Mpres.Mfrac (attrs, invoke' t1, invoke' t2) | A.Atop (t1, t2) -> - P.Mfrac (atop_attributes @ attrs, invoke' t1, invoke' t2) - | A.Sqrt t -> P.Msqrt (attrs, invoke' t) - | A.Root (t1, t2) -> P.Mroot (attrs, invoke' t1, invoke' t2) + Mpres.Mfrac (atop_attributes @ attrs, invoke' t1, invoke' t2) + | A.Sqrt t -> Mpres.Msqrt (attrs, invoke' t) + | A.Root (t1, t2) -> Mpres.Mroot (attrs, invoke' t1, invoke' t2) | A.Box ((_, spacing, _) as kind, terms) -> let children = aux_children mathonly spacing xref pos prec uris @@ -379,11 +400,11 @@ let render ids_to_uris = in List.map boxify_pres (find_clusters terms) in - aux [] false None `None 0 [] + aux [] false (ref None) `None 0 (ref []) -let rec print_box (t: CicNotationPres.boxml_markup) = +let rec print_box (t: boxml_markup) = Box.box2xml print_mpres t -and print_mpres (t: CicNotationPres.mathml_markup) = +and print_mpres (t: mathml_markup) = Mpresentation.print_mpres print_box t let print_xml = print_mpres