Attention une mise à jour du serveur va être effectuée le vendredi 16 avril entre 12h et 12h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit a9bccabd authored by Guillaume Melquiond's avatar Guillaume Melquiond

Replace hov boxes by compacting boxes in Coq printer.

parent 6014b2ad
......@@ -37,7 +37,7 @@ let char_to_alnumus c =
let syntax_arguments s f fmt l =
let sl = Strings.split ' ' s in
pp_open_hovbox fmt 1;
pp_open_box fmt 1;
print_list space (fun fmt s -> syntax_arguments s f fmt l) fmt sl;
pp_close_box fmt ()
......@@ -85,7 +85,7 @@ let print_tv_binders_list info ~whytypes ~implicit fmt ltv =
let print_params info ~whytypes fmt stv =
if Stv.is_empty stv then () else
fprintf fmt "@[<hov 2>forall%a,@]@ "
fprintf fmt "@[<2>forall%a,@]@ "
(print_tv_binders info ~whytypes ~implicit:true) stv
let print_params_list info ~whytypes fmt ltv =
......@@ -150,8 +150,8 @@ let print_ts_tv info fmt ts =
(print_list space (print_tv info ~whytypes:false)) ts.ts_args
let protect_on ?(boxed=false) x s =
if x then "@[<hov 1>(" ^^ s ^^ ")@]"
else if not boxed then "@[<hov>" ^^ s ^^ "@]"
if x then "@[<1>(" ^^ s ^^ ")@]"
else if not boxed then "@[" ^^ s ^^ "@]"
else s
let rec print_type info fmt ty = print_ty false info fmt ty
......@@ -198,7 +198,7 @@ let unambig_fs fs =
(** Patterns, terms, and formulas *)
let lparen_r fmt () = fprintf fmt "@[<hov 1>("
let lparen_r fmt () = fprintf fmt "@[<1>("
let rparen_r fmt () = fprintf fmt ")@]"
let print_paren_r fmt x =
print_list_delim ~start:lparen_r ~stop:rparen_r ~sep:comma fmt x
......@@ -219,12 +219,12 @@ let rec print_pat info fmt p = match p.pat_node with
begin match query_syntax info.info_syn cs.ls_name with
| Some s -> syntax_arguments s (print_pat info) fmt pl
| _ when pl = [] -> (print_ls_real info) fmt cs
| _ -> fprintf fmt "@[<hov 1>(%a@ %a)@]"
| _ -> fprintf fmt "@[<1>(%a@ %a)@]"
(print_ls_real info) cs (print_list space (print_pat info)) pl
end
let print_vsty info fmt v =
fprintf fmt "@[<hov 1>(%a:@,%a)@]" print_vs v (print_type info) v.vs_ty
fprintf fmt "@[<1>(%a:@,%a)@]" print_vs v (print_type info) v.vs_ty
let print_binop fmt = function
| Tand -> fprintf fmt "/\\"
......@@ -298,13 +298,13 @@ and print_tnode ?(boxed=false) opl opr info fmt t = match t.t_node with
else fprintf fmt (protect_on (opl || opr) "%a@ %a")
(print_ls_real info) fs
(print_list space (print_opr_term info)) tl
else fprintf fmt (protect_on (opl || opr) "@[<hov>%a%a@] :@ %a")
else fprintf fmt (protect_on (opl || opr) "@[%a%a@] :@ %a")
(print_ls_real info) fs (print_list_pre space (print_opr_term info)) tl
(print_type info) (t_type t)
end
| Tquant (Tforall,fq) ->
let vl,_tl,f = t_open_quant fq in
fprintf fmt (protect_on ~boxed opr "@[<hov 2>forall %a@],@ %a")
fprintf fmt (protect_on ~boxed opr "@[<2>forall %a@],@ %a")
(print_list space (print_vsty info)) vl
(print_tnode ~boxed:true false false info) f;
List.iter forget_var vl
......@@ -342,7 +342,7 @@ and print_tnode ?(boxed=false) opl opr info fmt t = match t.t_node with
and print_tbranch info fmt br =
let p,t = t_open_branch br in
fprintf fmt "@[<hov 4>| %a =>@ %a@]"
fprintf fmt "@[<4>| %a =>@ %a@]"
(print_pat info) p (print_term info) t;
Svs.iter forget_var p.pat_vars
......@@ -352,7 +352,7 @@ let print_expr info fmt =
(** Declarations *)
let print_constr info ts fmt (cs,_) =
fprintf fmt "@[<hov 4>| %a : %a%a%a@]" print_ls cs
fprintf fmt "@[<4>| %a : %a%a%a@]" print_ls cs
(print_arrow_list (print_op_type info)) cs.ls_args
print_ts ts
(print_list_pre space (print_tv info ~whytypes:false)) ts.ts_args
......@@ -646,19 +646,19 @@ let print_type_decl ~prev info fmt ts =
| Some (Query (_,Notation,c)) ->
fprintf fmt "(* Why3 goal *)@\n%s@\n" c
| Some (Axiom _) ->
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>Variable %a :@ @[<hov>%aType.@]@]@\n@[<hv 2>Hypothesis %a_WhyType :@ @[<hov>%aWhyType %a.@]@]@\nExisting Instance %a_WhyType.@\n@\n"
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>Variable %a :@ @[%aType.@]@]@\n@[<hv 2>Hypothesis %a_WhyType :@ @[%aWhyType %a.@]@]@\nExisting Instance %a_WhyType.@\n@\n"
print_ts ts (print_params_list info ~whytypes:false) ts.ts_args
print_ts ts (print_params_list info ~whytypes:true)
ts.ts_args (print_ts_tv info) ts print_ts ts
| _ ->
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>Definition %a :@ @[<hov>%aType.@]@]@\n%a@\n"
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>Definition %a :@ @[%aType.@]@]@\n%a@\n"
print_ts ts (print_params_list info ~whytypes:false) ts.ts_args
(print_previous_proof None info) prev
else begin
fprintf fmt "@[<hv 2>Axiom %a :@ @[<hov>%aType.@]@]@\n"
fprintf fmt "@[<hv 2>Axiom %a :@ @[%aType.@]@]@\n"
print_ts ts (print_params_list info ~whytypes:false) ts.ts_args;
if not info.ssreflect then begin
fprintf fmt "@[<hv 2>Parameter %a_WhyType :@ @[<hov>%aWhyType %a.@]@]@\n"
fprintf fmt "@[<hv 2>Parameter %a_WhyType :@ @[%aWhyType %a.@]@]@\n"
print_ts ts (print_params_list info ~whytypes:true) ts.ts_args
(print_ts_tv info) ts;
fprintf fmt "Existing Instance %a_WhyType.@\n"
......@@ -667,7 +667,7 @@ let print_type_decl ~prev info fmt ts =
fprintf fmt "@\n"
end
| Alias ty ->
fprintf fmt "(* Why3 assumption *)@\n@[<hov 2>Definition %a%a :=@ %a.@]@\n@\n"
fprintf fmt "(* Why3 assumption *)@\n@[<2>Definition %a%a :=@ %a.@]@\n@\n"
print_ts ts
(print_list_pre space
(print_tv_binder info ~whytypes:false ~implicit:false)) ts.ts_args
......@@ -680,9 +680,9 @@ let print_type_decl ~prev info fmt ts =
let print_data_decl ~first info fmt ts csl =
let name = id_unique iprinter ts.ts_name in
if first then
fprintf fmt "(* Why3 assumption *)@\n@[<hov 2>Inductive"
fprintf fmt "(* Why3 assumption *)@\n@[<2>Inductive"
else fprintf fmt "@\nwith";
fprintf fmt " %s%a :=@\n@[<hov>%a@]"
fprintf fmt " %s%a :=@\n@[%a@]"
name (print_list_pre space
(print_tv_binder info ~whytypes:false ~implicit:false)) ts.ts_args
(print_list newline (print_constr info ts)) csl;
......@@ -690,7 +690,7 @@ let print_data_decl ~first info fmt ts csl =
let print_data_whytype_and_implicits info fmt (name,ts,csl) =
if not info.ssreflect then
fprintf fmt "@[<hov 2>Axiom %s_WhyType : %aWhyType %a.@]@\nExisting Instance %s_WhyType.@\n"
fprintf fmt "@[<2>Axiom %s_WhyType : %aWhyType %a.@]@\nExisting Instance %s_WhyType.@\n"
name (print_params_list info ~whytypes:true) ts.ts_args
(print_ts_tv info) ts name;
List.iter
......@@ -699,7 +699,7 @@ let print_data_whytype_and_implicits info fmt (name,ts,csl) =
if not (Stv.is_empty all_ty_params) then
let print fmt tv =
fprintf fmt "[%a]" (print_tv info ~whytypes:false) tv in
fprintf fmt "@[<hov 2>Implicit Arguments %a@ [%a].@]@\n"
fprintf fmt "@[<2>Implicit Arguments %a@ [%a].@]@\n"
print_ls cs
(print_list space print) ts.ts_args)
csl;
......@@ -733,7 +733,7 @@ let print_param_decl ~prev info fmt ls =
| Some (Query (_,Notation,c)) ->
fprintf fmt "(* Why3 goal *)@\n%s@\n" c
| Some (Axiom _) ->
fprintf fmt "(* Why3 goal *)@\n@[<hov 2>Variable %a: %a%a%a.@]@\n@\n"
fprintf fmt "(* Why3 goal *)@\n@[<2>Variable %a: %a%a%a.@]@\n@\n"
print_ls ls (print_params info ~whytypes:true) all_ty_params
(print_arrow_list (print_op_type info)) ls.ls_args
(print_ls_type info) ls.ls_value
......@@ -748,13 +748,13 @@ let print_param_decl ~prev info fmt ls =
(print_expr info) e;
List.iter forget_var vl
| _ ->
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>Definition %a :@ @[<hv>%a@[<hov>%a%a.@]@]@]@\n%a@\n"
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>Definition %a :@ @[<hv>%a@[%a%a.@]@]@]@\n%a@\n"
print_ls ls (print_params info ~whytypes:true) all_ty_params
(print_arrow_list (print_op_type info)) ls.ls_args
(print_ls_type info) ls.ls_value
(print_previous_proof None info) prev
else
fprintf fmt "@[<hv 2>Parameter %a:@ @[<hov>%a%a%a.@]@]@\n@\n"
fprintf fmt "@[<hv 2>Parameter %a:@ @[%a%a%a.@]@]@\n@\n"
print_ls ls (print_params info ~whytypes:true) all_ty_params
(print_arrow_list (print_op_type info)) ls.ls_args
(print_ls_type info) ls.ls_value
......@@ -766,7 +766,7 @@ let print_param_decl ~prev info fmt ls =
let print_logic_decl info fmt (ls,ld) =
let _, _, all_ty_params = ls_ty_vars ls in
let vl,e = open_ls_defn ld in
fprintf fmt "(* Why3 assumption *)@\n@[<hv 2>Definition @[<hov>%a%a%a :@ %a@] :=@ @[<hov>%a.@]@]@\n"
fprintf fmt "(* Why3 assumption *)@\n@[<hv 2>Definition @[%a%a%a :@ %a@] :=@ @[%a.@]@]@\n"
print_ls ls
(print_tv_binders info ~whytypes:true ~implicit:true) all_ty_params
(print_list_pre space (print_vsty info)) vl
......@@ -779,7 +779,7 @@ let print_equivalence_lemma ~prev info fmt name (ls,ld) =
let _, _, all_ty_params = ls_ty_vars ls in
let def_formula = ls_defn_axiom ld in
fprintf fmt
"(* Why3 goal *)@\n@[<hv 2>Lemma %s :@ @[<hov>%a%a.@]@]@\n"
"(* Why3 goal *)@\n@[<hv 2>Lemma %s :@ @[%a%a.@]@]@\n"
name
(print_params info ~whytypes:true) all_ty_params
(print_expr info) def_formula;
......@@ -823,9 +823,9 @@ let print_recursive_decl ~old info fmt dl =
if dl_no_syn <> [] then begin
fprintf fmt "(* Why3 assumption *)@\n";
print_list_delim
~start:(fun fmt () -> fprintf fmt "@[<hov 2>Fixpoint ")
~start:(fun fmt () -> fprintf fmt "@[<2>Fixpoint ")
~stop:(fun fmt () -> fprintf fmt ".@]@\n")
~sep:(fun fmt () -> fprintf fmt "@]@\n@[<hov 2>with ")
~sep:(fun fmt () -> fprintf fmt "@]@\n@[<2>with ")
(fun fmt d -> print_recursive_decl info fmt d; forget_tvs ())
fmt dl_no_syn;
fprintf fmt "@\n";
......@@ -833,11 +833,11 @@ let print_recursive_decl ~old info fmt dl =
List.iter (print_equivalence_lemma ~old info fmt) dl_syn
let print_ind info fmt (pr,f) =
fprintf fmt "@[<hov 4>| %a : %a@]" print_pr pr (print_term info) f
fprintf fmt "@[<4>| %a : %a@]" print_pr pr (print_term info) f
let print_ind_decl info fmt ps bl =
let _, _, all_ty_params = ls_ty_vars ps in
fprintf fmt " %a%a: %aProp :=@ @[<hov>%a@]"
fprintf fmt " %a%a: %aProp :=@ @[%a@]"
print_ls ps
(print_tv_binders info ~whytypes:true ~implicit:true) all_ty_params
(print_arrow_list (print_op_type info)) ps.ls_args
......@@ -849,7 +849,7 @@ let print_ind_decls info s fmt tl =
if Mid.mem ps.ls_name info.info_syn then first
else begin
if first then
fprintf fmt "(* Why3 assumption *)@\n@[<hov 2>%s"
fprintf fmt "(* Why3 assumption *)@\n@[<2>%s"
(match s with Ind -> "Inductive" | Coind -> "CoInductive")
else fprintf fmt "@\nwith";
print_ind_decl info fmt ps bl;
......@@ -870,11 +870,11 @@ let print_prop_decl ~prev info fmt (k,pr,f) =
if stt <> "" then
match prev with
| Some (Axiom _) when stt = "Lemma" ->
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>Hypothesis %a :@ @[<hov>%a%a.@]@]@\n@\n"
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>Hypothesis %a :@ @[%a%a.@]@]@\n@\n"
print_pr pr (print_params info ~whytypes:true) params
(print_term info) f
| _ ->
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>%s %a :@ @[<hv>%a@[<hov>%a.@]@]@]@\n%a@\n"
fprintf fmt "(* Why3 goal *)@\n@[<hv 2>%s %a :@ @[<hv>%a@[%a.@]@]@]@\n%a@\n"
stt print_pr pr (print_params info ~whytypes:true) params
(print_term info) f
(print_previous_proof (Some (params,f)) info) prev
......@@ -915,7 +915,7 @@ let print_decl ~old info fmt d =
print_prop_decl ~prev info fmt pr
let print_decls ~old info fmt dl =
fprintf fmt "@\n@[<hov>%a@]" (print_list nothing (print_decl ~old info)) dl
fprintf fmt "@\n@[%a@]" (print_list nothing (print_decl ~old info)) dl
let print_task printer_args ~realize ~ssreflect ?old fmt task =
(* eprintf "Task:%a@.@." Pretty.print_task task; *)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment