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

Added more to the PascaLIGO pretty-printer.

Browse Source 
Improved the AST of PascaLIGO to better capture the struture.
This commit is contained in:
Christian Rinderknecht 2020-05-30 20:24:47 +02:00
parent 3264277310
commit 2d74681c96
11 changed files with 751 additions and 285 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/main/compile/helpers.ml
View File

@ -192,7 +192,7 @@ let pretty_print_pascaligo source =
let pretty_print_cameligo source = let pretty_print_cameligo source =
let%bind ast = Parser.Cameligo.parse_file source in let%bind ast = Parser.Cameligo.parse_file source in
let doc = Parser_cameligo.Pretty.make ast in let doc = Parser_cameligo.Pretty.print ast in
let buffer = Buffer.create 131 in let buffer = Buffer.create 131 in
let width = let width =
match Terminal_size.get_columns () with match Terminal_size.get_columns () with
@ -203,7 +203,7 @@ let pretty_print_cameligo source =
let pretty_print_reasonligo source = let pretty_print_reasonligo source =
let%bind ast = Parser.Reasonligo.parse_file source in let%bind ast = Parser.Reasonligo.parse_file source in
let doc = Parser_cameligo.Pretty.make ast in (* TODO *) let doc = Parser_cameligo.Pretty.print ast in (* TODO *)
let buffer = Buffer.create 131 in let buffer = Buffer.create 131 in
let width = let width =
match Terminal_size.get_columns () with match Terminal_size.get_columns () with

2
src/passes/1-parser/cameligo.ml
View File

@ -157,7 +157,7 @@ let pretty_print source =
match parse_file source with match parse_file source with
Stdlib.Error _ as e -> e Stdlib.Error _ as e -> e
| Ok ast -> | Ok ast ->
let doc = Pretty.make (fst ast) in let doc = Pretty.print (fst ast) in
let buffer = Buffer.create 131 in let buffer = Buffer.create 131 in
let width = let width =
match Terminal_size.get_columns () with match Terminal_size.get_columns () with

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

@ -78,7 +78,7 @@ let wrap = function
Stdlib.Ok ast -> Stdlib.Ok ast ->
if IO.options#pretty then if IO.options#pretty then
begin begin
let doc = Pretty.make ast in let doc = Pretty.print ast in
let width = let width =
match Terminal_size.get_columns () with match Terminal_size.get_columns () with
None -> 60 None -> 60

20
src/passes/1-parser/cameligo/Pretty.ml
View File

@ -5,11 +5,13 @@ module Region = Simple_utils.Region
open! Region open! Region
open! PPrint open! PPrint
(*let paragraph (s : string) = flow (break 1) (words s)*) let pp_par printer {value; _} =
string "(" ^^ nest 1 (printer value.inside ^^ string ")")
let rec make ast = let rec print ast =
let app decl = group (pp_declaration decl) in let app decl = group (pp_declaration decl) in
separate_map (hardline ^^ hardline) app (Utils.nseq_to_list ast.decl) let decl = Utils.nseq_to_list ast.decl in
separate_map (hardline ^^ hardline) app decl
and pp_declaration = function and pp_declaration = function
Let decl -> pp_let_decl decl Let decl -> pp_let_decl decl
@ -90,8 +92,7 @@ and pp_nat {value; _} =
and pp_bytes {value; _} = and pp_bytes {value; _} =
string ("0x" ^ Hex.show (snd value)) string ("0x" ^ Hex.show (snd value))
and pp_ppar {value; _} = and pp_ppar p = pp_par pp_pattern p
string "(" ^^ nest 1 (pp_pattern value.inside ^^ string ")")
and pp_plist = function and pp_plist = function
PListComp cmp -> pp_list_comp cmp PListComp cmp -> pp_list_comp cmp
@ -345,8 +346,7 @@ and pp_tuple_expr {value; _} =
then pp_expr head then pp_expr head
else pp_expr head ^^ string "," ^^ app (List.map snd tail) else pp_expr head ^^ string "," ^^ app (List.map snd tail)
and pp_par_expr {value; _} = and pp_par_expr e = pp_par pp_expr e
string "(" ^^ nest 1 (pp_expr value.inside ^^ string ")")
and pp_let_in {value; _} = and pp_let_in {value; _} =
let {binding; kwd_rec; body; attributes; _} = value in let {binding; kwd_rec; body; attributes; _} = value in
@ -425,8 +425,7 @@ and pp_field_decl {value; _} =
let t_expr = pp_type_expr field_type let t_expr = pp_type_expr field_type
in prefix 2 1 (name ^^ string " :") t_expr in prefix 2 1 (name ^^ string " :") t_expr
and pp_type_app {value; _} = and pp_type_app {value = ctor, tuple; _} =
let ctor, tuple = value in
prefix 2 1 (pp_type_tuple tuple) (pp_type_constr ctor) prefix 2 1 (pp_type_tuple tuple) (pp_type_constr ctor)
and pp_type_tuple {value; _} = and pp_type_tuple {value; _} =
@ -449,5 +448,4 @@ and pp_fun_type {value; _} =
let lhs, _, rhs = value in let lhs, _, rhs = value in
group (pp_type_expr lhs ^^ string " ->" ^/^ pp_type_expr rhs) group (pp_type_expr lhs ^^ string " ->" ^/^ pp_type_expr rhs)
and pp_type_par {value; _} = and pp_type_par t = pp_par pp_type_expr t
string "(" ^^ nest 1 (pp_type_expr value.inside ^^ string ")")

126
src/passes/1-parser/pascaligo/AST.ml
View File

@ -106,14 +106,15 @@ type eof = Region.t
(* Literals *) (* Literals *)
type variable = string reg type variable = string reg
type fun_name = string reg type fun_name = string reg
type type_name = string reg type type_name = string reg
type field_name = string reg type type_constr = string reg
type map_name = string reg type field_name = string reg
type set_name = string reg type map_name = string reg
type constr = string reg type set_name = string reg
type attribute = string reg type constr = string reg
type attribute = string reg
(* Parentheses *) (* Parentheses *)
@ -181,7 +182,7 @@ and type_expr =
TProd of cartesian TProd of cartesian
| TSum of (variant reg, vbar) nsepseq reg | TSum of (variant reg, vbar) nsepseq reg
| TRecord of field_decl reg ne_injection reg | TRecord of field_decl reg ne_injection reg
| TApp of (type_name * type_tuple) reg | TApp of (type_constr * type_tuple) reg
| TFun of (type_expr * arrow * type_expr) reg | TFun of (type_expr * arrow * type_expr) reg
| TPar of type_expr par reg | TPar of type_expr par reg
| TVar of variable | TVar of variable
@ -249,19 +250,14 @@ and param_var = {
} }
and block = { and block = {
opening : block_opening; enclosing : block_enclosing;
statements : statements; statements : statements;
terminator : semi option; terminator : semi option
closing : block_closing
} }
and block_opening = and block_enclosing =
Block of kwd_block * lbrace Block of kwd_block * lbrace * rbrace
| Begin of kwd_begin | BeginEnd of kwd_begin * kwd_end
and block_closing =
Block of rbrace
| End of kwd_end
and statements = (statement, semi) nsepseq and statements = (statement, semi) nsepseq
@ -378,10 +374,10 @@ and set_membership = {
and 'a case = { and 'a case = {
kwd_case : kwd_case; kwd_case : kwd_case;
expr : expr; expr : expr;
opening : opening; kwd_of : kwd_of;
enclosing : enclosing;
lead_vbar : vbar option; lead_vbar : vbar option;
cases : ('a case_clause reg, vbar) nsepseq reg; cases : ('a case_clause reg, vbar) nsepseq reg
closing : closing
} }
and 'a case_clause = { and 'a case_clause = {
@ -471,34 +467,12 @@ and expr =
| EPar of expr par reg | EPar of expr par reg
| EFun of fun_expr reg | EFun of fun_expr reg
and annot_expr = (expr * type_expr) and annot_expr = expr * type_expr
and set_expr = and set_expr =
SetInj of expr injection reg SetInj of expr injection reg
| SetMem of set_membership reg | SetMem of set_membership reg
and 'a injection = {
opening : opening;
elements : ('a, semi) sepseq;
terminator : semi option;
closing : closing
}
and 'a ne_injection = {
opening : opening;
ne_elements : ('a, semi) nsepseq;
terminator : semi option;
closing : closing
}
and opening =
Kwd of keyword
| KwdBracket of keyword * lbracket
and closing =
End of kwd_end
| RBracket of rbracket
and map_expr = and map_expr =
MapLookUp of map_lookup reg MapLookUp of map_lookup reg
| MapInj of binding reg injection reg | MapInj of binding reg injection reg
@ -520,7 +494,7 @@ and logic_expr =
and bool_expr = and bool_expr =
Or of kwd_or bin_op reg Or of kwd_or bin_op reg
| And of kwd_and bin_op reg | And of kwd_and bin_op reg
| Not of kwd_not un_op reg | Not of kwd_not un_op reg
| False of c_False | False of c_False
| True of c_True | True of c_True
@ -544,15 +518,15 @@ and comp_expr =
| Neq of neq bin_op reg | Neq of neq bin_op reg
and arith_expr = and arith_expr =
Add of plus bin_op reg Add of plus bin_op reg
| Sub of minus bin_op reg | Sub of minus bin_op reg
| Mult of times bin_op reg | Mult of times bin_op reg
| Div of slash bin_op reg | Div of slash bin_op reg
| Mod of kwd_mod bin_op reg | Mod of kwd_mod bin_op reg
| Neg of minus un_op reg | Neg of minus un_op reg
| Int of (Lexer.lexeme * Z.t) reg | Int of (Lexer.lexeme * Z.t) reg
| Nat of (Lexer.lexeme * Z.t) reg | Nat of (Lexer.lexeme * Z.t) reg
| Mutez of (Lexer.lexeme * Z.t) reg | Mutez of (Lexer.lexeme * Z.t) reg
and string_expr = and string_expr =
Cat of cat bin_op reg Cat of cat bin_op reg
@ -584,14 +558,14 @@ and projection = {
} }
and update = { and update = {
record : path; record : path;
kwd_with : kwd_with; kwd_with : kwd_with;
updates : field_path_assign reg ne_injection reg updates : field_path_assign reg ne_injection reg
} }
and field_path_assign = { and field_path_assign = {
field_path : (field_name, dot) nsepseq; field_path : (field_name, dot) nsepseq;
equal : equal; equal : equal;
field_expr : expr field_expr : expr
} }
@ -605,6 +579,38 @@ and fun_call = (expr * arguments) reg
and arguments = tuple_expr and arguments = tuple_expr
(* Injections *)
and 'a injection = {
kind : injection_kwd;
enclosing : enclosing;
elements : ('a, semi) sepseq;
terminator : semi option
}
and injection_kwd =
InjSet of keyword
| InjMap of keyword
| InjBigMap of keyword
| InjList of keyword
and enclosing =
Brackets of lbracket * rbracket
| End of kwd_end
and 'a ne_injection = {
kind : ne_injection_kwd;
enclosing : enclosing;
ne_elements : ('a, semi) nsepseq;
terminator : semi option
}
and ne_injection_kwd =
NEInjAttr of keyword
| NEInjSet of keyword
| NEInjMap of keyword
| NEInjRecord of keyword
(* Patterns *) (* Patterns *)
and pattern = and pattern =
@ -635,7 +641,7 @@ and list_pattern =
| PCons of (pattern, cons) nsepseq reg | PCons of (pattern, cons) nsepseq reg
(* Projecting regions *) (* PROJECTING REGIONS *)
let rec last to_region = function let rec last to_region = function
[] -> Region.ghost [] -> Region.ghost

258
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -122,7 +122,8 @@ attr_decl:
open_attr_decl ";"? { $1 } open_attr_decl ";"? { $1 }
open_attr_decl: open_attr_decl:
ne_injection("attributes","<string>") { $1 } ne_injection("attributes","<string>") {
$1 (fun region -> NEInjAttr region) }
(* Type declarations *) (* Type declarations *)
@ -214,19 +215,19 @@ record_type:
let () = Utils.nsepseq_to_list ne_elements let () = Utils.nsepseq_to_list ne_elements
|> Scoping.check_fields in |> Scoping.check_fields in
let region = cover $1 $3 let region = cover $1 $3
and value = {opening = Kwd $1; and value = {kind = NEInjRecord $1;
enclosing = End $3;
ne_elements; ne_elements;
terminator; terminator}
closing = End $3}
in TRecord {region; value} in TRecord {region; value}
} }
| "record" "[" sep_or_term_list(field_decl,";") "]" { | "record" "[" sep_or_term_list(field_decl,";") "]" {
let ne_elements, terminator = $3 in let ne_elements, terminator = $3 in
let region = cover $1 $4 let region = cover $1 $4
and value = {opening = KwdBracket ($1,$2); and value = {kind = NEInjRecord $1;
enclosing = Brackets ($2,$4);
ne_elements; ne_elements;
terminator; terminator}
closing = RBracket $4}
in TRecord {region; value} } in TRecord {region; value} }
field_decl: field_decl:
@ -238,7 +239,7 @@ field_decl:
fun_expr: fun_expr:
| ioption ("recursive") "function" parameters ":" type_expr "is" expr { ioption ("recursive") "function" parameters ":" type_expr "is" expr {
let stop = expr_to_region $7 in let stop = expr_to_region $7 in
let region = cover $2 stop let region = cover $2 stop
and value = {kwd_recursive= $1; and value = {kwd_recursive= $1;
@ -271,7 +272,8 @@ open_fun_decl:
attributes = None} attributes = None}
in {region; value} in {region; value}
} }
| ioption ("recursive") "function" fun_name parameters ":" type_expr "is" expr { | ioption ("recursive") "function" fun_name parameters ":" type_expr "is"
expr {
Scoping.check_reserved_name $3; Scoping.check_reserved_name $3;
let stop = expr_to_region $8 in let stop = expr_to_region $8 in
let region = cover $2 stop let region = cover $2 stop
@ -326,19 +328,17 @@ block:
"begin" sep_or_term_list(statement,";") "end" { "begin" sep_or_term_list(statement,";") "end" {
let statements, terminator = $2 in let statements, terminator = $2 in
let region = cover $1 $3 let region = cover $1 $3
and value = {opening = Begin $1; and value = {enclosing = BeginEnd ($1,$3);
statements; statements;
terminator; terminator}
closing = End $3}
in {region; value} in {region; value}
} }
| "block" "{" sep_or_term_list(statement,";") "}" { | "block" "{" sep_or_term_list(statement,";") "}" {
let statements, terminator = $3 in let statements, terminator = $3 in
let region = cover $1 $4 let region = cover $1 $4
and value = {opening = Block ($1,$2); and value = {enclosing = Block ($1,$2,$4);
statements; statements;
terminator; terminator}
closing = Block $4}
in {region; value} } in {region; value} }
statement: statement:
@ -404,124 +404,122 @@ instruction:
set_remove: set_remove:
"remove" expr "from" "set" path { "remove" expr "from" "set" path {
let region = cover $1 (path_to_region $5) in let region = cover $1 (path_to_region $5) in
let value = { let value = {kwd_remove = $1;
kwd_remove = $1; element = $2;
element = $2; kwd_from = $3;
kwd_from = $3; kwd_set = $4;
kwd_set = $4; set = $5}
set = $5}
in {region; value} } in {region; value} }
map_remove: map_remove:
"remove" expr "from" "map" path { "remove" expr "from" "map" path {
let region = cover $1 (path_to_region $5) in let region = cover $1 (path_to_region $5) in
let value = { let value = {kwd_remove = $1;
kwd_remove = $1; key = $2;
key = $2; kwd_from = $3;
kwd_from = $3; kwd_map = $4;
kwd_map = $4; map = $5}
map = $5}
in {region; value} } in {region; value} }
set_patch: set_patch:
"patch" path "with" ne_injection("set",expr) { "patch" path "with" ne_injection("set",expr) {
let region = cover $1 $4.region in let set_inj = $4 (fun region -> NEInjSet region) in
let value = { let region = cover $1 set_inj.region in
kwd_patch = $1; let value = {kwd_patch = $1;
path = $2; path = $2;
kwd_with = $3; kwd_with = $3;
set_inj = $4} set_inj}
in {region; value} } in {region; value} }
map_patch: map_patch:
"patch" path "with" ne_injection("map",binding) { "patch" path "with" ne_injection("map",binding) {
let region = cover $1 $4.region in let map_inj = $4 (fun region -> NEInjMap region) in
let value = { let region = cover $1 map_inj.region in
kwd_patch = $1; let value = {kwd_patch = $1;
path = $2; path = $2;
kwd_with = $3; kwd_with = $3;
map_inj = $4} map_inj}
in {region; value} } in {region; value} }
injection(Kind,element): injection(Kind,element):
Kind sep_or_term_list(element,";") "end" { Kind sep_or_term_list(element,";") "end" {
let elements, terminator = $2 in fun mk_kwd ->
let region = cover $1 $3 let elements, terminator = $2 in
and value = { let region = cover $1 $3
opening = Kwd $1; and value = {
elements = Some elements; kind = mk_kwd $1;
terminator; enclosing = End $3;
closing = End $3} elements = Some elements;
in {region; value} terminator}
in {region; value}
} }
| Kind "end" { | Kind "end" {
let region = cover $1 $2 fun mk_kwd ->
and value = { let region = cover $1 $2
opening = Kwd $1; and value = {kind = mk_kwd $1;
elements = None; enclosing = End $2;
terminator = None; elements = None;
closing = End $2} terminator = None}
in {region; value} in {region; value}
} }
| Kind "[" sep_or_term_list(element,";") "]" { | Kind "[" sep_or_term_list(element,";") "]" {
let elements, terminator = $3 in fun mk_kwd ->
let region = cover $1 $4 let elements, terminator = $3 in
and value = { let region = cover $1 $4
opening = KwdBracket ($1,$2); and value = {kind = mk_kwd $1;
elements = Some elements; enclosing = Brackets ($2,$4);
terminator; elements = Some elements;
closing = RBracket $4} terminator}
in {region; value} in {region; value}
} }
| Kind "[" "]" { | Kind "[" "]" {
let region = cover $1 $3 fun mk_kwd ->
and value = { let region = cover $1 $3
opening = KwdBracket ($1,$2); and value = {kind = mk_kwd $1;
elements = None; enclosing = Brackets ($2,$3);
terminator = None; elements = None;
closing = RBracket $3} terminator = None}
in {region; value} } in {region; value} }
ne_injection(Kind,element): ne_injection(Kind,element):
Kind sep_or_term_list(element,";") "end" { Kind sep_or_term_list(element,";") "end" {
let ne_elements, terminator = $2 in fun mk_kwd ->
let region = cover $1 $3 let ne_elements, terminator = $2 in
and value = { let region = cover $1 $3
opening = Kwd $1; and value = {kind = mk_kwd $1;
ne_elements; enclosing = End $3;
terminator; ne_elements;
closing = End $3} terminator}
in {region; value} in {region; value}
} }
| Kind "[" sep_or_term_list(element,";") "]" { | Kind "[" sep_or_term_list(element,";") "]" {
let ne_elements, terminator = $3 in fun mk_kwd ->
let region = cover $1 $4 let ne_elements, terminator = $3 in
and value = { let region = cover $1 $4
opening = KwdBracket ($1,$2); and value = {kind = mk_kwd $1;
ne_elements; enclosing = Brackets ($2,$4);
terminator; ne_elements;
closing = RBracket $4} terminator}
in {region; value} } in {region; value} }
binding: binding:
expr "->" expr { expr "->" expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop let region = cover start stop
and value = { and value = {source = $1;
source = $1; arrow = $2;
arrow = $2; image = $3}
image = $3}
in {region; value} } in {region; value} }
record_patch: record_patch:
"patch" path "with" ne_injection("record",field_assignment) { "patch" path "with" ne_injection("record",field_assignment) {
let region = cover $1 $4.region in let record_inj = $4 (fun region -> NEInjRecord region) in
let value = { let region = cover $1 record_inj.region in
kwd_patch = $1; let value = {kwd_patch = $1;
path = $2; path = $2;
kwd_with = $3; kwd_with = $3;
record_inj = $4} record_inj}
in {region; value} } in {region; value} }
proc_call: proc_call:
@ -547,12 +545,9 @@ if_clause:
clause_block: clause_block:
block { LongBlock $1 } block { LongBlock $1 }
| "{" sep_or_term_list(statement,";") "}" { | "{" sep_or_term_list(statement,";") "}" {
let statements, terminator = $2 in
let region = cover $1 $3 in let region = cover $1 $3 in
let value = {lbrace = $1; let value = {lbrace=$1; inside=$2; rbrace=$3}
inside = statements, terminator; in ShortBlock {value; region} }
rbrace = $3} in
ShortBlock {value; region} }
case_instr: case_instr:
case(if_clause) { $1 if_clause_to_region } case(if_clause) { $1 if_clause_to_region }
@ -563,10 +558,10 @@ case(rhs):
let region = cover $1 $6 in let region = cover $1 $6 in
let value = {kwd_case = $1; let value = {kwd_case = $1;
expr = $2; expr = $2;
opening = Kwd $3; kwd_of = $3;
enclosing = End $6;
lead_vbar = $4; lead_vbar = $4;
cases = $5 rhs_to_region; cases = $5 rhs_to_region}
closing = End $6}
in {region; value} in {region; value}
} }
| "case" expr "of" "[" "|"? cases(rhs) "]" { | "case" expr "of" "[" "|"? cases(rhs) "]" {
@ -574,10 +569,10 @@ case(rhs):
let region = cover $1 $7 in let region = cover $1 $7 in
let value = {kwd_case = $1; let value = {kwd_case = $1;
expr = $2; expr = $2;
opening = KwdBracket ($3,$4); kwd_of = $3;
enclosing = Brackets ($4,$7);
lead_vbar = $5; lead_vbar = $5;
cases = $6 rhs_to_region; cases = $6 rhs_to_region}
closing = RBracket $7}
in {region; value} } in {region; value} }
cases(rhs): cases(rhs):
@ -904,12 +899,17 @@ annot_expr:
in {region; value} } in {region; value} }
set_expr: set_expr:
injection("set",expr) { SetInj $1 } injection("set",expr) { SetInj ($1 (fun region -> InjSet region)) }
map_expr: map_expr:
map_lookup { MapLookUp $1 } map_lookup {
| injection("map",binding) { MapInj $1 } MapLookUp $1
| injection("big_map",binding) { BigMapInj $1 } }
| injection("map",binding) {
MapInj ($1 (fun region -> InjMap region))
}
| injection("big_map",binding) {
BigMapInj ($1 (fun region -> InjBigMap region)) }
map_lookup: map_lookup:
path brackets(expr) { path brackets(expr) {
@ -958,26 +958,27 @@ record_expr:
let ne_elements, terminator = $2 in let ne_elements, terminator = $2 in
let region = cover $1 $3 let region = cover $1 $3
and value : field_assign AST.reg ne_injection = { and value : field_assign AST.reg ne_injection = {
opening = Kwd $1; kind = NEInjRecord $1;
enclosing = End $3;
ne_elements; ne_elements;
terminator; terminator}
closing = End $3}
in {region; value} in {region; value}
} }
| "record" "[" sep_or_term_list(field_assignment,";") "]" { | "record" "[" sep_or_term_list(field_assignment,";") "]" {
let ne_elements, terminator = $3 in let ne_elements, terminator = $3 in
let region = cover $1 $4 let region = cover $1 $4
and value : field_assign AST.reg ne_injection = { and value : field_assign AST.reg ne_injection = {
opening = KwdBracket ($1,$2); kind = NEInjRecord $1;
ne_elements; enclosing = Brackets ($2,$4);
terminator; ne_elements;
closing = RBracket $4} terminator}
in {region; value} } in {region; value} }
update_record: update_record:
path "with" ne_injection("record",field_path_assignment){ path "with" ne_injection("record",field_path_assignment) {
let region = cover (path_to_region $1) $3.region in let updates = $3 (fun region -> NEInjRecord region) in
let value = {record=$1; kwd_with=$2; updates=$3} let region = cover (path_to_region $1) updates.region in
let value = {record=$1; kwd_with=$2; updates}
in {region; value} } in {region; value} }
field_assignment: field_assignment:
@ -1010,8 +1011,8 @@ arguments:
par(nsepseq(expr,",")) { $1 } par(nsepseq(expr,",")) { $1 }
list_expr: list_expr:
injection("list",expr) { EListComp $1 } injection("list",expr) { EListComp ($1 (fun region -> InjList region)) }
| "nil" { ENil $1 } | "nil" { ENil $1 }
(* Patterns *) (* Patterns *)
@ -1034,9 +1035,10 @@ core_pattern:
| constr_pattern { PConstr $1 } | constr_pattern { PConstr $1 }
list_pattern: list_pattern:
injection("list",core_pattern) { PListComp $1 } "nil" { PNil $1 }
| "nil" { PNil $1 }
| par(cons_pattern) { PParCons $1 } | par(cons_pattern) { PParCons $1 }
| injection("list",core_pattern) {
PListComp ($1 (fun region -> InjList region)) }
cons_pattern: cons_pattern:
core_pattern "#" pattern { $1,$2,$3 } core_pattern "#" pattern { $1,$2,$3 }

