From 6f56b297f2bfcfe3ca0fd234a04441c6c34b952d Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 4 Jun 2020 19:01:31 +0200 Subject: [PATCH] Improved the pretty-printers. --- .../cameligo/Pretty.ml | 35 ++++++-------- .../pascaligo/Pretty.ml | 47 ++++++++++--------- src/passes/1-parser/cameligo/.links | 23 --------- src/passes/1-parser/pascaligo/.links | 25 ---------- src/passes/1-parser/reasonligo/.links | 31 ------------ 5 files changed, 41 insertions(+), 120 deletions(-) rename src/passes/{1-parser => 01-parser}/cameligo/Pretty.ml (91%) rename src/passes/{1-parser => 01-parser}/pascaligo/Pretty.ml (93%) delete mode 100644 src/passes/1-parser/cameligo/.links delete mode 100644 src/passes/1-parser/pascaligo/.links delete mode 100644 src/passes/1-parser/reasonligo/.links diff --git a/src/passes/1-parser/cameligo/Pretty.ml b/src/passes/01-parser/cameligo/Pretty.ml similarity index 91% rename from src/passes/1-parser/cameligo/Pretty.ml rename to src/passes/01-parser/cameligo/Pretty.ml index 0ab052a7a..50a16afb4 100644 --- a/src/passes/1-parser/cameligo/Pretty.ml +++ b/src/passes/01-parser/cameligo/Pretty.ml @@ -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; _} = diff --git a/src/passes/1-parser/pascaligo/Pretty.ml b/src/passes/01-parser/pascaligo/Pretty.ml similarity index 93% rename from src/passes/1-parser/pascaligo/Pretty.ml rename to src/passes/01-parser/pascaligo/Pretty.ml index 287a53608..37ee63569 100644 --- a/src/passes/1-parser/pascaligo/Pretty.ml +++ b/src/passes/01-parser/pascaligo/Pretty.ml @@ -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 diff --git a/src/passes/1-parser/cameligo/.links b/src/passes/1-parser/cameligo/.links deleted file mode 100644 index fc8466c8e..000000000 --- a/src/passes/1-parser/cameligo/.links +++ /dev/null @@ -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 \ No newline at end of file diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links deleted file mode 100644 index 45c9a4602..000000000 --- a/src/passes/1-parser/pascaligo/.links +++ /dev/null @@ -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 diff --git a/src/passes/1-parser/reasonligo/.links b/src/passes/1-parser/reasonligo/.links deleted file mode 100644 index 214b46e6c..000000000 --- a/src/passes/1-parser/reasonligo/.links +++ /dev/null @@ -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