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

Improved the pretty-printers.

Browse Source
This commit is contained in:
Christian Rinderknecht 2020-06-04 19:01:31 +02:00
parent a6972bf28b
commit 6f56b297f2
5 changed files with 41 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/passes/1-parser/cameligo/Pretty.ml → src/passes/01-parser/cameligo/Pretty.ml
View File

@ -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,14 +154,13 @@ 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 rest = List.map snd tail in
let head = pp_clause 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; _} =

47
src/passes/1-parser/pascaligo/Pretty.ml → src/passes/01-parser/pascaligo/Pretty.ml
View File

@ -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 :
@ -244,12 +250,11 @@ and pp_cases :
('a case_clause reg, vbar) Utils.nsepseq Region.reg -> document =
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 rest = List.map snd tail in
let app clause =
break 1 ^^ string "| " ^^ pp_case_clause printer clause
in head ^^ concat_map app rest
let head = pp_case_clause printer 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
in head ^^ concat_map app rest
and pp_case_clause :
'a.('a -> document) -> 'a case_clause Region.reg -> document =
@ -268,7 +273,7 @@ and pp_lhs : lhs -> document = function
and pp_loop = function
While l -> pp_while_loop l
| For f -> pp_for_loop f
| For f -> pp_for_loop f
and pp_while_loop {value; _} = string "TODO:pp_while_loop"
@ -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

23
src/passes/1-parser/cameligo/.links
View File

@ -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

25
src/passes/1-parser/pascaligo/.links
View File

@ -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

31
src/passes/1-parser/reasonligo/.links
View File

@ -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