X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcontent_pres%2FtermContentPres.ml;h=3fae0f52b05a00ea529b3b3acc96e8b4f46ef2d1;hb=07713b63c109a99c2b9dc7265571bcdd3dd6ed0d;hp=378708bce764e9e0e8010ff5b64e696f9e52f7eb;hpb=eb9ca860db8cb06083765f7698179f16dee5303e;p=helm.git diff --git a/helm/software/components/content_pres/termContentPres.ml b/helm/software/components/content_pres/termContentPres.ml index 378708bce..3fae0f52b 100644 --- a/helm/software/components/content_pres/termContentPres.ml +++ b/helm/software/components/content_pres/termContentPres.ml @@ -93,6 +93,13 @@ let string_of_sort_kind = function | `Set -> "Set" | `CProp _ -> "CProp" | `Type _ -> "Type" + | `NType s -> "Type[" ^ s ^ "]" + | `NCProp s -> "CProp[" ^ 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 = @@ -144,16 +151,16 @@ let pp_ast0 t k = let mk_case_pattern = function Ast.Pattern (head, href, vars) -> - hvbox true false (ident_w_href href head :: List.map aux_var vars) + hvbox true true (ident_w_href href head :: + List.flatten (List.map (fun x -> [break;x]) (map_space aux_var vars))) | Ast.Wildcard -> builtin_symbol "_" in let patterns' = List.map (fun (lhs, rhs) -> remove_level_info - (hvbox false true [ - hbox false true [ - mk_case_pattern lhs; builtin_symbol "\\Rightarrow" ]; + (hovbox false true [ + mk_case_pattern lhs; break; builtin_symbol "\\Rightarrow"; break; top_pos (k rhs) ])) patterns in @@ -204,8 +211,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 = @@ -218,9 +225,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; @@ -231,7 +239,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 ] @ @@ -245,7 +253,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 @@ -534,6 +543,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 *) @@ -549,6 +560,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 @@ -588,7 +601,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 _ @@ -598,6 +611,8 @@ let instantiate_level2 env term = | Ast.Magic magic -> aux_magic env magic | Ast.Variable var -> aux_variable env var + | Ast.Cast (t, ty) -> Ast.Cast (aux env t, aux env ty) + | _ -> assert false and aux_opt env = function | Some term -> Some (aux env term)