More pretty-printing.

This commit is contained in:
Christian Rinderknecht 2020-06-04 14:55:40 +02:00
parent 3bec051115
commit 8606528ddb
2 changed files with 63 additions and 32 deletions

View File

@ -404,8 +404,7 @@ and pp_cartesian {value; _} =
and pp_variants {value; _} = and pp_variants {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 let head = if tail = [] then head else ifflat head (blank 2 ^^ head) in
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 head ^^ concat_map app rest in head ^^ concat_map app rest

View File

@ -5,9 +5,18 @@ module Region = Simple_utils.Region
open! Region open! Region
open! PPrint open! PPrint
let pp_par (printer: 'a -> document) ({value; _} : 'a par reg) = let pp_par : ('a -> document) -> 'a par reg -> document =
fun printer {value; _} ->
string "(" ^^ nest 1 (printer value.inside ^^ string ")") string "(" ^^ nest 1 (printer value.inside ^^ string ")")
let pp_brackets : ('a -> document) -> 'a brackets reg -> document =
fun printer {value; _} ->
string "[" ^^ nest 1 (printer value.inside ^^ string "]")
let pp_braces : ('a -> document) -> 'a braces reg -> document =
fun printer {value; _} ->
string "{" ^^ nest 1 (printer value.inside ^^ string "}")
let rec print ast = let rec print ast =
let app decl = group (pp_declaration decl) in let app decl = group (pp_declaration decl) in
let decl = Utils.nseq_to_list ast.decl in let decl = Utils.nseq_to_list ast.decl in
@ -132,7 +141,7 @@ and pp_fun_decl {value; _} =
^/^ string ": " ^^ nest 2 return_t ^/^ string ": " ^^ nest 2 return_t
^^ blk_opening ^^ blk_opening
^^ nest 2 (break 0 ^^ blk_in) ^^ nest 2 (break 0 ^^ blk_in)
^/^ blk_closing ^^ nest 4 (break 1 ^^ expr) ^/^ group (blk_closing ^^ nest 4 (break 1 ^^ expr))
^^ attr ^^ attr
and pp_parameters p = pp_nsepseq ";" pp_param_decl p and pp_parameters p = pp_nsepseq ";" pp_param_decl p
@ -203,20 +212,20 @@ and pp_cond_expr {value; _} = string "TODO:pp_cond_expr"
and pp_conditional {value; _} = and pp_conditional {value; _} =
let {test; ifso; ifnot; _} : conditional = value in let {test; ifso; ifnot; _} : conditional = value in
let if_then = let if_then = string "if " ^^ group (nest 3 (pp_expr test)) in
string "if " ^^ group (nest 3 (pp_expr test)) ^/^ string "then" let ifso = prefix 2 1 (string "then") (pp_if_clause ifso) in
^^ group (nest 2 (break 1 ^^ pp_if_clause ifso)) in let ifnot =
let if_else = string "else" ^^ group (nest 2 (blank 1 ^^ pp_if_clause ifnot))
string "else" ^^ group (nest 2 (break 1 ^^ pp_if_clause ifnot)) in group (if_then ^/^ ifso ^/^ ifnot)
in if_then ^/^ if_else
and pp_if_clause = function and pp_if_clause = function
ClauseInstr i -> pp_instruction i ClauseInstr i -> nest 1 (pp_instruction i)
| ClauseBlock b -> pp_clause_block b | ClauseBlock b ->
string "{" ^^ hardline ^^ pp_clause_block b ^^ hardline ^^ string "}"
and pp_clause_block = function and pp_clause_block = function
LongBlock b -> pp_block b LongBlock b -> pp_block b
| ShortBlock b -> pp_short_block b | ShortBlock {value; _} -> Utils.(pp_statements <@ fst) value.inside
and pp_short_block {value; _} = string "TODO:pp_short_block" and pp_short_block {value; _} = string "TODO:pp_short_block"
@ -226,8 +235,9 @@ and pp_case :
'a.('a -> document) -> 'a case Region.reg -> document = 'a.('a -> document) -> 'a case Region.reg -> document =
fun printer {value; _} -> fun printer {value; _} ->
let {expr; cases; _} = value in let {expr; cases; _} = value in
group (string "case " ^^ nest 5 (pp_expr expr) ^/^ string "of") group (string "case " ^^ nest 5 (pp_expr expr) ^/^ string "of [")
^^ hardline ^^ nest 2 (pp_cases printer cases) ^^ hardline ^^ pp_cases printer cases
^^ hardline ^^ string "]"
and pp_cases : and pp_cases :
'a.('a -> document) -> 'a.('a -> document) ->
@ -235,8 +245,7 @@ and pp_cases :
fun printer {value; _} -> fun printer {value; _} ->
let head, tail = value in let head, tail = value in
let head = pp_case_clause printer head in let head = pp_case_clause printer head in
let head = if tail = [] then head let head = if tail = [] then head else blank 4 ^^ head in
else string " " ^^ head in
let rest = List.map snd tail in let rest = List.map snd tail in
let app clause = let app clause =
break 1 ^^ string "| " ^^ pp_case_clause printer clause break 1 ^^ string "| " ^^ pp_case_clause printer clause
@ -244,7 +253,10 @@ and pp_cases :
and pp_case_clause : and pp_case_clause :
'a.('a -> document) -> 'a case_clause Region.reg -> document = 'a.('a -> document) -> 'a case_clause Region.reg -> document =
fun printer clause -> string "TODO:pp_case_clause" fun printer {value; _} ->
let {pattern; rhs; _} = value in
prefix 4 1 (pp_pattern pattern ^^ string " ->") (printer rhs)
and pp_assignment {value; _} = and pp_assignment {value; _} =
let {lhs; rhs; _} = value in let {lhs; rhs; _} = value in
@ -279,12 +291,12 @@ and pp_collection = function
and pp_expr = function and pp_expr = function
ECase e -> pp_case pp_expr e ECase e -> pp_case pp_expr e
| ECond e -> pp_cond_expr e | ECond e -> group (pp_cond_expr e)
| EAnnot e -> pp_annot_expr e | EAnnot e -> pp_annot_expr e
| ELogic e -> pp_logic_expr e | ELogic e -> pp_logic_expr e
| EArith e -> 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)
| ESet e -> pp_set_expr e | ESet e -> pp_set_expr e
| EConstr e -> pp_constr_expr e | EConstr e -> pp_constr_expr e
| ERecord e -> pp_record e | ERecord e -> pp_record e
@ -310,7 +322,8 @@ and pp_map_expr = function
| MapInj inj -> pp_injection pp_binding inj | MapInj inj -> pp_injection pp_binding inj
| BigMapInj inj -> pp_injection pp_binding inj | BigMapInj inj -> pp_injection pp_binding inj
and pp_map_lookup {value; _} = string "TODO:pp_map_lookup" and pp_map_lookup {value; _} =
pp_path value.path ^^ pp_brackets pp_expr value.index
and pp_path = function and pp_path = function
Name v -> pp_ident v Name v -> pp_ident v
@ -386,14 +399,19 @@ and pp_field_assign {value; _} = string "TODO:pp_field_assign"
and pp_record ne_inj = group (pp_ne_injection pp_field_assign ne_inj) and pp_record ne_inj = group (pp_ne_injection pp_field_assign ne_inj)
and pp_projection {value; _} = string "TODO:pp_projection" and pp_projection {value; _} =
let {struct_name; field_path; _} = value in
let fields = Utils.nsepseq_to_list field_path
and sep = string "." ^^ break 0 in
let fields = separate_map sep pp_selection fields in
group (pp_ident struct_name ^^ string "." ^^ break 0 ^^ fields)
and pp_update {value; _} = string "TODO:pp_update" and pp_update {value; _} = string "TODO:pp_update"
and pp_field_path_assign {value; _} = string "TODO:pp_field_path_assign" and pp_field_path_assign {value; _} = string "TODO:pp_field_path_assign"
and pp_selection = function and pp_selection = function
FieldName _ -> string "TODO:pp_selection:FieldName" FieldName v -> string v.value
| Component cmp -> cmp.value |> snd |> Z.to_string |> string | Component cmp -> cmp.value |> snd |> Z.to_string |> string
and pp_tuple_expr {value; _} = and pp_tuple_expr {value; _} =
@ -420,7 +438,21 @@ and pp_arguments v = pp_tuple_expr v
and pp_injection : and pp_injection :
'a.('a -> document) -> 'a injection reg -> document = 'a.('a -> document) -> 'a injection reg -> document =
fun printer {value; _} -> string "TODO:pp_injection" fun printer {value; _} ->
let {kind; enclosing; elements; _} = value in
let sep = string ";" ^^ break 1 in
let elements = Utils.sepseq_to_list elements in
let elements = separate_map sep printer elements in
let kwd = pp_injection_kwd kind in
let offset = String.length kwd + 2 in
string (kwd ^ " [")
^^ group (nest 2 (break 0 ^^ elements ^^ string "]"))
and pp_injection_kwd = function
InjSet _ -> "set"
| InjMap _ -> "map"
| InjBigMap _ -> "big_map"
| InjList _ -> "list"
and pp_ne_injection : and pp_ne_injection :
'a.('a -> document) -> 'a ne_injection reg -> document = 'a.('a -> document) -> 'a ne_injection reg -> document =