More pretty-printing.
This commit is contained in:
parent
3bec051115
commit
8606528ddb
@ -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
|
||||||
|
@ -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 =
|
||||||
|
Loading…
Reference in New Issue
Block a user