diff options
Diffstat (limited to 'printing')
| -rw-r--r-- | printing/ppconstr.ml | 2 | ||||
| -rw-r--r-- | printing/ppvernac.ml | 33 | ||||
| -rw-r--r-- | printing/prettyp.ml | 2 | ||||
| -rw-r--r-- | printing/printer.ml | 2 |
4 files changed, 24 insertions, 15 deletions
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml index aa94fb7be3..80ddd669f4 100644 --- a/printing/ppconstr.ml +++ b/printing/ppconstr.ml @@ -442,7 +442,7 @@ end) = struct let pr_recursive_decl pr pr_dangling dangling_with_for id bl annot t c = let pr_body = if dangling_with_for then pr_dangling else pr in - pr_id id ++ str" " ++ + pr_id id ++ (if bl = [] then mt () else str" ") ++ hov 0 (pr_undelimited_binders spc (pr ltop) bl ++ annot) ++ pr_opt_type_spc pr t ++ str " :=" ++ pr_sep_com (fun () -> brk(1,2)) (pr_body ltop) c diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml index 93c3179bcf..ff72be90c5 100644 --- a/printing/ppvernac.ml +++ b/printing/ppvernac.ml @@ -164,14 +164,17 @@ module Make | ModeNoHeadEvar -> str"!" | ModeOutput -> str"-" + let pr_hint_info pr_pat { hint_priority = pri; hint_pattern = pat } = + pr_opt (fun x -> str"|" ++ int x) pri ++ + pr_opt (fun y -> (if Option.is_empty pri then str"| " else mt()) ++ pr_pat y) pat + let pr_hints db h pr_c pr_pat = let opth = pr_opt_hintbases db in let pph = match h with | HintsResolve l -> keyword "Resolve " ++ prlist_with_sep sep - (fun (pri, _, c) -> pr_reference_or_constr pr_c c ++ - match pri with Some x -> spc () ++ str"(" ++ int x ++ str")" | None -> mt ()) + (fun (info, _, c) -> pr_reference_or_constr pr_c c ++ pr_hint_info pr_pat info) l | HintsImmediate l -> keyword "Immediate" ++ spc() ++ @@ -886,7 +889,7 @@ module Make spc() ++ pr_class_rawexpr c2) ) - | VernacInstance (abst, sup, (instid, bk, cl), props, pri) -> + | VernacInstance (abst, sup, (instid, bk, cl), props, info) -> return ( hov 1 ( (if abst then keyword "Declare" ++ spc () else mt ()) ++ @@ -897,7 +900,7 @@ module Make pr_and_type_binders_arg sup ++ str":" ++ spc () ++ (match bk with Implicit -> str "! " | Explicit -> mt ()) ++ - pr_constr cl ++ pr_priority pri ++ + pr_constr cl ++ pr_hint_info pr_constr_pattern_expr info ++ (match props with | Some (true,CRecord (_,l)) -> spc () ++ str":=" ++ spc () ++ str"{" ++ pr_record_body l ++ str "}" | Some (true,_) -> assert false @@ -908,14 +911,17 @@ module Make | VernacContext l -> return ( hov 1 ( - keyword "Context" ++ spc () ++ pr_and_type_binders_arg l) + keyword "Context" ++ pr_and_type_binders_arg l) ) - | VernacDeclareInstances (ids, pri) -> - return ( + | VernacDeclareInstances insts -> + let pr_inst (id, info) = + pr_reference id ++ pr_hint_info pr_constr_pattern_expr info + in + return ( hov 1 (keyword "Existing" ++ spc () ++ - keyword(String.plural (List.length ids) "Instance") ++ - spc () ++ prlist_with_sep spc pr_reference ids ++ pr_priority pri) + keyword(String.plural (List.length insts) "Instance") ++ + spc () ++ prlist_with_sep (fun () -> str", ") pr_inst insts) ) | VernacDeclareClass id -> @@ -1007,7 +1013,10 @@ module Make (keyword "Notation" ++ spc () ++ pr_lident id ++ spc () ++ prlist_with_sep spc pr_id ids ++ str":=" ++ pr_constrarg c ++ pr_syntax_modifiers - (match compat with None -> [] | Some v -> [SetCompatVersion v])) + (match compat with + | None -> [] + | Some Flags.Current -> [SetOnlyParsing] + | Some v -> [SetCompatVersion v])) ) | VernacDeclareImplicits (q,[]) -> return ( @@ -1049,7 +1058,7 @@ module Make in print_arguments nargs args ++ if not (List.is_empty more_implicits) then - str ", " ++ prlist_with_sep (fun () -> str", ") print_implicits more_implicits + prlist (fun l -> str"," ++ print_implicits l) more_implicits else (mt ()) ++ (if not (List.is_empty mods) then str" : " else str"") ++ prlist_with_sep (fun () -> str", " ++ spc()) (function @@ -1120,7 +1129,7 @@ module Make | VernacSetAppendOption (na,v) -> return ( hov 2 (keyword "Set" ++ spc() ++ pr_printoption na None ++ - spc() ++ keyword "Append" ++ spc() ++ str v) + spc() ++ keyword "Append" ++ spc() ++ qs v) ) | VernacAddOption (na,l) -> return ( diff --git a/printing/prettyp.ml b/printing/prettyp.ml index 64c7c0ba5e..2fc8bc82d1 100644 --- a/printing/prettyp.ml +++ b/printing/prettyp.ml @@ -877,7 +877,7 @@ let pr_instance env i = (* gallina_print_constant_with_infos i.is_impl *) (* lighter *) print_ref false (instance_impl i) ++ - begin match instance_priority i with + begin match hint_priority i with | None -> mt () | Some i -> spc () ++ str "|" ++ spc () ++ int i end diff --git a/printing/printer.ml b/printing/printer.ml index 447337b9a2..f059683838 100644 --- a/printing/printer.ml +++ b/printing/printer.ml @@ -541,7 +541,7 @@ let print_evar_constraints gl sigma = str" with candidates:" ++ fnl () ++ hov 0 ppcandidates else mt () -let should_print_dependent_evars = ref true +let should_print_dependent_evars = ref false let _ = let open Goptions in |