X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcontent_pres%2FtermContentPres.ml;h=68cc4ccbb391e913a21b5fac7ca99419ae781c2d;hb=f9abd21eb0d26cf9b632af4df819225be4d091e3;hp=f1ea0b25e9abeb0b42a78842f7db2a58a721cc29;hpb=9b09890767aaa93e512324f8e7f13e2cdeebac88;p=helm.git diff --git a/helm/software/components/content_pres/termContentPres.ml b/helm/software/components/content_pres/termContentPres.ml index f1ea0b25e..68cc4ccbb 100644 --- a/helm/software/components/content_pres/termContentPres.ml +++ b/helm/software/components/content_pres/termContentPres.ml @@ -88,12 +88,26 @@ let binder_symbol s = add_xml_attrs (RenderingAttrs.builtin_symbol_attributes `MathML) (builtin_symbol s) -let string_of_sort_kind = function - | `Prop -> "Prop" - | `Set -> "Set" - | `CProp _ -> "CProp" - | `Type _ -> "Type" - | `NType s -> "Type[" ^ s ^ "]" +let xml_of_sort x = + let to_string x = Ast.Ident (x, None) in + let identify x = + add_xml_attrs (RenderingAttrs.keyword_attributes `MathML) (to_string x) + in + let lvl t = Ast.AttributedTerm (`Level 90,t) in + match x with + | `Prop -> identify "Prop" + | `Set -> identify "Set" + | `CProp _ -> identify "CProp" + | `Type _ -> identify "Type" + | `NType s -> lvl(Ast.Layout (Ast.Sub (identify "Type",to_string s))) + | `NCProp s -> lvl(Ast.Layout (Ast.Sub (identify "CProp",to_string s))) +;; + + +let map_space f l = + HExtlib.list_concat + ~sep:[space] (List.map (fun x -> [f x]) l) +;; let pp_ast0 t k = let rec aux = @@ -146,7 +160,7 @@ let pp_ast0 t k = function Ast.Pattern (head, href, vars) -> hvbox true true (ident_w_href href head :: - List.flatten (List.map (fun x -> [break;x]) (List.map aux_var vars))) + List.flatten (List.map (fun x -> [break;x]) (map_space aux_var vars))) | Ast.Wildcard -> builtin_symbol "_" in let patterns' = @@ -205,8 +219,8 @@ let pp_ast0 t k = match rec_kind with `Inductive -> "rec" | `CoInductive -> "corec" in let mk_fun (args, (name,ty), body, rec_param) = - List.map aux_var args ,k name, HExtlib.map_option k ty, k body, - fst (List.nth args rec_param) + List.flatten (List.map (fun x -> [aux_var x; space]) args), + k name, HExtlib.map_option k ty, k body, fst (List.nth args rec_param) in let mk_funs = List.map mk_fun in let fst_fun, tl_funs = @@ -219,9 +233,10 @@ let pp_ast0 t k = space; keyword rec_op; space; - name] @ + name; + space] @ params @ - [space; keyword "on" ; space ; rec_param ;space ] @ + [keyword "on" ; space ; rec_param ;space ] @ (match ty with None -> [] | Some ty -> [builtin_symbol ":"; ty]) @ [ builtin_symbol "\\def"; break; @@ -232,7 +247,7 @@ let pp_ast0 t k = (fun (params, name, ty, body, rec_param) -> [ break; hvbox false true ([ - keyword "and"; + keyword "and"; space; name] @ params @ [space; keyword "on" ; space; rec_param ;space ] @ @@ -246,7 +261,8 @@ let pp_ast0 t k = ((hvbox false false (fst_row :: List.flatten tl_rows @ [ break; keyword "in"; break; k where ]))) - | Ast.Implicit -> builtin_symbol "?" + | Ast.Implicit `JustOne -> builtin_symbol "?" + | Ast.Implicit `Vector -> builtin_symbol "…" | Ast.Meta (n, l) -> let local_context l = List.map (function None -> None | Some t -> Some (k t)) l @@ -260,9 +276,7 @@ let pp_ast0 t k = | Ast.Literal _ | Ast.UserInput as leaf -> leaf | t -> CicNotationUtil.visit_ast ~special_k k t - and aux_sort sort_kind = - add_xml_attrs (RenderingAttrs.keyword_attributes `MathML) - (Ast.Ident (string_of_sort_kind sort_kind, None)) + and aux_sort sort_kind = xml_of_sort sort_kind and aux_ty = function | None -> builtin_symbol "?" | Some ty -> k ty @@ -535,6 +549,8 @@ let head_names names env = aux ((name, (ty, v)) :: acc) tl | Env.TermType _, Env.TermValue _ -> aux ((name, (ty, v)) :: acc) tl + | Env.OptType _, Env.OptValue _ -> + aux ((name, (ty, v)) :: acc) tl | _ -> assert false) | _ :: tl -> aux acc tl (* base pattern may contain only meta names, thus we trash all others *) @@ -550,6 +566,8 @@ let tail_names names env = aux ((name, (Env.ListType ty, Env.ListValue vtl)) :: acc) tl | Env.TermType _, Env.TermValue _ -> aux ((name, (ty, v)) :: acc) tl + | Env.OptType _, Env.OptValue _ -> + aux ((name, (ty, v)) :: acc) tl | _ -> assert false) | binding :: tl -> aux (binding :: acc) tl | [] -> acc @@ -589,7 +607,7 @@ let instantiate_level2 env term = Ast.Ident (name, Some (aux_substs env substs)) | Ast.Meta (index, substs) -> Ast.Meta (index, aux_meta_substs env substs) - | Ast.Implicit + | Ast.Implicit _ | Ast.Ident _ | Ast.Num _ | Ast.Sort _