balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More fixes to the pretty-printer.

Browse Source
This commit is contained in:
Christian Rinderknecht 2020-05-15 00:44:15 +02:00
parent ec0a0dbd01
commit f3ed135926
3 changed files with 43 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
src/passes/1-parser/cameligo/Pretty.ml
View File

@ -23,12 +23,13 @@ and pp_let_decl Region.{value; _} =
| Some _ -> string "rec " in | Some _ -> string "rec " in
let binding = pp_let_binding binding let binding = pp_let_binding binding
and attr = pp_attributes attr and attr = pp_attributes attr
in string "let " ^^ rec_doc ^^ binding in string "let " ^^ rec_doc ^^ binding ^^ attr
^^ group (nest 2 (break 1 ^^ attr))
and pp_attributes attr = and pp_attributes = function
let make s = string "[@@" ^^ string s.value ^^ string "]" [] -> empty
in separate_map (break 0) make attr | 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 and pp_ident Region.{value; _} = string value
@ -42,8 +43,10 @@ and pp_let_binding (binding : let_binding) =
let lhs_type = let lhs_type =
match lhs_type with match lhs_type with
None -> empty None -> empty
| Some (_,e) -> prefix 2 1 (string " :") (pp_type_expr e) | Some (_,e) -> group (nest 2 (break 1 ^^ string ": " ^^ pp_type_expr e))
in patterns ^^ lhs_type ^^ string " =" in patterns
^^ lhs_type
^^ string " ="
^^ group (nest 2 (break 1 ^^ group (pp_expr let_rhs))) ^^ group (nest 2 (break 1 ^^ group (pp_expr let_rhs)))
and pp_pattern = function and pp_pattern = function
@ -71,7 +74,8 @@ and pp_pconstr = function
and pp_patt_c_app Region.{value; _} = and pp_patt_c_app Region.{value; _} =
match value with match value with
constr, None -> pp_ident constr 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; _} = and pp_patt_some Region.{value; _} =
prefix 4 1 (string "Some") (pp_pattern (snd value)) prefix 4 1 (string "Some") (pp_pattern (snd value))
@ -101,7 +105,7 @@ and pp_cons Region.{value; _} =
and pp_ptuple Region.{value; _} = and pp_ptuple Region.{value; _} =
let cmp = Utils.nsepseq_to_list value in let cmp = Utils.nsepseq_to_list value in
let sep = string "," ^^ break 1 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 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 | ELogic e -> pp_logic_expr e
| EArith e -> group (pp_arith_expr e) | EArith e -> group (pp_arith_expr e)
| EString e -> pp_string_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 | EConstr e -> pp_constr_expr e
| ERecord e -> pp_record_expr e | ERecord e -> pp_record_expr e
| EProj e -> pp_projection e | EProj e -> pp_projection e
@ -143,15 +147,16 @@ and pp_expr = function
and pp_case_expr Region.{value; _} = and pp_case_expr Region.{value; _} =
let {expr; cases; _} = value in let {expr; cases; _} = value in
group (string "match " ^^ pp_expr expr ^/^ string "with") 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; _} = and pp_cases Region.{value; _} =
let head, tail = value in let head, tail = value in
let head = pp_clause head 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 rest = List.map snd tail in
let app clause = break 1 ^^ string "| " ^^ pp_clause clause let app clause = break 1 ^^ string "| " ^^ pp_clause clause
in ifflat head (string " " ^^ head) in head ^^ concat_map app rest
^^ concat_map app rest
and pp_clause Region.{value; _} = and pp_clause Region.{value; _} =
let {pattern; rhs; _} = value in let {pattern; rhs; _} = value in
@ -160,18 +165,18 @@ and pp_clause Region.{value; _} =
and pp_cond_expr Region.{value; _} = and pp_cond_expr Region.{value; _} =
let {test; ifso; kwd_else; ifnot; _} = value in let {test; ifso; kwd_else; ifnot; _} = value in
let if_then = let if_then =
string "if " ^^ pp_expr test string "if " ^^ group (nest 2 (pp_expr test)) ^/^ string "then"
^/^ string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso)) in ^^ group (nest 2 (break 1 ^^ pp_expr ifso)) in
if kwd_else#is_ghost then if_then if kwd_else#is_ghost then
else let else_ = if_then
string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot)) else
in if_then ^/^ else_ if_then
^/^ string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot))
and pp_annot_expr Region.{value; _} = and pp_annot_expr Region.{value; _} =
let expr, _, type_expr = value.inside in let expr, _, type_expr = value.inside in
string "(" ^^ string "(" ^^ pp_expr expr ^^ string " :"
nest 1 (pp_expr expr ^^ string " :" ^^ group (nest 1 (break 1 ^^ pp_type_expr type_expr ^^ string ")"))
^/^ pp_type_expr type_expr ^^ string ")")
and pp_logic_expr = function and pp_logic_expr = function
BoolExpr e -> pp_bool_expr e BoolExpr e -> pp_bool_expr e
@ -253,7 +258,7 @@ and pp_constr_app Region.{value; _} =
let constr = string constr.value in let constr = string constr.value in
match arg with match arg with
None -> constr 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 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 let rec_doc = match kwd_rec with
None -> empty None -> empty
| Some _ -> string "rec " | Some _ -> string "rec "
in group (string "let " ^^ rec_doc ^^ binding in group (string "let " ^^ rec_doc ^^ binding) ^^ attr
^^ group (nest 2 (break 1 ^^ attr)) ^/^ group (string "in " ^^ nest 3 (pp_expr body))
^/^ string "in"
^^ group (nest 2 (break 1 ^^ pp_expr body)))
and pp_fun Region.{value; _} = and pp_fun Region.{value; _} =
let {binders; lhs_type; body; _} = value in let {binders; lhs_type; body; _} = value in
@ -348,8 +351,8 @@ and pp_fun Region.{value; _} =
and annot = match lhs_type with and annot = match lhs_type with
None -> empty None -> empty
| Some (_,e) -> string ": " ^/^ pp_type_expr e | Some (_,e) -> string ": " ^/^ pp_type_expr e
in string "fun " ^^ nest 4 binders ^^ annot in group (string "fun " ^^ nest 4 binders ^^ annot
^^ string " ->" ^^ nest 2 (break 1 ^^ pp_expr body) ^^ string " ->" ^^ nest 2 (break 1 ^^ pp_expr body))
and pp_seq e = pp_injection pp_expr e and pp_seq e = pp_injection pp_expr e
@ -375,17 +378,18 @@ and pp_cartesian Region.{value; _} =
and pp_variants Region.{value; _} = and pp_variants Region.{value; _} =
let head, tail = value in let head, tail = value in
let head = pp_variant head 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 rest = List.map snd tail in
let app variant = break 1 ^^ string "| " ^^ pp_variant variant let app variant = break 1 ^^ string "| " ^^ pp_variant variant
in ifflat head (string " " ^^ head) in head ^^ concat_map app rest
^^ concat_map app rest
and pp_variant Region.{value; _} = and pp_variant Region.{value; _} =
let {constr; arg} = value in let {constr; arg} = value in
match arg with match arg with
None -> pp_ident constr None -> pp_ident constr
| Some (_, t_expr) -> | Some (_, e) ->
prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr t_expr) prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr e)
and pp_fields fields = pp_ne_injection pp_field_decl fields 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; _} = and pp_type_app Region.{value; _} =
let ctor, tuple = value in 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; _} = and pp_type_tuple Region.{value; _} =
let {inside; _} = value in let {inside; _} = value in

2
src/test/contracts/fibo2.mligo
View File

@ -1,6 +1,6 @@
type storage = unit type storage = unit
let main (p : unit; store : storage) : operation list * storage = let main (p, store : unit * storage) : operation list * storage =
let n = let n =
(fun (f : int -> int) (z : int) (y : int) -> f y) (fun (f : int -> int) (z : int) (y : int) -> f y)
(fun (x : int) -> x) (fun (x : int) -> x)