X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_notation%2FcicNotationPres.ml;h=633d702a90c554c3acc6bf02a6802658579ac66c;hb=98d5d40127827a5c40e58cb0c9654066f940b0ea;hp=e8458a0738a08f1136b090867db5aea3c55c8078;hpb=5a7ff7a3ce24bd14385d2295a1c77fad4b876cb8;p=helm.git diff --git a/helm/ocaml/cic_notation/cicNotationPres.ml b/helm/ocaml/cic_notation/cicNotationPres.ml index e8458a073..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 @@ -34,13 +35,6 @@ let atop_attributes = [None, "linethickness", "0pt"] 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 - prerr_endline (Printf.sprintf "make_attributes %s %s" n s); - (p,n,s) :: make_attributes (List.tl l1) tl *) let rec make_attributes l1 = function | [] -> [] | hd :: tl -> @@ -48,18 +42,21 @@ let rec make_attributes l1 = function | None -> make_attributes (List.tl l1) tl | Some s -> let p,n = List.hd l1 in - prerr_endline (Printf.sprintf "make_attributes %s %s" n s); 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 = @@ -85,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 = @@ -104,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)) @@ -151,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 _ @@ -193,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 @@ -227,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 (ref []) + @ 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 @@ -252,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 ]) @@ -264,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 *) @@ -318,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 (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