177
src/passes/1-parser/pascaligo/ParserLog.ml
View File

@ -27,11 +27,11 @@ let mk_state ~offsets ~mode ~buffer =
val pad_node = "" val pad_node = ""
method pad_node = pad_node method pad_node = pad_node
(** The method [pad] updates the current padding, which is (* The method [pad] updates the current padding, which is
comprised of two components: the padding to reach the new node comprised of two components: the padding to reach the new node
(space before reaching a subtree, then a vertical bar for it) (space before reaching a subtree, then a vertical bar for it)
and the padding for the new node itself (Is it the last child and the padding for the new node itself (Is it the last child
of its parent?). of its parent?).
*) *)
method pad arity rank = method pad arity rank =
{< pad_path = {< pad_path =
@ -44,7 +44,7 @@ let mk_state ~offsets ~mode ~buffer =
let compact state (region: Region.t) = let compact state (region: Region.t) =
region#compact ~offsets:state#offsets state#mode region#compact ~offsets:state#offsets state#mode
(** {1 Printing the tokens with their source regions} *) (* Printing the tokens with their source regions *)
let print_nsepseq : let print_nsepseq :
state -> string -> (state -> 'a -> unit) -> state -> string -> (state -> 'a -> unit) ->
@ -117,7 +117,7 @@ let rec print_tokens state ast =
print_token state eof "EOF" print_token state eof "EOF"
and print_attr_decl state = and print_attr_decl state =
print_ne_injection state "attributes" print_string print_ne_injection state print_string
and print_decl state = function and print_decl state = function
TypeDecl decl -> print_type_decl state decl TypeDecl decl -> print_type_decl state decl
@ -170,8 +170,8 @@ and print_variant state ({value; _}: variant reg) =
and print_sum_type state {value; _} = and print_sum_type state {value; _} =
print_nsepseq state "|" print_variant value print_nsepseq state "|" print_variant value
and print_record_type state record_type = and print_record_type state =
print_ne_injection state "record" print_field_decl record_type print_ne_injection state print_field_decl
and print_type_app state {value; _} = and print_type_app state {value; _} =
let type_name, type_tuple = value in let type_name, type_tuple = value in
@ -256,22 +256,19 @@ and print_param_var state {value; _} =
print_type_expr state param_type print_type_expr state param_type
and print_block state block = and print_block state block =
let {opening; statements; terminator; closing} = block.value in let {enclosing; statements; terminator} = block.value in
print_block_opening state opening; match enclosing with
print_statements state statements; Block (kwd_block, lbrace, rbrace) ->
print_terminator state terminator; print_token state kwd_block "block";
print_block_closing state closing print_token state lbrace "{";
print_statements state statements;
and print_block_opening state = function print_terminator state terminator;
Block (kwd_block, lbrace) -> print_token state rbrace "}"
print_token state kwd_block "block"; | BeginEnd (kwd_begin, kwd_end) ->
print_token state lbrace "{" print_token state kwd_begin "begin";
| Begin kwd_begin -> print_statements state statements;
print_token state kwd_begin "begin" print_terminator state terminator;
print_token state kwd_end "end"
and print_block_closing state = function
Block rbrace -> print_token state rbrace "}"
| End kwd_end -> print_token state kwd_end "end"
and print_data_decl state = function and print_data_decl state = function
LocalConst decl -> print_const_decl state decl LocalConst decl -> print_const_decl state decl
@ -344,14 +341,20 @@ and print_clause_block state = function
print_token state rbrace "}" print_token state rbrace "}"
and print_case_instr state (node : if_clause case) = and print_case_instr state (node : if_clause case) =
let {kwd_case; expr; opening; let {kwd_case; expr; kwd_of; enclosing; lead_vbar; cases} = node in
lead_vbar; cases; closing} = node in
print_token state kwd_case "case"; print_token state kwd_case "case";
print_expr state expr; print_expr state expr;
print_opening state "of" opening; print_token state kwd_of "of";
print_token_opt state lead_vbar "|"; match enclosing with
print_cases_instr state cases; Brackets (lbracket, rbracket) ->
print_closing state closing print_token state lbracket "[";
print_token_opt state lead_vbar "|";
print_cases_instr state cases;
print_token state rbracket "]"
| End kwd_end ->
print_token_opt state lead_vbar "|";
print_cases_instr state cases;
print_token state kwd_end "end"
and print_token_opt state = function and print_token_opt state = function
None -> fun _ -> () None -> fun _ -> ()
@ -466,14 +469,20 @@ and print_annot_expr state (expr , type_expr) =
print_type_expr state type_expr print_type_expr state type_expr
and print_case_expr state (node : expr case) = and print_case_expr state (node : expr case) =
let {kwd_case; expr; opening; let {kwd_case; expr; kwd_of; enclosing; lead_vbar; cases} = node in
lead_vbar; cases; closing} = node in
print_token state kwd_case "case"; print_token state kwd_case "case";
print_expr state expr; print_expr state expr;
print_opening state "of" opening; print_token state kwd_of "of";
print_token_opt state lead_vbar "|"; match enclosing with
print_cases_expr state cases; Brackets (lbracket, rbracket) ->
print_closing state closing print_token state lbracket "[";
print_token_opt state lead_vbar "|";
print_cases_expr state cases;
print_token state rbracket "]"
| End kwd_end ->
print_token_opt state lead_vbar "|";
print_cases_expr state cases;
print_token state kwd_end "end"
and print_cases_expr state {value; _} = and print_cases_expr state {value; _} =
print_nsepseq state "|" print_case_clause_expr value print_nsepseq state "|" print_case_clause_expr value
@ -486,11 +495,11 @@ and print_case_clause_expr state {value; _} =
and print_map_expr state = function and print_map_expr state = function
MapLookUp {value; _} -> print_map_lookup state value MapLookUp {value; _} -> print_map_lookup state value
| MapInj inj -> print_injection state "map" print_binding inj | MapInj inj -> print_injection state print_binding inj
| BigMapInj inj -> print_injection state "big_map" print_binding inj | BigMapInj inj -> print_injection state print_binding inj
and print_set_expr state = function and print_set_expr state = function
SetInj inj -> print_injection state "set" print_expr inj SetInj inj -> print_injection state print_expr inj
| SetMem mem -> print_set_membership state mem | SetMem mem -> print_set_membership state mem
and print_set_membership state {value; _} = and print_set_membership state {value; _} =
@ -600,7 +609,7 @@ and print_list_expr state = function
print_expr state arg1; print_expr state arg1;
print_token state op "#"; print_token state op "#";
print_expr state arg2 print_expr state arg2
| EListComp e -> print_injection state "list" print_expr e | EListComp e -> print_injection state print_expr e
| ENil e -> print_nil state e | ENil e -> print_nil state e
and print_constr_expr state = function and print_constr_expr state = function
@ -608,8 +617,8 @@ and print_constr_expr state = function
| NoneExpr e -> print_none_expr state e | NoneExpr e -> print_none_expr state e
| ConstrApp e -> print_constr_app state e | ConstrApp e -> print_constr_app state e
and print_record_expr state e = and print_record_expr state =
print_ne_injection state "record" print_field_assign e print_ne_injection state print_field_assign
and print_field_assign state {value; _} = and print_field_assign state {value; _} =
let {field_name; equal; field_expr} = value in let {field_name; equal; field_expr} = value in
@ -627,8 +636,7 @@ and print_update_expr state {value; _} =
let {record; kwd_with; updates} = value in let {record; kwd_with; updates} = value in
print_path state record; print_path state record;
print_token state kwd_with "with"; print_token state kwd_with "with";
print_ne_injection state "updates field" print_field_path_assign updates print_ne_injection state print_field_path_assign updates
and print_projection state {value; _} = and print_projection state {value; _} =
let {struct_name; selector; field_path} = value in let {struct_name; selector; field_path} = value in
@ -648,21 +656,21 @@ and print_record_patch state node =
print_token state kwd_patch "patch"; print_token state kwd_patch "patch";
print_path state path; print_path state path;
print_token state kwd_with "with"; print_token state kwd_with "with";
print_ne_injection state "record" print_field_assign record_inj print_ne_injection state print_field_assign record_inj
and print_set_patch state node = and print_set_patch state node =
let {kwd_patch; path; kwd_with; set_inj} = node in let {kwd_patch; path; kwd_with; set_inj} = node in
print_token state kwd_patch "patch"; print_token state kwd_patch "patch";
print_path state path; print_path state path;
print_token state kwd_with "with"; print_token state kwd_with "with";
print_ne_injection state "set" print_expr set_inj print_ne_injection state print_expr set_inj
and print_map_patch state node = and print_map_patch state node =
let {kwd_patch; path; kwd_with; map_inj} = node in let {kwd_patch; path; kwd_with; map_inj} = node in
print_token state kwd_patch "patch"; print_token state kwd_patch "patch";
print_path state path; print_path state path;
print_token state kwd_with "with"; print_token state kwd_with "with";
print_ne_injection state "map" print_binding map_inj print_ne_injection state print_binding map_inj
and print_map_remove state node = and print_map_remove state node =
let {kwd_remove; key; kwd_from; kwd_map; map} = node in let {kwd_remove; key; kwd_from; kwd_map; map} = node in
@ -681,35 +689,48 @@ and print_set_remove state node =
print_path state set print_path state set
and print_injection : and print_injection :
'a.state -> string -> (state -> 'a -> unit) -> 'a.state -> (state -> 'a -> unit) -> 'a injection reg -> unit =
'a injection reg -> unit = fun state print {value; _} ->
fun state kwd print {value; _} -> let {kind; enclosing; elements; terminator} = value in
let {opening; elements; terminator; closing} = value in print_injection_kwd state kind;
print_opening state kwd opening; match enclosing with
print_sepseq state ";" print elements; Brackets (lbracket, rbracket) ->
print_terminator state terminator; print_token state lbracket "[";
print_closing state closing print_sepseq state ";" print elements;
print_terminator state terminator;
print_token state rbracket "]"
| End kwd_end ->
print_sepseq state ";" print elements;
print_terminator state terminator;
print_token state kwd_end "end"
and print_injection_kwd state = function
InjSet kwd_set -> print_token state kwd_set "set"
| InjMap kwd_map -> print_token state kwd_map "map"
| InjBigMap kwd_big_map -> print_token state kwd_big_map "big_map"
| InjList kwd_list -> print_token state kwd_list "list"
and print_ne_injection : and print_ne_injection :
'a.state -> string -> (state -> 'a -> unit) -> 'a.state -> (state -> 'a -> unit) -> 'a ne_injection reg -> unit =
'a ne_injection reg -> unit = fun state print {value; _} ->
fun state kwd print {value; _} -> let {kind; enclosing; ne_elements; terminator} = value in
let {opening; ne_elements; terminator; closing} = value in print_ne_injection_kwd state kind;
print_opening state kwd opening; match enclosing with
print_nsepseq state ";" print ne_elements; Brackets (lbracket, rbracket) ->
print_terminator state terminator; print_token state lbracket "[";
print_closing state closing print_nsepseq state ";" print ne_elements;
print_terminator state terminator;
print_token state rbracket "]"
| End kwd_end ->
print_nsepseq state ";" print ne_elements;
print_terminator state terminator;
print_token state kwd_end "end"
and print_opening state lexeme = function and print_ne_injection_kwd state = function
Kwd kwd -> NEInjAttr kwd_attributes -> print_token state kwd_attributes "attributes"
print_token state kwd lexeme | NEInjSet kwd_set -> print_token state kwd_set "set"
| KwdBracket (kwd, lbracket) -> | NEInjMap kwd_map -> print_token state kwd_map "map"
print_token state kwd lexeme; | NEInjRecord kwd_record -> print_token state kwd_record "record"
print_token state lbracket "["
and print_closing state = function
RBracket rbracket -> print_token state rbracket "]"
| End kwd_end -> print_token state kwd_end "end"
and print_binding state {value; _} = and print_binding state {value; _} =
let {source; arrow; image} = value in let {source; arrow; image} = value in
@ -787,7 +808,7 @@ and print_patterns state {value; _} =
and print_list_pattern state = function and print_list_pattern state = function
PListComp comp -> PListComp comp ->
print_injection state "list" print_pattern comp print_injection state print_pattern comp
| PNil kwd_nil -> | PNil kwd_nil ->
print_token state kwd_nil "nil" print_token state kwd_nil "nil"
| PParCons cons -> | PParCons cons ->
@ -831,7 +852,7 @@ let pattern_to_string ~offsets ~mode =
let instruction_to_string ~offsets ~mode = let instruction_to_string ~offsets ~mode =
to_string ~offsets ~mode print_instruction to_string ~offsets ~mode print_instruction
(** {1 Pretty-printing the AST} *) (* Pretty-printing the AST *)
let pp_ident state {value=name; region} = let pp_ident state {value=name; region} =
let reg = compact state region in let reg = compact state region in
@ -952,8 +973,8 @@ and pp_type_expr state = function
let fields = Utils.nsepseq_to_list value.ne_elements in let fields = Utils.nsepseq_to_list value.ne_elements in
List.iteri (List.length fields |> apply) fields List.iteri (List.length fields |> apply) fields
| TString s -> | TString s ->
pp_node state "TString"; pp_node state "TString";
pp_string (state#pad 1 0) s pp_string (state#pad 1 0) s
and pp_cartesian state {value; _} = and pp_cartesian state {value; _} =
let apply len rank = let apply len rank =

18
src/passes/1-parser/pascaligo/ParserMain.ml
View File

@ -75,9 +75,23 @@ module Unit =
(* Main *) (* Main *)
let wrap = function let wrap = function
Stdlib.Ok _ -> flush_all () Stdlib.Ok ast ->
if IO.options#pretty then
begin
let doc = Pretty.print 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 -> | 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 () = let () =
match IO.options#input with match IO.options#input with

425
src/passes/1-parser/pascaligo/Pretty.ml Normal file
View File

@ -0,0 +1,425 @@
[@@@warning "-42"]
open AST
module Region = Simple_utils.Region
open! Region
open! PPrint
let pp_par (printer: 'a -> document) ({value; _} : 'a par reg) =
string "(" ^^ nest 1 (printer value.inside ^^ string ")")
let rec print ast =
let app decl = group (pp_declaration decl) in
let decl = Utils.nseq_to_list ast.decl in
separate_map (hardline ^^ hardline) app decl
and pp_declaration = function
TypeDecl d -> pp_type_decl d
| ConstDecl d -> pp_const_decl d
| FunDecl d -> pp_fun_decl d
| AttrDecl d -> pp_attr_decl d
and pp_attr_decl decl = pp_ne_injection pp_string decl
and pp_const_decl {value; _} = string "TODO:pp_const_decl"
(* Type declarations *)
and pp_type_decl decl =
let {name; type_expr; _} = decl.value in
string "type " ^^ string name.value ^^ string " is"
^^ group (nest 2 (break 1 ^^ pp_type_expr type_expr))
and pp_type_expr = function
TProd t -> pp_cartesian t
| TSum t -> pp_variants t
| TRecord t -> pp_fields t
| TApp t -> pp_type_app t
| TFun t -> pp_fun_type t
| TPar t -> pp_type_par t
| TVar t -> pp_ident t
| TString s -> pp_string s
and pp_cartesian {value; _} =
let head, tail = value in
let rec app = function
[] -> empty
| [e] -> group (break 1 ^^ pp_type_expr e)
| e::items ->
group (break 1 ^^ pp_type_expr e ^^ string " *") ^^ app items
in pp_type_expr head ^^ string " *" ^^ app (List.map snd tail)
and pp_variants {value; _} =
let head, tail = value in
let head = pp_variant head in
let head = if tail = [] then head
else ifflat head (string " " ^^ head) in
let rest = List.map snd tail in
let app variant = break 1 ^^ string "| " ^^ pp_variant variant
in head ^^ concat_map app rest
and pp_variant {value; _} =
let {constr; arg} = value in
match arg with
None -> pp_ident constr
| Some (_, e) ->
prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr e)
and pp_fields fields = pp_ne_injection pp_field_decl fields
and pp_field_decl {value; _} =
let {field_name; field_type; _} = value in
let name = pp_ident field_name in
let t_expr = pp_type_expr field_type
in prefix 2 1 (name ^^ string " :") t_expr
and pp_fun_type {value; _} =
let lhs, _, rhs = value in
group (pp_type_expr lhs ^^ string " ->" ^/^ pp_type_expr rhs)
and pp_type_par t = pp_par pp_type_expr t
and pp_type_app {value = ctor, tuple; _} =
prefix 2 1 (pp_type_constr ctor) (pp_type_tuple tuple)
and pp_type_constr ctor = string ctor.value
and pp_type_tuple {value; _} =
let head, tail = value.inside in
let rec app = function
[] -> empty
| [e] -> group (break 1 ^^ pp_type_expr e)
| e::items ->
group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items in
if tail = []
then pp_type_expr head
else
let components =
pp_type_expr head ^^ string "," ^^ app (List.map snd tail)
in string "(" ^^ nest 1 (components ^^ string ")")
(* Function and procedure declarations *)
and pp_fun_expr {value; _} = string "TODO:pp_fun_expr"
and pp_fun_decl {value; _} =
let {kwd_recursive; fun_name; param;
ret_type; block_with; return; attributes} = value in
let start =
match kwd_recursive with
None -> string "function"
| Some _ -> string "recursive" ^/^ string "function" in
let parameters = pp_par pp_parameters param in
let return_t = pp_type_expr ret_type in
string "TODO:pp_fun_decl"
and pp_parameters p = pp_nsepseq ";" pp_param_decl p
and pp_param_decl = function
ParamConst c -> pp_param_const c
| ParamVar v -> pp_param_var v
and pp_param_const {value; _} = string "PP:pp_param_const"
and pp_param_var {value; _} = string "TODO:pp_param_var"
and pp_block {value; _} = string "TODO:pp_block"
and pp_statements s = pp_nsepseq ";" pp_statement s
and pp_statement = function
Instr s -> pp_instruction s
| Data s -> pp_data_decl s
| Attr s -> pp_attr_decl s
and pp_data_decl = function
LocalConst d -> pp_const_decl d
| LocalVar d -> pp_var_decl d
| LocalFun d -> pp_fun_decl d
and pp_var_decl decl = string "TODO:pp_var_decl"
and pp_instruction = function
Cond i -> pp_conditional i
| CaseInstr i -> pp_case pp_if_clause i
| Assign i -> pp_assignment i
| Loop i -> pp_loop i
| ProcCall i -> pp_fun_call i
| Skip _ -> string "skip"
| RecordPatch i -> pp_record_patch i
| MapPatch i -> pp_map_patch i
| SetPatch i -> pp_set_patch i
| MapRemove i -> pp_map_remove i
| SetRemove i -> pp_set_remove i
and pp_set_remove {value; _} = string "TODO:pp_set_remove"
and pp_map_remove {value; _} = string "TODO:pp_map_remove"
and pp_set_patch {value; _} = string "TODO:pp_set_patch"
and pp_map_patch {value; _} = string "TODO:pp_map_patch"
and pp_binding b = string "TODO:pp_binding"
and pp_record_patch {value; _} = string "TODO:pp_record_patch"
and pp_cond_expr {value; _} = string "TODO:pp_cond_expr"
and pp_conditional {value; _} = string "TODO:pp_conditional"
and pp_if_clause = function
ClauseInstr i -> pp_instruction i
| ClauseBlock b -> pp_clause_block b
and pp_clause_block = function
LongBlock b -> pp_block b
| ShortBlock b -> pp_short_block b
and pp_short_block {value; _} = string "TODO:pp_short_block"
and pp_set_membership {value; _} = string "TODO:pp_set_membership"
and pp_case :
'a.('a -> document) -> 'a case Region.reg -> document =
fun printer case -> string "TODO:pp_case"
and pp_case_clause :
'a.('a -> document) -> 'a case_clause Region.reg -> document =
fun printer clause -> string "TODO:pp_case_clause"
and pp_assignment {value; _} = string "TODO:pp_assignment"
and pp_lhs : lhs -> document = function
Path p -> pp_path p
| MapPath p -> pp_map_lookup p
and pp_loop = function
While l -> pp_while_loop l
| For f -> pp_for_loop f
and pp_while_loop {value; _} = string "TODO:pp_while_loop"
and pp_for_loop = function
ForInt l -> pp_for_int l
| ForCollect l -> pp_for_collect l
and pp_for_int {value; _} = string "TODO:pp_for_int"
and pp_var_assign {value; _} = string "TODO:pp_var_assign"
and pp_for_collect {value; _} = string "TODO:pp_for_collect"
and pp_collection = function
Map _ -> string "map"
| Set _ -> string "set"
| List _ -> string "list"
(* Expressions *)
and pp_expr = function
ECase e -> pp_case pp_expr e
| ECond e -> pp_cond_expr e
| EAnnot e -> pp_annot_expr e
| ELogic e -> pp_logic_expr e
| EArith e -> pp_arith_expr e
| EString e -> pp_string_expr e
| EList e -> pp_list_expr e
| ESet e -> pp_set_expr e
| EConstr e -> pp_constr_expr e
| ERecord e -> pp_record e
| EProj e -> pp_projection e
| EUpdate e -> pp_update e
| EMap e -> pp_map_expr e
| EVar e -> pp_ident e
| ECall e -> pp_fun_call e
| EBytes e -> pp_bytes e
| EUnit _ -> string "Unit"
| ETuple e -> pp_tuple_expr e
| EPar e -> pp_par pp_expr e
| EFun e -> pp_fun_expr e
and pp_annot_expr {value; _} = string "TODO:pp_annot_expr"
and pp_set_expr = function
SetInj inj -> string "TODO:pp_set_expr:SetInj"
| SetMem mem -> string "TODO:pp_set_expr:SetMem"
and pp_map_expr = function
MapLookUp fetch -> pp_map_lookup fetch
| MapInj inj -> pp_injection pp_binding inj
| BigMapInj inj -> pp_injection pp_binding inj
and pp_map_lookup {value; _} = string "TODO:pp_map_lookup"
and pp_path = function
Name v -> pp_ident v
| Path p -> pp_projection p
and pp_logic_expr = function
BoolExpr e -> pp_bool_expr e
| CompExpr e -> pp_comp_expr e
and pp_bool_expr = function
Or e -> pp_bin_op "||" e
| And e -> pp_bin_op "&&" e
| Not e -> pp_un_op "not" e
| True _ -> string "true"
| False _ -> string "false"
and pp_bin_op op {value; _} =
let {arg1; arg2; _} = value
and length = String.length op + 1 in
pp_expr arg1 ^/^ string (op ^ " ") ^^ nest length (pp_expr arg2)
and pp_un_op op {value; _} =
string (op ^ " ") ^^ pp_expr value.arg
and pp_comp_expr = function
Lt e -> pp_bin_op "<" e
| Leq e -> pp_bin_op "<=" e
| Gt e -> pp_bin_op ">" e
| Geq e -> pp_bin_op ">=" e
| Equal e -> pp_bin_op "=" e
| Neq e -> pp_bin_op "<>" e
and pp_arith_expr = function
Add e -> pp_bin_op "+" e
| Sub e -> pp_bin_op "-" e
| Mult e -> pp_bin_op "*" e
| Div e -> pp_bin_op "/" e
| Mod e -> pp_bin_op "mod" e
| Neg e -> string "-" ^^ pp_expr e.value.arg
| Int e -> pp_int e
| Nat e -> pp_nat e
| Mutez e -> pp_mutez e
and pp_mutez {value; _} =
Z.to_string (snd value) ^ "mutez" |> string
and pp_string_expr = function
Cat e -> pp_bin_op "^" e
| String e -> pp_string e
| Verbatim e -> pp_verbatim e
and pp_ident {value; _} = string value
and pp_string s = string "\"" ^^ pp_ident s ^^ string "\""
and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
and pp_list_expr = function
ECons e -> pp_bin_op "#" e
| EListComp e -> group (pp_injection pp_expr e)
| ENil _ -> string "nil"
and pp_constr_expr = function
SomeApp a -> pp_some_app a
| NoneExpr _ -> string "None"
| ConstrApp a -> pp_constr_app a
and pp_some_app {value; _} = string "TODO:pp_some_app"
and pp_constr_app {value; _} = string "TODO:pp_constr_app"
and pp_field_assign {value; _} = string "TODO:pp_field_assign"
and pp_record ne_inj = group (pp_ne_injection pp_field_assign ne_inj)
and pp_projection {value; _} = string "TODO:pp_projection"
and pp_update {value; _} = string "TODO:pp_update"
and pp_field_path_assign {value; _} = string "TODO:pp_field_path_assign"
and pp_selection = function
FieldName _ -> string "TODO:pp_selection:FieldName"
| Component cmp -> cmp.value |> snd |> Z.to_string |> string
and pp_tuple_expr {value; _} = string "TODO:pp_tuple_expr"
and pp_fun_call {value; _} = string "TODO:pp_fun_call"
and pp_arguments v = pp_tuple_expr v
(* Injections *)
and pp_injection :
'a.('a -> document) -> 'a injection reg -> document =
fun printer {value; _} -> string "TODO:pp_injection"
and pp_ne_injection :
'a.('a -> document) -> 'a ne_injection reg -> document =
fun printer {value; _} ->
let {kind; enclosing; ne_elements; _} = value in
let elements = pp_nsepseq ";" printer ne_elements in
let kwd = pp_ne_injection_kwd kind in
let offset = String.length kwd + 2 in
string (kwd ^ " [")
^^ group (nest 2 (break 0 ^^ elements ^^ string "]"))
and pp_ne_injection_kwd = function
NEInjAttr _ -> "attributes"
| NEInjSet _ -> "set"
| NEInjMap _ -> "map"
| NEInjRecord _ -> "record"
and pp_nsepseq :
'a.string ->
('a -> document) ->
('a, t) Utils.nsepseq ->
document =
fun sep printer elements ->
let elems = Utils.nsepseq_to_list elements
and sep = string sep ^^ break 1
in separate_map sep printer elems
(* Patterns *)
and pp_pattern = function
PConstr p -> pp_constr_pattern p
| PVar v -> pp_ident v
| PWild _ -> string "_"
| PInt i -> pp_int i
| PNat n -> pp_nat n
| PBytes b -> pp_bytes b
| PString s -> pp_string s
| PList l -> pp_list_pattern l
| PTuple t -> pp_tuple_pattern t
and pp_int {value; _} =
string (Z.to_string (snd value))
and pp_nat {value; _} =
string (Z.to_string (snd value) ^ "n")
and pp_bytes {value; _} =
string ("0x" ^ Hex.show (snd value))
and pp_constr_pattern = function
PUnit _ -> string "Unit"
| PFalse _ -> string "False"
| PTrue _ -> string "True"
| PNone _ -> string "None"
| PSomeApp a -> pp_psome a
| PConstrApp a -> pp_pconstr_app a
and pp_psome {value=_, p; _} =
prefix 4 1 (string "Some") (pp_par pp_pattern p)
and pp_pconstr_app {value; _} = string "TODO:pp_pconstr_app"
and pp_tuple_pattern {value; _} = string "TODO:tuple_pattern"
and pp_list_pattern = function
PListComp cmp -> pp_list_comp cmp
| PNil _ -> string "nil"
| PParCons p -> pp_ppar_cons p
| PCons p -> pp_nsepseq "#" pp_pattern p.value
and pp_list_comp {value; _} = string "TODO:pp_list_comp"
and pp_ppar_cons {value; _} = string "TODO:pp_ppar_cons"
and pp_cons {value; _} = string "TODO:pp_cons"

2
src/passes/1-parser/pascaligo/dune
View File

@ -15,7 +15,7 @@
(name parser_pascaligo) (name parser_pascaligo)
(public_name ligo.parser.pascaligo) (public_name ligo.parser.pascaligo)
(modules (modules
Scoping AST pascaligo Parser ParserLog LexToken ParErr) Scoping AST pascaligo Parser ParserLog LexToken ParErr Pretty)
(libraries (libraries
menhirLib menhirLib
parser_shared parser_shared

2
src/passes/1-parser/reasonligo.ml
View File

@ -189,7 +189,7 @@ let pretty_print source =
match parse_file source with match parse_file source with
Stdlib.Error _ as e -> e Stdlib.Error _ as e -> e
| Ok ast -> | Ok ast ->
let doc = Pretty.make (fst ast) in let doc = Pretty.print (fst ast) in
let buffer = Buffer.create 131 in let buffer = Buffer.create 131 in
let width = let width =
match Terminal_size.get_columns () with match Terminal_size.get_columns () with