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

* Renamed [TStringLiteral] as [TString].

Browse Source 
* 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.
This commit is contained in:
Christian Rinderknecht 2020-05-01 20:32:48 +02:00
parent d0d495ccce
commit 2667c10990
10 changed files with 87 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/passes/1-parser/cameligo/AST.ml
View File

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

17
src/passes/1-parser/cameligo/LexToken.mll
View File

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

27
src/passes/1-parser/cameligo/Parser.mly
View File

@ -149,7 +149,7 @@ cartesian:
core_type:
type_name { TVar $1 }
| par(type_expr) { TPar $1 }
| "<string>" { TStringLiteral $1 }
| "<string>" { 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} }

19
src/passes/1-parser/cameligo/ParserLog.ml
View File

@ -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; _} =

23
src/passes/1-parser/cameligo/ParserMain.ml
View File

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

17
src/passes/1-parser/cameligo/Tests/pp.mligo
View File

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

14
src/passes/1-parser/shared/EvalOpt.ml
View File

@ -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=<stages> 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 *)

9
src/passes/1-parser/shared/EvalOpt.mli
View File

@ -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. *)

3
src/passes/1-parser/shared/ParserUnit.ml
View File

@ -15,7 +15,8 @@ module type SubIO =
ext : string;
mode : [`Byte | `Point];
cmd : EvalOpt.command;
mono : bool
mono : bool;
pretty : bool
>
val options : options

3
src/passes/1-parser/shared/ParserUnit.mli
View File

@ -17,7 +17,8 @@ module type SubIO =
ext : string;
mode : [`Byte | `Point];
cmd : EvalOpt.command;
mono : bool
mono : bool;
pretty : bool
>
val options : options