From 2667c109909aada7ad650233700f163fa77fdfe4 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Fri, 1 May 2020 20:32:48 +0200 Subject: [PATCH] * Renamed [TStringLiteral] as [TString]. * LexToken.mll for CameLIGO: Fixed printing of "Str" into "String". * Added CLI option --pretty to call the pretty-printer from ParserMain. * Use the package Terminal_size to try to determine the width of the terminal where the source is pretty-printed. --- src/passes/1-parser/cameligo/AST.ml | 9 ++++--- src/passes/1-parser/cameligo/LexToken.mll | 17 ++++++------- src/passes/1-parser/cameligo/Parser.mly | 27 ++++++++++----------- src/passes/1-parser/cameligo/ParserLog.ml | 19 +++++++-------- src/passes/1-parser/cameligo/ParserMain.ml | 23 +++++++++++++++--- src/passes/1-parser/cameligo/Tests/pp.mligo | 17 +++++++------ src/passes/1-parser/shared/EvalOpt.ml | 14 ++++++++--- src/passes/1-parser/shared/EvalOpt.mli | 9 +++++-- src/passes/1-parser/shared/ParserUnit.ml | 3 ++- src/passes/1-parser/shared/ParserUnit.mli | 3 ++- 10 files changed, 87 insertions(+), 54 deletions(-) diff --git a/src/passes/1-parser/cameligo/AST.ml b/src/passes/1-parser/cameligo/AST.ml index df94dc783..bb05f4dbe 100644 --- a/src/passes/1-parser/cameligo/AST.ml +++ b/src/passes/1-parser/cameligo/AST.ml @@ -137,11 +137,14 @@ and ast = t and attributes = attribute list and declaration = - Let of (kwd_let * kwd_rec option * let_binding * attributes) reg + Let of let_decl | TypeDecl of type_decl reg (* Non-recursive values *) +and let_decl = + (kwd_let * kwd_rec option * let_binding * attributes) reg + and let_binding = { binders : pattern nseq; lhs_type : (colon * type_expr) option; @@ -166,7 +169,7 @@ and type_expr = | TFun of (type_expr * arrow * type_expr) reg | TPar of type_expr par reg | TVar of variable -| TStringLiteral of Lexer.lexeme reg +| TString of Lexer.lexeme reg and cartesian = (type_expr, times) nsepseq reg @@ -408,7 +411,7 @@ let type_expr_to_region = function | TApp {region; _} | TFun {region; _} | TPar {region; _} -| TStringLiteral {region; _} +| TString {region; _} | TVar {region; _} -> region let list_pattern_to_region = function diff --git a/src/passes/1-parser/cameligo/LexToken.mll b/src/passes/1-parser/cameligo/LexToken.mll index a87150cf7..823acb754 100644 --- a/src/passes/1-parser/cameligo/LexToken.mll +++ b/src/passes/1-parser/cameligo/LexToken.mll @@ -111,7 +111,7 @@ let proj_token = function (* Literals *) String Region.{region; value} -> - region, sprintf "Str %s" value + region, sprintf "String %s" value | Bytes Region.{region; value = s,b} -> region, sprintf "Bytes (\"%s\", \"0x%s\")" s (Hex.show b) @@ -424,21 +424,20 @@ type nat_err = | Non_canonical_zero_nat let mk_nat lexeme region = - match (String.index_opt lexeme 'n') with + match String.index_opt lexeme 'n' with None -> Error Invalid_natural | Some _ -> let z = - Str.(global_replace (regexp "_") "" lexeme) |> - Str.(global_replace (regexp "n") "") |> - Z.of_string in + Str.(global_replace (regexp "_") "" lexeme) |> + Str.(global_replace (regexp "n") "") |> + Z.of_string in if Z.equal z Z.zero && lexeme <> "0n" then Error Non_canonical_zero_nat else Ok (Nat Region.{region; value = lexeme,z}) let mk_mutez lexeme region = - let z = - Str.(global_replace (regexp "_") "" lexeme) |> - Str.(global_replace (regexp "mutez") "") |> - Z.of_string in + let z = Str.(global_replace (regexp "_") "" lexeme) |> + Str.(global_replace (regexp "mutez") "") |> + Z.of_string in if Z.equal z Z.zero && lexeme <> "0mutez" then Error Non_canonical_zero else Ok (Mutez Region.{region; value = lexeme, z}) diff --git a/src/passes/1-parser/cameligo/Parser.mly b/src/passes/1-parser/cameligo/Parser.mly index 12352480d..2aa57aad3 100644 --- a/src/passes/1-parser/cameligo/Parser.mly +++ b/src/passes/1-parser/cameligo/Parser.mly @@ -149,7 +149,7 @@ cartesian: core_type: type_name { TVar $1 } | par(type_expr) { TPar $1 } -| "" { TStringLiteral $1 } +| "" { TString $1 } | module_name "." type_name { let module_name = $1.value in let type_name = $3.value in @@ -456,15 +456,14 @@ case_clause(right_expr): let_expr(right_expr): "let" ioption("rec") let_binding seq(Attr) "in" right_expr { - let kwd_let = $1 - and kwd_rec = $2 - and binding = $3 - and attributes = $4 - and kwd_in = $5 - and body = $6 in - let stop = expr_to_region body in - let region = cover kwd_let stop - and value = {kwd_let; kwd_rec; binding; kwd_in; body; attributes} + let stop = expr_to_region $6 in + let region = cover $1 stop + and value = {kwd_let = $1; + kwd_rec = $2; + binding = $3; + attributes = $4; + kwd_in = $5; + body = $6} in ELetIn {region; value} } fun_expr(right_expr): @@ -475,8 +474,7 @@ fun_expr(right_expr): binders = $2; lhs_type = None; arrow = $3; - body = $4 - } + body = $4} in EFun {region; value} } disj_expr_level: @@ -651,7 +649,8 @@ update_record: field_path_assignment : nsepseq(field_name,".") "=" expr { - let region = cover (nsepseq_to_region (fun x -> x.region) $1) (expr_to_region $3) in + let start = nsepseq_to_region (fun x -> x.region) $1 in + let region = cover start (expr_to_region $3) in let value = {field_path = $1; assignment = $2; field_expr = $3} @@ -675,7 +674,7 @@ sequence: match $2 with None -> None, None | Some (ne_elements, terminator) -> - Some ne_elements, terminator in + Some ne_elements, terminator in let value = {compound; elements; terminator} in {region; value} } diff --git a/src/passes/1-parser/cameligo/ParserLog.ml b/src/passes/1-parser/cameligo/ParserLog.ml index 6ebe07c73..0c89ba266 100644 --- a/src/passes/1-parser/cameligo/ParserLog.ml +++ b/src/passes/1-parser/cameligo/ParserLog.ml @@ -130,11 +130,10 @@ let rec print_tokens state {decl;eof} = print_token state eof "EOF" and print_attributes state attributes = - List.iter ( - fun ({value = attribute; region}) -> - let attribute_formatted = sprintf "[@@%s]" attribute in - print_token state region attribute_formatted - ) attributes + let apply {value = attribute; region} = + let attribute_formatted = sprintf "[@@%s]" attribute in + print_token state region attribute_formatted + in List.iter apply attributes and print_statement state = function Let {value=kwd_let, kwd_rec, let_binding, attributes; _} -> @@ -156,7 +155,7 @@ and print_type_expr state = function | TPar par -> print_type_par state par | TVar var -> print_var state var | TFun t -> print_fun_type state t -| TStringLiteral s -> print_string state s +| TString s -> print_string state s and print_fun_type state {value; _} = let domain, arrow, range = value in @@ -1119,14 +1118,14 @@ and pp_type_expr state = function pp_type_expr (state#pad len rank) in let domain, _, range = value in List.iteri (apply 2) [domain; range] - | TPar {value={inside;_}; region} -> +| TPar {value={inside;_}; region} -> pp_loc_node state "TPar" region; pp_type_expr (state#pad 1 0) inside - | TVar v -> +| TVar v -> pp_node state "TVar"; pp_ident (state#pad 1 0) v - | TStringLiteral s -> - pp_node state "String"; +| TString s -> + pp_node state "TString"; pp_string (state#pad 1 0) s and pp_type_tuple state {value; _} = diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml index a3d13f3cc..60b89c7c3 100644 --- a/src/passes/1-parser/cameligo/ParserMain.ml +++ b/src/passes/1-parser/cameligo/ParserMain.ml @@ -22,7 +22,8 @@ module SubIO = ext : string; mode : [`Byte | `Point]; cmd : EvalOpt.command; - mono : bool + mono : bool; + pretty : bool > let options : options = @@ -36,6 +37,7 @@ module SubIO = method mode = IO.options#mode method cmd = IO.options#cmd method mono = IO.options#mono + method pretty = IO.options#pretty end let make = @@ -48,6 +50,7 @@ module SubIO = ~mode:options#mode ~cmd:options#cmd ~mono:options#mono + ~pretty:options#pretty end module Parser = @@ -72,9 +75,23 @@ module Unit = (* Main *) let wrap = function - Stdlib.Ok _ -> flush_all () + Stdlib.Ok ast -> + if IO.options#pretty then + begin + let doc = Pretty.make ast in + let width = + match Terminal_size.get_columns () with + None -> 60 + | Some c -> c in + PPrint.ToChannel.pretty 1.0 width stdout doc; + print_newline () + end; + flush_all () | Error msg -> - (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value) + begin + flush_all (); + Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value + end let () = match IO.options#input with diff --git a/src/passes/1-parser/cameligo/Tests/pp.mligo b/src/passes/1-parser/cameligo/Tests/pp.mligo index d84c270aa..ca4236e8f 100644 --- a/src/passes/1-parser/cameligo/Tests/pp.mligo +++ b/src/passes/1-parser/cameligo/Tests/pp.mligo @@ -1,20 +1,21 @@ -type q = {a: int; b: {c: string}} type r = int list -type s = (int, address) map type t = int -type u = {a: int; b: t * char} +type s = (int,address) map +type w = timestamp * nat -> (string, address) map -> t type v = int * (string * address) -type w = timestamp * nat -> (string, address) map +type u = {a: int; b: t * char} +type q = {a: int; b: {c: string}} type x = A | B of t * int | C of int -> (string -> int) - -let x = 4 -let y : t = (if true then -3 + f x x else 0) - 1 -let f (x: int) y = (x : int) +type y = "foo" +let x (_, (y: char)) = 4 +let y {x=(_,y); z=3} = x let z : (t) = y let w = match f 3 with None -> [] | Some (1::[2;3]) -> [4;5]::[] +let y : t = (if true then -3 + f x x else 0) - 1 +let f (x: int) y = (x : int) let n : nat = 0n let a = A let b = B a diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 8cb22608d..314b04bb9 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -29,11 +29,12 @@ type options = < mode : [`Byte | `Point]; cmd : command; mono : bool; - expr : bool + expr : bool; + pretty : bool > let make ~input ~libs ~verbose ~offsets ?block - ?line ~ext ~mode ~cmd ~mono ~expr : options = + ?line ~ext ~mode ~cmd ~mono ~expr ~pretty : options = object method input = input method libs = libs @@ -46,6 +47,7 @@ let make ~input ~libs ~verbose ~offsets ?block method cmd = cmd method mono = mono method expr = expr + method pretty = pretty end (* Auxiliary functions *) @@ -77,6 +79,7 @@ let help extension () = print " --bytes Bytes for source locations"; print " --mono Use Menhir monolithic API"; print " --expr Parse an expression"; + print " --pretty Pretty-print the input"; print " --verbose= cli, preproc, ast-tokens, ast (colon-separated)"; print " --version Commit hash on stdout"; print " -h, --help This help"; @@ -100,6 +103,7 @@ and libs = ref [] and verb_str = ref "" and mono = ref false and expr = ref false +and pretty = ref false let split_at_colon = Str.(split (regexp ":")) @@ -121,6 +125,7 @@ let specs extension = noshort, "bytes", set bytes true, None; noshort, "mono", set mono true, None; noshort, "expr", set expr true, None; + noshort, "pretty", set pretty true, None; noshort, "verbose", None, Some add_verbose; 'h', "help", Some (help extension), None; noshort, "version", Some version, None @@ -156,6 +161,7 @@ let print_opt () = printf "bytes = %b\n" !bytes; printf "mono = %b\n" !mono; printf "expr = %b\n" !expr; + printf "pretty = %b\n" !pretty; printf "verbose = %s\n" !verb_str; printf "input = %s\n" (string_of quote !input); printf "libs = %s\n" (string_of_path !libs) @@ -185,6 +191,7 @@ let check ?block ?line ~ext = and mono = !mono and expr = !expr and verbose = !verbose + and pretty = !pretty and libs = !libs in let () = @@ -199,6 +206,7 @@ let check ?block ?line ~ext = printf "mode = %s\n" (if mode = `Byte then "`Byte" else "`Point"); printf "mono = %b\n" mono; printf "expr = %b\n" expr; + printf "pretty = %b\n" pretty; printf "verbose = %s\n" !verb_str; printf "input = %s\n" (string_of quote input); printf "libs = %s\n" (string_of_path libs) @@ -214,7 +222,7 @@ let check ?block ?line ~ext = | _ -> abort "Choose one of -q, -c, -u, -t." in make ~input ~libs ~verbose ~offsets ~mode - ~cmd ~mono ~expr ?block ?line ~ext + ~cmd ~mono ~expr ?block ?line ~ext ~pretty (* Parsing the command-line options *) diff --git a/src/passes/1-parser/shared/EvalOpt.mli b/src/passes/1-parser/shared/EvalOpt.mli index 2e7e7f3cd..098726fba 100644 --- a/src/passes/1-parser/shared/EvalOpt.mli +++ b/src/passes/1-parser/shared/EvalOpt.mli @@ -47,7 +47,10 @@ type command = Quiet | Copy | Units | Tokens {li If the field [expr] is [true], then the parser for expressions is used, otherwise a full-fledged contract is expected.} -} *) + + {li If the field [pretty] is [true], then the source is + pretty-printed on the standard out.} + } *) module SSet : Set.S with type elt = string and type t = Set.Make(String).t @@ -67,7 +70,8 @@ type options = < mode : [`Byte | `Point]; cmd : command; mono : bool; - expr : bool + expr : bool; + pretty : bool > val make : @@ -82,6 +86,7 @@ val make : cmd:command -> mono:bool -> expr:bool -> + pretty:bool -> options (** Parsing the command-line options on stdin. *) diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml index dfaa888c7..0e7f4eb88 100644 --- a/src/passes/1-parser/shared/ParserUnit.ml +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -15,7 +15,8 @@ module type SubIO = ext : string; mode : [`Byte | `Point]; cmd : EvalOpt.command; - mono : bool + mono : bool; + pretty : bool > val options : options diff --git a/src/passes/1-parser/shared/ParserUnit.mli b/src/passes/1-parser/shared/ParserUnit.mli index a9456ab8c..a2199ec4e 100644 --- a/src/passes/1-parser/shared/ParserUnit.mli +++ b/src/passes/1-parser/shared/ParserUnit.mli @@ -17,7 +17,8 @@ module type SubIO = ext : string; mode : [`Byte | `Point]; cmd : EvalOpt.command; - mono : bool + mono : bool; + pretty : bool > val options : options