Improved the pretty-printers.
This commit is contained in:
parent
a6972bf28b
commit
6f56b297f2
@ -25,7 +25,7 @@ and pp_let_decl {value; _} =
|
||||
| Some _ -> "let rec " in
|
||||
let binding = pp_let_binding binding
|
||||
and attr = pp_attributes attr
|
||||
in string let_str ^^ nest 4 binding ^^ attr
|
||||
in string let_str ^^ binding ^^ attr
|
||||
|
||||
and pp_attributes = function
|
||||
[] -> empty
|
||||
@ -44,12 +44,11 @@ and pp_let_binding (binding : let_binding) =
|
||||
let patterns = Utils.nseq_to_list binders in
|
||||
let patterns = group (separate_map (break 1) pp_pattern patterns) in
|
||||
let lhs =
|
||||
patterns ^^
|
||||
match lhs_type with
|
||||
None -> patterns
|
||||
| Some (_,e) ->
|
||||
patterns ^^ group (break 1 ^^ string ": " ^^ pp_type_expr e)
|
||||
and rhs = group (break 1 ^^ string "= " ^^ nest 2 (pp_expr let_rhs))
|
||||
in lhs ^^ rhs
|
||||
None -> empty
|
||||
| Some (_,e) -> group (break 1 ^^ string ": " ^^ pp_type_expr e)
|
||||
in prefix 2 1 (lhs ^^ string " =") (pp_expr let_rhs)
|
||||
|
||||
and pp_pattern = function
|
||||
PConstr p -> pp_pconstr p
|
||||
@ -155,13 +154,12 @@ and pp_expr = function
|
||||
and pp_case_expr {value; _} =
|
||||
let {expr; cases; _} = value in
|
||||
group (string "match " ^^ nest 6 (pp_expr expr) ^/^ string "with")
|
||||
^^ hardline ^^ nest 2 (pp_cases cases)
|
||||
^^ hardline ^^ pp_cases cases
|
||||
|
||||
and pp_cases {value; _} =
|
||||
let head, tail = value in
|
||||
let head = pp_clause head in
|
||||
let head = if tail = [] then head
|
||||
else string " " ^^ head in
|
||||
let head = if tail = [] then head else blank 2 ^^ head in
|
||||
let rest = List.map snd tail in
|
||||
let app clause = break 1 ^^ string "| " ^^ pp_clause clause
|
||||
in head ^^ concat_map app rest
|
||||
@ -172,14 +170,11 @@ and pp_clause {value; _} =
|
||||
|
||||
and pp_cond_expr {value; _} =
|
||||
let {test; ifso; kwd_else; ifnot; _} = value in
|
||||
let if_then =
|
||||
string "if " ^^ group (nest 3 (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))
|
||||
let test = string "if " ^^ group (nest 3 (pp_expr test))
|
||||
and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso))
|
||||
and ifnot = string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot))
|
||||
in if kwd_else#is_ghost then test ^/^ ifso
|
||||
else test ^/^ ifso ^/^ ifnot
|
||||
|
||||
and pp_annot_expr {value; _} =
|
||||
let expr, _, type_expr = value.inside in
|
||||
@ -356,7 +351,7 @@ and pp_let_in {value; _} =
|
||||
| Some _ -> "let rec " in
|
||||
let binding = pp_let_binding binding
|
||||
and attr = pp_attributes attributes
|
||||
in string let_str ^^ nest 4 binding ^^ attr
|
||||
in string let_str ^^ binding ^^ attr
|
||||
^^ hardline ^^ group (string "in " ^^ nest 3 (pp_expr body))
|
||||
|
||||
and pp_fun {value; _} =
|
@ -180,11 +180,11 @@ and pp_var_decl {value; _} =
|
||||
let {name; var_type; init; _} = value in
|
||||
let start = string ("var " ^ name.value ^ " :") in
|
||||
let t_expr = pp_type_expr var_type
|
||||
in prefix 2 1 start t_expr
|
||||
^/^ prefix 2 1 (string ":=") (pp_expr init)
|
||||
in prefix 2 1 start
|
||||
(t_expr ^/^ prefix 2 1 (string ":=") (pp_expr init))
|
||||
|
||||
and pp_instruction = function
|
||||
Cond i -> pp_conditional i
|
||||
Cond i -> group (pp_conditional i)
|
||||
| CaseInstr i -> pp_case pp_if_clause i
|
||||
| Assign i -> pp_assignment i
|
||||
| Loop i -> pp_loop i
|
||||
@ -212,23 +212,29 @@ and pp_cond_expr {value; _} = string "TODO:pp_cond_expr"
|
||||
|
||||
and pp_conditional {value; _} =
|
||||
let {test; ifso; ifnot; _} : conditional = value in
|
||||
let if_then = string "if " ^^ group (nest 3 (pp_expr test)) in
|
||||
let ifso = prefix 2 1 (string "then") (pp_if_clause ifso) in
|
||||
let ifnot =
|
||||
string "else" ^^ group (nest 2 (blank 1 ^^ pp_if_clause ifnot))
|
||||
in group (if_then ^/^ ifso ^/^ ifnot)
|
||||
let test = string "if " ^^ group (nest 3 (pp_expr test))
|
||||
and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_if_clause ifso))
|
||||
and ifnot =
|
||||
if is_clause_block ifnot then
|
||||
string "else {"
|
||||
^^ group (nest 2 (hardline ^^ pp_if_clause ifnot))
|
||||
^^ hardline ^^ string "}"
|
||||
else
|
||||
string "else" ^^ group (nest 2 (break 1 ^^ pp_if_clause ifnot))
|
||||
in test ^/^ ifso ^/^ ifnot
|
||||
|
||||
and pp_if_clause = function
|
||||
ClauseInstr i -> nest 1 (pp_instruction i)
|
||||
| ClauseBlock b ->
|
||||
string "{" ^^ hardline ^^ pp_clause_block b ^^ hardline ^^ string "}"
|
||||
ClauseInstr i -> pp_instruction i
|
||||
| ClauseBlock b -> pp_clause_block b
|
||||
|
||||
and is_clause_block = function
|
||||
ClauseInstr _ -> false
|
||||
| ClauseBlock _ -> true
|
||||
|
||||
and pp_clause_block = function
|
||||
LongBlock b -> pp_block b
|
||||
| ShortBlock {value; _} -> Utils.(pp_statements <@ fst) value.inside
|
||||
|
||||
and pp_short_block {value; _} = string "TODO:pp_short_block"
|
||||
|
||||
and pp_set_membership {value; _} = string "TODO:pp_set_membership"
|
||||
|
||||
and pp_case :
|
||||
@ -245,10 +251,9 @@ and pp_cases :
|
||||
fun printer {value; _} ->
|
||||
let head, tail = value in
|
||||
let head = pp_case_clause printer head in
|
||||
let head = if tail = [] then head else blank 4 ^^ head in
|
||||
let head = if tail = [] then head else blank 2 ^^ head in
|
||||
let rest = List.map snd tail in
|
||||
let app clause =
|
||||
break 1 ^^ string "| " ^^ pp_case_clause printer clause
|
||||
let app clause = break 1 ^^ string "| " ^^ pp_case_clause printer clause
|
||||
in head ^^ concat_map app rest
|
||||
|
||||
and pp_case_clause :
|
||||
@ -323,7 +328,7 @@ and pp_map_expr = function
|
||||
| BigMapInj inj -> pp_injection pp_binding inj
|
||||
|
||||
and pp_map_lookup {value; _} =
|
||||
pp_path value.path ^^ pp_brackets pp_expr value.index
|
||||
pp_path value.path ^^ blank 1 ^^ pp_brackets pp_expr value.index
|
||||
|
||||
and pp_path = function
|
||||
Name v -> pp_ident v
|
@ -1,23 +0,0 @@
|
||||
$HOME/git/OCaml-build/Makefile
|
||||
|
||||
../shared/Lexer.mli
|
||||
../shared/Lexer.mll
|
||||
../shared/LexerLib.ml
|
||||
../shared/EvalOpt.ml
|
||||
../shared/EvalOpt.mli
|
||||
../shared/FQueue.ml
|
||||
../shared/FQueue.mli
|
||||
../shared/LexerLog.mli
|
||||
../shared/LexerLog.ml
|
||||
../shared/Markup.ml
|
||||
../shared/Markup.mli
|
||||
../shared/Utils.mli
|
||||
../shared/Utils.ml
|
||||
../shared/ParserAPI.mli
|
||||
../shared/ParserAPI.ml
|
||||
../shared/LexerUnit.mli
|
||||
../shared/LexerUnit.ml
|
||||
../shared/ParserUnit.mli
|
||||
../shared/ParserUnit.ml
|
||||
|
||||
$HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml
|
@ -1,25 +0,0 @@
|
||||
$HOME/git/OCaml-build/Makefile
|
||||
|
||||
../shared/Lexer.mli
|
||||
../shared/Lexer.mll
|
||||
../shared/LexerLib.mli
|
||||
../shared/LexerLib.ml
|
||||
../shared/EvalOpt.ml
|
||||
../shared/EvalOpt.mli
|
||||
../shared/FQueue.ml
|
||||
../shared/FQueue.mli
|
||||
../shared/LexerLog.mli
|
||||
../shared/LexerLog.ml
|
||||
../shared/Markup.ml
|
||||
../shared/Markup.mli
|
||||
../shared/Utils.mli
|
||||
../shared/Utils.ml
|
||||
../shared/ParserAPI.mli
|
||||
../shared/ParserAPI.ml
|
||||
../shared/LexerUnit.mli
|
||||
../shared/LexerUnit.ml
|
||||
../shared/ParserUnit.mli
|
||||
../shared/ParserUnit.ml
|
||||
../shared/LexerLib.ml
|
||||
|
||||
$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml
|
@ -1,31 +0,0 @@
|
||||
$HOME/git/OCaml-build/Makefile
|
||||
|
||||
../shared/Lexer.mli
|
||||
../shared/Lexer.mll
|
||||
../shared/LexerLib.ml
|
||||
../shared/EvalOpt.ml
|
||||
../shared/EvalOpt.mli
|
||||
../shared/FQueue.ml
|
||||
../shared/FQueue.mli
|
||||
../shared/LexerLog.mli
|
||||
../shared/LexerLog.ml
|
||||
../shared/Markup.ml
|
||||
../shared/Markup.mli
|
||||
../shared/Utils.mli
|
||||
../shared/Utils.ml
|
||||
../shared/ParserAPI.mli
|
||||
../shared/ParserAPI.ml
|
||||
../shared/LexerUnit.mli
|
||||
../shared/LexerUnit.ml
|
||||
../shared/ParserUnit.mli
|
||||
../shared/ParserUnit.ml
|
||||
|
||||
Stubs/Parser_cameligo.ml
|
||||
|
||||
../cameligo/AST.ml
|
||||
../cameligo/ParserLog.mli
|
||||
../cameligo/ParserLog.ml
|
||||
../cameligo/Scoping.mli
|
||||
../cameligo/Scoping.ml
|
||||
|
||||
$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml
|
Loading…
Reference in New Issue
Block a user