* 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.
This commit is contained in:
parent
d0d495ccce
commit
2667c10990
@ -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
|
||||
|
@ -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,7 +424,7 @@ 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) |>
|
||||
@ -435,8 +435,7 @@ let mk_nat lexeme region =
|
||||
else Ok (Nat Region.{region; value = lexeme,z})
|
||||
|
||||
let mk_mutez lexeme region =
|
||||
let z =
|
||||
Str.(global_replace (regexp "_") "" lexeme) |>
|
||||
let z = Str.(global_replace (regexp "_") "" lexeme) |>
|
||||
Str.(global_replace (regexp "mutez") "") |>
|
||||
Z.of_string in
|
||||
if Z.equal z Z.zero && lexeme <> "0mutez"
|
||||
|
@ -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}
|
||||
|
@ -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 apply {value = attribute; region} =
|
||||
let attribute_formatted = sprintf "[@@%s]" attribute in
|
||||
print_token state region attribute_formatted
|
||||
) attributes
|
||||
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; _} =
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 *)
|
||||
|
||||
|
@ -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. *)
|
||||
|
@ -15,7 +15,8 @@ module type SubIO =
|
||||
ext : string;
|
||||
mode : [`Byte | `Point];
|
||||
cmd : EvalOpt.command;
|
||||
mono : bool
|
||||
mono : bool;
|
||||
pretty : bool
|
||||
>
|
||||
|
||||
val options : options
|
||||
|
@ -17,7 +17,8 @@ module type SubIO =
|
||||
ext : string;
|
||||
mode : [`Byte | `Point];
|
||||
cmd : EvalOpt.command;
|
||||
mono : bool
|
||||
mono : bool;
|
||||
pretty : bool
|
||||
>
|
||||
|
||||
val options : options
|
||||
|
Loading…
Reference in New Issue
Block a user