From f3ed135926588c5b104ae853cbcad211438cd30f Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Fri, 15 May 2020 00:44:15 +0200 Subject: [PATCH] More fixes to the pretty-printer. --- src/passes/1-parser/cameligo/Pretty.ml | 72 ++++++++++++++------------ src/passes/1-parser/shared/Utils.mli | 8 +-- src/test/contracts/fibo2.mligo | 2 +- 3 files changed, 43 insertions(+), 39 deletions(-) diff --git a/src/passes/1-parser/cameligo/Pretty.ml b/src/passes/1-parser/cameligo/Pretty.ml index ff2dfdc09..d880d0cb9 100644 --- a/src/passes/1-parser/cameligo/Pretty.ml +++ b/src/passes/1-parser/cameligo/Pretty.ml @@ -23,12 +23,13 @@ and pp_let_decl Region.{value; _} = | Some _ -> string "rec " in let binding = pp_let_binding binding and attr = pp_attributes attr - in string "let " ^^ rec_doc ^^ binding - ^^ group (nest 2 (break 1 ^^ attr)) + in string "let " ^^ rec_doc ^^ binding ^^ attr -and pp_attributes attr = - let make s = string "[@@" ^^ string s.value ^^ string "]" - in separate_map (break 0) make attr +and pp_attributes = function + [] -> empty +| attr -> + let make s = string "[@@" ^^ string s.value ^^ string "]" in + group (nest 2 (break 1 ^^ separate_map (break 0) make attr)) and pp_ident Region.{value; _} = string value @@ -42,8 +43,10 @@ and pp_let_binding (binding : let_binding) = let lhs_type = match lhs_type with None -> empty - | Some (_,e) -> prefix 2 1 (string " :") (pp_type_expr e) - in patterns ^^ lhs_type ^^ string " =" + | Some (_,e) -> group (nest 2 (break 1 ^^ string ": " ^^ pp_type_expr e)) + in patterns + ^^ lhs_type + ^^ string " =" ^^ group (nest 2 (break 1 ^^ group (pp_expr let_rhs))) and pp_pattern = function @@ -71,7 +74,8 @@ and pp_pconstr = function and pp_patt_c_app Region.{value; _} = match value with constr, None -> pp_ident constr - | constr, Some pat -> pp_ident constr ^^ pp_pattern pat + | constr, Some pat -> + prefix 4 1 (pp_ident constr) (pp_pattern pat) and pp_patt_some Region.{value; _} = prefix 4 1 (string "Some") (pp_pattern (snd value)) @@ -101,7 +105,7 @@ and pp_cons Region.{value; _} = and pp_ptuple Region.{value; _} = let cmp = Utils.nsepseq_to_list value in let sep = string "," ^^ break 1 in - separate_map sep pp_pattern cmp + group (separate_map sep pp_pattern cmp) and pp_precord fields = pp_ne_injection pp_field_pattern fields @@ -125,7 +129,7 @@ and pp_expr = function | ELogic e -> pp_logic_expr e | EArith e -> group (pp_arith_expr e) | EString e -> pp_string_expr e -| EList e -> pp_list_expr e +| EList e -> group (pp_list_expr e) | EConstr e -> pp_constr_expr e | ERecord e -> pp_record_expr e | EProj e -> pp_projection e @@ -143,15 +147,16 @@ and pp_expr = function and pp_case_expr Region.{value; _} = let {expr; cases; _} = value in group (string "match " ^^ pp_expr expr ^/^ string "with") - ^^ group (nest 2 (break 1 ^^ pp_cases cases)) + ^^ hardline ^^ nest 2 (pp_cases cases) and pp_cases Region.{value; _} = let head, tail = value in let head = pp_clause head in + let head = if tail = [] then head + else string " " ^^ head in let rest = List.map snd tail in let app clause = break 1 ^^ string "| " ^^ pp_clause clause - in ifflat head (string " " ^^ head) - ^^ concat_map app rest + in head ^^ concat_map app rest and pp_clause Region.{value; _} = let {pattern; rhs; _} = value in @@ -160,18 +165,18 @@ and pp_clause Region.{value; _} = and pp_cond_expr Region.{value; _} = let {test; ifso; kwd_else; ifnot; _} = value in let if_then = - string "if " ^^ pp_expr test - ^/^ string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso)) in - if kwd_else#is_ghost then if_then - else let else_ = - string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot)) - in if_then ^/^ else_ + string "if " ^^ group (nest 2 (pp_expr test)) ^/^ string "then" + ^^ group (nest 2 (break 1 ^^ pp_expr ifso)) in + if kwd_else#is_ghost then + if_then + else + if_then + ^/^ string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot)) and pp_annot_expr Region.{value; _} = let expr, _, type_expr = value.inside in - string "(" ^^ - nest 1 (pp_expr expr ^^ string " :" - ^/^ pp_type_expr type_expr ^^ string ")") + string "(" ^^ pp_expr expr ^^ string " :" + ^^ group (nest 1 (break 1 ^^ pp_type_expr type_expr ^^ string ")")) and pp_logic_expr = function BoolExpr e -> pp_bool_expr e @@ -253,7 +258,7 @@ and pp_constr_app Region.{value; _} = let constr = string constr.value in match arg with None -> constr - | Some e -> constr ^/^ pp_expr e + | Some e -> prefix 2 1 constr (pp_expr e) and pp_record_expr ne_inj = pp_ne_injection pp_field_assign ne_inj @@ -337,10 +342,8 @@ and pp_let_in Region.{value; _} = let rec_doc = match kwd_rec with None -> empty | Some _ -> string "rec " - in group (string "let " ^^ rec_doc ^^ binding - ^^ group (nest 2 (break 1 ^^ attr)) - ^/^ string "in" - ^^ group (nest 2 (break 1 ^^ pp_expr body))) + in group (string "let " ^^ rec_doc ^^ binding) ^^ attr + ^/^ group (string "in " ^^ nest 3 (pp_expr body)) and pp_fun Region.{value; _} = let {binders; lhs_type; body; _} = value in @@ -348,8 +351,8 @@ and pp_fun Region.{value; _} = and annot = match lhs_type with None -> empty | Some (_,e) -> string ": " ^/^ pp_type_expr e - in string "fun " ^^ nest 4 binders ^^ annot - ^^ string " ->" ^^ nest 2 (break 1 ^^ pp_expr body) + in group (string "fun " ^^ nest 4 binders ^^ annot + ^^ string " ->" ^^ nest 2 (break 1 ^^ pp_expr body)) and pp_seq e = pp_injection pp_expr e @@ -375,17 +378,18 @@ and pp_cartesian Region.{value; _} = and pp_variants Region.{value; _} = let head, tail = value in let head = pp_variant head in + let head = if tail = [] then head + else ifflat head (string " " ^^ head) in let rest = List.map snd tail in let app variant = break 1 ^^ string "| " ^^ pp_variant variant - in ifflat head (string " " ^^ head) - ^^ concat_map app rest + in head ^^ concat_map app rest and pp_variant Region.{value; _} = let {constr; arg} = value in match arg with None -> pp_ident constr - | Some (_, t_expr) -> - prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr t_expr) + | Some (_, e) -> + prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr e) and pp_fields fields = pp_ne_injection pp_field_decl fields @@ -397,7 +401,7 @@ and pp_field_decl Region.{value; _} = and pp_type_app Region.{value; _} = let ctor, tuple = value in - pp_type_tuple tuple ^^ string " " ^^ pp_type_constr ctor + prefix 2 1 (pp_type_tuple tuple) (pp_type_constr ctor) and pp_type_tuple Region.{value; _} = let {inside; _} = value in diff --git a/src/passes/1-parser/shared/Utils.mli b/src/passes/1-parser/shared/Utils.mli index db3a03c49..3ef10fe7f 100644 --- a/src/passes/1-parser/shared/Utils.mli +++ b/src/passes/1-parser/shared/Utils.mli @@ -31,9 +31,9 @@ val sepseq_cons : 'a -> 'sep -> ('a,'sep) sepseq -> ('a,'sep) nsepseq (* Reversing *) -val nseq_rev: 'a nseq -> 'a nseq -val nsepseq_rev: ('a,'sep) nsepseq -> ('a,'sep) nsepseq -val sepseq_rev: ('a,'sep) sepseq -> ('a,'sep) sepseq +val nseq_rev : 'a nseq -> 'a nseq +val nsepseq_rev : ('a,'sep) nsepseq -> ('a,'sep) nsepseq +val sepseq_rev : ('a,'sep) sepseq -> ('a,'sep) sepseq (* Rightwards iterators *) @@ -55,7 +55,7 @@ val sepseq_foldr : ('a -> 'b -> 'b) -> ('a,'c) sepseq -> 'b -> 'b val nseq_map : ('a -> 'b) -> 'a nseq -> 'b nseq val nsepseq_map : ('a -> 'b) -> ('a,'c) nsepseq -> ('b,'c) nsepseq -val sepseq_map : ('a -> 'b) -> ('a,'c) sepseq -> ('b,'c) sepseq +val sepseq_map : ('a -> 'b) -> ('a,'c) sepseq -> ('b,'c) sepseq (* Conversions to lists *) diff --git a/src/test/contracts/fibo2.mligo b/src/test/contracts/fibo2.mligo index f41ee0e3d..49dc8b0e9 100644 --- a/src/test/contracts/fibo2.mligo +++ b/src/test/contracts/fibo2.mligo @@ -1,6 +1,6 @@ type storage = unit -let main (p : unit; store : storage) : operation list * storage = +let main (p, store : unit * storage) : operation list * storage = let n = (fun (f : int -> int) (z : int) (y : int) -> f y) (fun (x : int) -> x)