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

Finished the refactoring of the parsers.

Browse Source
This commit is contained in:
Christian Rinderknecht 2019-12-15 20:59:04 +01:00
parent fca439558b
commit a94ee53fd3
4 changed files with 296 additions and 379 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -223,7 +223,7 @@ and fun_expr = {
and fun_decl = { and fun_decl = {
fun_expr : fun_expr reg; fun_expr : fun_expr reg;
terminator : semi option ; terminator : semi option
} }
and parameters = (param_decl, semi) nsepseq par reg and parameters = (param_decl, semi) nsepseq par reg

2
src/passes/1-parser/pascaligo/AST.mli
View File

@ -214,7 +214,7 @@ and fun_expr = {
and fun_decl = { and fun_decl = {
fun_expr : fun_expr reg; fun_expr : fun_expr reg;
terminator : semi option ; terminator : semi option
} }
and parameters = (param_decl, semi) nsepseq par reg and parameters = (param_decl, semi) nsepseq par reg

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

@ -107,8 +107,7 @@ sepseq(X,Sep):
(* Main *) (* Main *)
contract: contract:
nseq(declaration) EOF { nseq(declaration) EOF { {decl=$1; eof=$2} }
{decl = $1; eof = $2} }
declaration: declaration:
type_decl { TypeDecl $1 } type_decl { TypeDecl $1 }
@ -124,8 +123,7 @@ type_decl:
Some region -> region Some region -> region
| None -> type_expr_to_region $4 in | None -> type_expr_to_region $4 in
let region = cover $1 stop in let region = cover $1 stop in
let value = { let value = {kwd_type = $1;
kwd_type = $1;
name = $2; name = $2;
kwd_is = $3; kwd_is = $3;
type_expr = $4; type_expr = $4;
@ -133,22 +131,17 @@ type_decl:
in {region; value} } in {region; value} }
type_expr: type_expr:
sum_type { TSum $1 } sum_type | record_type | cartesian { $1 }
| record_type { TRecord $1 }
| cartesian { $1 }
cartesian: cartesian:
function_type "*" nsepseq(function_type,"*") { function_type { $1 }
| function_type "*" nsepseq(function_type,"*") {
let value = Utils.nsepseq_cons $1 $2 $3 in let value = Utils.nsepseq_cons $1 $2 $3 in
let region = nsepseq_to_region type_expr_to_region value let region = nsepseq_to_region type_expr_to_region value
in TProd {region; value} in TProd {region; value} }
}
| function_type { ($1 : type_expr) }
function_type: function_type:
core_type { core_type { $1 }
$1
}
| core_type "->" function_type { | core_type "->" function_type {
let start = type_expr_to_region $1 let start = type_expr_to_region $1
and stop = type_expr_to_region $3 in and stop = type_expr_to_region $3 in
@ -156,9 +149,8 @@ function_type:
TFun {region; value = $1,$2,$3} } TFun {region; value = $1,$2,$3} }
core_type: core_type:
type_name { type_name { TVar $1 }
TVar $1 | par(type_expr) { TPar $1 }
}
| type_name type_tuple { | type_name type_tuple {
let region = cover $1.region $2.region let region = cover $1.region $2.region
in TApp {region; value = $1,$2} in TApp {region; value = $1,$2}
@ -187,8 +179,6 @@ core_type:
let tuple = {region; value={lpar; inside=inside,[]; rpar}} let tuple = {region; value={lpar; inside=inside,[]; rpar}}
in TApp {region=total; value = type_constr, tuple} in TApp {region=total; value = type_constr, tuple}
} }
| par(type_expr) {
TPar $1}
type_tuple: type_tuple:
par(nsepseq(type_expr,",")) { $1 } par(nsepseq(type_expr,",")) { $1 }
@ -196,37 +186,33 @@ type_tuple:
sum_type: sum_type:
"|"? nsepseq(variant,"|") { "|"? nsepseq(variant,"|") {
let region = nsepseq_to_region (fun x -> x.region) $2 let region = nsepseq_to_region (fun x -> x.region) $2
in {region; value=$2} } in TSum {region; value=$2} }
variant: variant:
"<constr>" "of" cartesian { "<constr>" { {$1 with value = {constr=$1; arg=None}} }
| "<constr>" "of" cartesian {
let region = cover $1.region (type_expr_to_region $3) let region = cover $1.region (type_expr_to_region $3)
and value = {constr=$1; arg = Some ($2,$3)} and value = {constr=$1; arg = Some ($2,$3)}
in {region; value} in {region; value} }
}
| "<constr>" {
{region=$1.region; value= {constr=$1; arg=None}} }
record_type: record_type:
"record" sep_or_term_list(field_decl,";") "end" { "record" sep_or_term_list(field_decl,";") "end" {
let ne_elements, terminator = $2 in let ne_elements, terminator = $2 in
let region = cover $1 $3 let region = cover $1 $3
and value = { and value = {opening = Kwd $1;
opening = Kwd $1;
ne_elements; ne_elements;
terminator; terminator;
closing = End $3} closing = End $3}
in {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 = { and value = {opening = KwdBracket ($1,$2);
opening = KwdBracket ($1,$2);
ne_elements; ne_elements;
terminator; terminator;
closing = RBracket $4} closing = RBracket $4}
in {region; value} } in TRecord {region; value} }
field_decl: field_decl:
field_name ":" type_expr { field_name ":" type_expr {
@ -241,8 +227,7 @@ fun_expr:
"with" expr { "with" expr {
let stop = expr_to_region $9 in let stop = expr_to_region $9 in
let region = cover $1 stop let region = cover $1 stop
and value = { and value = {kwd_function = $1;
kwd_function = $1;
name = $2; name = $2;
param = $3; param = $3;
colon = $4; colon = $4;
@ -254,8 +239,7 @@ fun_expr:
| "function" fun_name? parameters ":" type_expr "is" expr { | "function" fun_name? parameters ":" type_expr "is" expr {
let stop = expr_to_region $7 in let stop = expr_to_region $7 in
let region = cover $1 stop let region = cover $1 stop
and value = { and value = {kwd_function = $1;
kwd_function = $1;
name = $2; name = $2;
param = $3; param = $3;
colon = $4; colon = $4;
@ -269,23 +253,16 @@ fun_expr:
(* Function declarations *) (* Function declarations *)
fun_decl: fun_decl:
fun_expr ";"? { open_fun_decl { $1 }
let stop = | fun_expr ";" {
match $2 with let region = cover $1.region $2
Some region -> region and value = {fun_expr=$1; terminator= Some $2}
| None -> $1.region in
let region = cover $1.region stop
and value = {
fun_expr = $1;
terminator = $2}
in {region; value} } in {region; value} }
open_fun_decl: open_fun_decl:
fun_expr { fun_expr {
let region = $1.region let region = $1.region
and value = { and value = {fun_expr=$1; terminator=None}
fun_expr = $1;
terminator = None}
in {region; value} } in {region; value} }
parameters: parameters:
@ -295,8 +272,7 @@ param_decl:
"var" var ":" param_type { "var" var ":" param_type {
let stop = type_expr_to_region $4 in let stop = type_expr_to_region $4 in
let region = cover $1 stop let region = cover $1 stop
and value = { and value = {kwd_var = $1;
kwd_var = $1;
var = $2; var = $2;
colon = $3; colon = $3;
param_type = $4} param_type = $4}
@ -305,8 +281,7 @@ param_decl:
| "const" var ":" param_type { | "const" var ":" param_type {
let stop = type_expr_to_region $4 in let stop = type_expr_to_region $4 in
let region = cover $1 stop let region = cover $1 stop
and value = { and value = {kwd_const = $1;
kwd_const = $1;
var = $2; var = $2;
colon = $3; colon = $3;
param_type = $4} param_type = $4}
@ -319,8 +294,7 @@ 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 = { and value = {opening = Begin $1;
opening = Begin $1;
statements; statements;
terminator; terminator;
closing = End $3} closing = End $3}
@ -329,8 +303,7 @@ block:
| "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 = { and value = {opening = Block ($1,$2);
opening = Block ($1,$2);
statements; statements;
terminator; terminator;
closing = Block $4} closing = Block $4}
@ -349,8 +322,7 @@ open_const_decl:
"const" unqualified_decl("=") { "const" unqualified_decl("=") {
let name, colon, const_type, equal, init, stop = $2 in let name, colon, const_type, equal, init, stop = $2 in
let region = cover $1 stop let region = cover $1 stop
and value = { and value = {kwd_const = $1;
kwd_const = $1;
name; name;
colon; colon;
const_type; const_type;
@ -363,8 +335,7 @@ open_var_decl:
"var" unqualified_decl(":=") { "var" unqualified_decl(":=") {
let name, colon, var_type, assign, init, stop = $2 in let name, colon, var_type, assign, init, stop = $2 in
let region = cover $1 stop let region = cover $1 stop
and value = { and value = {kwd_var = $1;
kwd_var = $1;
name; name;
colon; colon;
var_type; var_type;
@ -379,12 +350,9 @@ unqualified_decl(OP):
in $1, $2, $3, $4, $5, region } in $1, $2, $3, $4, $5, region }
const_decl: const_decl:
open_const_decl ";" { open_const_decl { $1 }
let const_decl : AST.const_decl = $1.value in | open_const_decl ";" {
{$1 with value = {const_decl with terminator = Some $2}} {$1 with value = {$1.value with terminator = Some $2}} }
}
| open_const_decl { $1 }
instruction: instruction:
conditional { Cond $1 } conditional { Cond $1 }
@ -528,7 +496,7 @@ proc_call:
conditional: conditional:
"if" expr "then" if_clause ";"? "else" if_clause { "if" expr "then" if_clause ";"? "else" if_clause {
let region = cover $1 (if_clause_to_region $7) in let region = cover $1 (if_clause_to_region $7) in
let value : conditional = { let value : AST.conditional = {
kwd_if = $1; kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
@ -543,12 +511,10 @@ if_clause:
| clause_block { ClauseBlock $1 } | clause_block { ClauseBlock $1 }
clause_block: clause_block:
block { block { LongBlock $1 }
LongBlock $1 }
| "{" sep_or_term_list(statement,";") "}" { | "{" sep_or_term_list(statement,";") "}" {
let region = cover $1 $3 in let region = cover $1 $3 in
let value = { let value = {lbrace = $1;
lbrace = $1;
inside = $2; inside = $2;
rbrace = $3} in rbrace = $3} in
ShortBlock {value; region} } ShortBlock {value; region} }
@ -560,8 +526,7 @@ case(rhs):
"case" expr "of" "|"? cases(rhs) "end" { "case" expr "of" "|"? cases(rhs) "end" {
fun rhs_to_region -> fun rhs_to_region ->
let region = cover $1 $6 in let region = cover $1 $6 in
let value = { let value = {kwd_case = $1;
kwd_case = $1;
expr = $2; expr = $2;
opening = Kwd $3; opening = Kwd $3;
lead_vbar = $4; lead_vbar = $4;
@ -572,8 +537,7 @@ case(rhs):
| "case" expr "of" "[" "|"? cases(rhs) "]" { | "case" expr "of" "[" "|"? cases(rhs) "]" {
fun rhs_to_region -> fun rhs_to_region ->
let region = cover $1 $7 in let region = cover $1 $7 in
let value = { let value = {kwd_case = $1;
kwd_case = $1;
expr = $2; expr = $2;
opening = KwdBracket ($3,$4); opening = KwdBracket ($3,$4);
lead_vbar = $5; lead_vbar = $5;
@ -618,17 +582,13 @@ loop:
while_loop: while_loop:
"while" expr block { "while" expr block {
let region = cover $1 $3.region let region = cover $1 $3.region
and value = { and value = {kwd_while=$1; cond=$2; block=$3}
kwd_while = $1;
cond = $2;
block = $3}
in While {region; value} } in While {region; value} }
for_loop: for_loop:
"for" var_assign "to" expr block { "for" var_assign "to" expr block {
let region = cover $1 $5.region in let region = cover $1 $5.region in
let value = { let value = {kwd_for = $1;
kwd_for = $1;
assign = $2; assign = $2;
kwd_to = $3; kwd_to = $3;
bound = $4; bound = $4;
@ -637,8 +597,7 @@ for_loop:
} }
| "for" var arrow_clause? "in" collection expr block { | "for" var arrow_clause? "in" collection expr block {
let region = cover $1 $7.region in let region = cover $1 $7.region in
let value = { let value = {kwd_for = $1;
kwd_for = $1;
var = $2; var = $2;
bind_to = $3; bind_to = $3;
kwd_in = $4; kwd_in = $4;
@ -675,7 +634,7 @@ expr:
cond_expr: cond_expr:
"if" expr "then" expr ";"? "else" expr { "if" expr "then" expr ";"? "else" expr {
let region = cover $1 (expr_to_region $7) in let region = cover $1 (expr_to_region $7) in
let value : cond_expr = { let value : AST.cond_expr = {
kwd_if = $1; kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
@ -686,37 +645,31 @@ cond_expr:
in ECond {region; value} } in ECond {region; value} }
disj_expr: disj_expr:
disj_expr "or" conj_expr { conj_expr { $1 }
| disj_expr "or" conj_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 = {arg1=$1; op=$2; arg2=$3} in and value = {arg1=$1; op=$2; arg2=$3} in
ELogic (BoolExpr (Or {region; value})) ELogic (BoolExpr (Or {region; value})) }
}
| conj_expr { $1 }
conj_expr: conj_expr:
conj_expr "and" set_membership { set_membership { $1 }
| conj_expr "and" set_membership {
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 = {arg1=$1; op=$2; arg2=$3} and value = {arg1=$1; op=$2; arg2=$3}
in ELogic (BoolExpr (And {region; value})) in ELogic (BoolExpr (And {region; value})) }
}
| set_membership { $1 }
set_membership: set_membership:
core_expr "contains" set_membership { comp_expr { $1 }
| core_expr "contains" set_membership {
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 in let region = cover start stop in
let value = { let value = {set=$1; kwd_contains=$2; element=$3}
set = $1; in ESet (SetMem {region; value}) }
kwd_contains = $2;
element = $3}
in ESet (SetMem {region; value})
}
| comp_expr { $1 }
comp_expr: comp_expr:
comp_expr "<" cat_expr { comp_expr "<" cat_expr {
@ -919,8 +872,7 @@ projection:
struct_name "." nsepseq(selection,".") { struct_name "." nsepseq(selection,".") {
let stop = nsepseq_to_region selection_to_region $3 in let stop = nsepseq_to_region selection_to_region $3 in
let region = cover $1.region stop let region = cover $1.region stop
and value = { and value = {struct_name = $1;
struct_name = $1;
selector = $2; selector = $2;
field_path = $3} field_path = $3}
in {region; value} } in {region; value} }
@ -953,8 +905,7 @@ record_expr:
field_assignment: field_assignment:
field_name "=" expr { field_name "=" expr {
let region = cover $1.region (expr_to_region $3) let region = cover $1.region (expr_to_region $3)
and value = { and value = {field_name = $1;
field_name = $1;
equal = $2; equal = $2;
field_expr = $3} field_expr = $3}
in {region; value} } in {region; value} }
@ -968,8 +919,7 @@ tuple_expr:
par(tuple_comp) { $1 } par(tuple_comp) { $1 }
tuple_comp: tuple_comp:
expr "," nsepseq(expr,",") { expr "," nsepseq(expr,",") { Utils.nsepseq_cons $1 $2 $3 }
Utils.nsepseq_cons $1 $2 $3 }
arguments: arguments:
par(nsepseq(expr,",")) { $1 } par(nsepseq(expr,",")) { $1 }
@ -981,12 +931,11 @@ list_expr:
(* Patterns *) (* Patterns *)
pattern: pattern:
core_pattern "#" nsepseq(core_pattern,"#") { core_pattern { $1 }
| core_pattern "#" nsepseq(core_pattern,"#") {
let value = Utils.nsepseq_cons $1 $2 $3 in let value = Utils.nsepseq_cons $1 $2 $3 in
let region = nsepseq_to_region pattern_to_region value let region = nsepseq_to_region pattern_to_region value
in PList (PCons {region; value}) in PList (PCons {region; value}) }
}
| core_pattern { $1 }
core_pattern: core_pattern:
var { PVar $1 } var { PVar $1 }

200
src/passes/1-parser/reasonligo/Parser.mly
View File

@ -22,6 +22,8 @@ type 'a sequence_or_record =
| PaRecord of 'a record_elements | PaRecord of 'a record_elements
| PaSingleExpr of expr | PaSingleExpr of expr
let (<@) f g x = f (g x)
(* END HEADER *) (* END HEADER *)
%} %}
@ -33,13 +35,14 @@ type 'a sequence_or_record =
%type <AST.t> contract %type <AST.t> contract
%type <AST.expr> interactive_expr %type <AST.expr> interactive_expr
%nonassoc Ident (* Solves a shift/reduce problem that happens with record and
%nonassoc COLON (* Solves a shift/reduce problem that happens with record sequences. To elaborate: [sequence_or_record_in]
and sequences. To elaborate: can be reduced to [expr -> Ident], but also to
- sequence_or_record_in can be reduced to [field_assignment -> Ident].
expr -> Ident, but also to
field_assignment -> Ident.
*) *)
%nonassoc Ident
%nonassoc COLON
%% %%
(* RULES *) (* RULES *)
@ -145,9 +148,8 @@ declaration:
type_decl: type_decl:
"type" type_name "=" type_expr { "type" type_name "=" type_expr {
let region = cover $1 (type_expr_to_region $4) in let region = cover $1 (type_expr_to_region $4)
let value = { and value = {kwd_type = $1;
kwd_type = $1;
name = $2; name = $2;
eq = $3; eq = $3;
type_expr = $4} type_expr = $4}
@ -185,8 +187,8 @@ core_type:
let constr, arg = $1, $2 in let constr, arg = $1, $2 in
let start = constr.region let start = constr.region
and stop = arg.region in and stop = arg.region in
let region = cover start stop in let region = cover start stop
TApp {region; value = constr,arg} } in TApp {region; value = constr,arg} }
sum_type: sum_type:
"|" nsepseq(variant,"|") { "|" nsepseq(variant,"|") {
@ -197,7 +199,7 @@ variant:
"<constr>" { {$1 with value={constr=$1; arg=None}} } "<constr>" { {$1 with value={constr=$1; arg=None}} }
| "<constr>" "(" cartesian ")" { | "<constr>" "(" cartesian ")" {
let region = cover $1.region $4 let region = cover $1.region $4
and value = {constr=$1; arg = Some ($2,$3)} and value = {constr=$1; arg = Some (ghost,$3)}
in {region; value} } in {region; value} }
record_type: record_type:
@ -212,10 +214,7 @@ type_expr_field:
field_decl: field_decl:
field_name { field_name {
let value = { let value = {field_name=$1; colon=ghost; field_type = TVar $1}
field_name = $1;
colon = Region.ghost;
field_type = TVar $1}
in {$1 with value} in {$1 with value}
} }
| field_name ":" type_expr_field { | field_name ":" type_expr_field {
@ -252,7 +251,8 @@ let_binding:
{binders = PRecord $1, []; lhs_type=$2; eq=$3; let_rhs=$4} {binders = PRecord $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
} }
| par(closed_irrefutable) type_annotation? "=" expr { | par(closed_irrefutable) type_annotation? "=" expr {
{binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } {binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
}
| tuple(sub_irrefutable) type_annotation? "=" expr { | tuple(sub_irrefutable) type_annotation? "=" expr {
let hd, tl = $1 in let hd, tl = $1 in
let start = pattern_to_region hd in let start = pattern_to_region hd in
@ -292,14 +292,12 @@ typed_pattern:
let start = pattern_to_region $1 in let start = pattern_to_region $1 in
let stop = type_expr_to_region $3 in let stop = type_expr_to_region $3 in
let region = cover start stop in let region = cover start stop in
let value = { let value = {pattern=$1; colon=$2; type_expr=$3}
pattern = $1;
colon = $2;
type_expr = $3}
in {region; value} } in {region; value} }
pattern: pattern:
"[" sub_pattern "," "..." sub_pattern "]" { core_pattern { $1 }
| "[" sub_pattern "," "..." sub_pattern "]" {
let start = pattern_to_region $2 in let start = pattern_to_region $2 in
let stop = pattern_to_region $5 in let stop = pattern_to_region $5 in
let region = cover start stop in let region = cover start stop in
@ -311,9 +309,7 @@ pattern:
let start = pattern_to_region hd in let start = pattern_to_region hd in
let stop = last fst tl in let stop = last fst tl in
let region = cover start stop let region = cover start stop
in PTuple {value=$1; region} in PTuple {value=$1; region} }
}
| core_pattern { $1 }
sub_pattern: sub_pattern:
par(sub_pattern) { PPar $1 } par(sub_pattern) { PPar $1 }
@ -336,8 +332,7 @@ record_pattern:
"{" sep_or_term_list(field_pattern,",") "}" { "{" sep_or_term_list(field_pattern,",") "}" {
let ne_elements, terminator = $2 in let ne_elements, terminator = $2 in
let region = cover $1 $3 in let region = cover $1 $3 in
let value = { let value = {compound = Braces ($1,$3);
compound = Braces ($1,$3);
ne_elements; ne_elements;
terminator} terminator}
in {region; value} } in {region; value} }
@ -383,7 +378,6 @@ interactive_expr:
expr: expr:
base_cond__open(expr) | switch_expr(base_cond) { $1 } base_cond__open(expr) | switch_expr(base_cond) { $1 }
base_cond__open(x): base_cond__open(x):
base_expr(x) | conditional(x) { $1 } base_expr(x) | conditional(x) { $1 }
@ -391,7 +385,7 @@ base_cond:
base_cond__open(base_cond) { $1 } base_cond__open(base_cond) { $1 }
type_expr_simple_args: type_expr_simple_args:
"(" nsepseq(type_expr_simple, ",") ")" { $1, $2, $3 } par(nsepseq(type_expr_simple, ",")) { $1 }
type_expr_simple: type_expr_simple:
core_expr_2 type_expr_simple_args? { core_expr_2 type_expr_simple_args? {
@ -403,29 +397,27 @@ type_expr_simple:
let app a = function let app a = function
FieldName v -> a ^ "." ^ v.value FieldName v -> a ^ "." ^ v.value
| Component {value = c, _; _} -> a ^ "." ^ c in | Component {value = c, _; _} -> a ^ "." ^ c in
let path = let value =
Utils.nsepseq_foldl app struct_name.value field_path Utils.nsepseq_foldl app struct_name.value field_path
in {value=path; region} in {region; value}
| EArith Mutez r | EArith Int r | EArith Nat r -> | EArith Mutez r | EArith Int r | EArith Nat r ->
{r with value = fst r.value} {r with value = fst r.value}
| EString String s -> s | EString String s -> s
| ELogic BoolExpr (True t) -> {value="true"; region=t} | ELogic BoolExpr (True t) -> {region=t; value="true"}
| ELogic BoolExpr (False f) -> {value="false"; region=f} | ELogic BoolExpr (False f) -> {region=f; value="false"}
| _ -> failwith "Not supported" | _ -> failwith "Not supported" (* TODO: raise a proper exception *)
in match args with in match args with
Some (lpar, args, rpar) -> Some {value; _} ->
let region = cover (expr_to_region $1) rpar let region = cover (expr_to_region $1) value.rpar in
and value = {inside=args; lpar; rpar} in
let value = constr, {region; value} let value = constr, {region; value}
in TApp {region; value} in TApp {region; value}
| None -> TVar constr | None -> TVar constr
} }
| "(" nsepseq(type_expr_simple, ",") ")" { | "(" nsepseq(type_expr_simple, ",") ")" {
TProd {value=$2; region = cover $1 $3} TProd {region = cover $1 $3; value=$2}
} }
| "(" type_expr_simple "=>" type_expr_simple ")" { | "(" type_expr_simple "=>" type_expr_simple ")" {
TFun {value=$2,$3,$4; region = cover $1 $5} TFun {region = cover $1 $5; value=$2,$3,$4} }
}
type_annotation_simple: type_annotation_simple:
":" type_expr_simple { $1,$2 } ":" type_expr_simple { $1,$2 }
@ -433,22 +425,24 @@ type_annotation_simple:
fun_expr: fun_expr:
disj_expr_level es6_func { disj_expr_level es6_func {
let arrow, body = $2 in let arrow, body = $2 in
let kwd_fun = Region.ghost in let kwd_fun = ghost in
let start = expr_to_region $1 in let start = expr_to_region $1 in
let stop = expr_to_region body in let stop = expr_to_region body in
let region = cover start stop in let region = cover start stop in
let rec arg_to_pattern = (function
| EVar val_ -> PVar val_ let rec arg_to_pattern = function
| EAnnot {value = {inside = EVar v, colon, typ; _}; region} -> EVar v -> PVar v
| EAnnot {region; value = {inside = EVar v, colon, typ; _}} ->
let value = {pattern = PVar v; colon; type_expr = typ} let value = {pattern = PVar v; colon; type_expr = typ}
in PTyped {region; value} in PTyped {region; value}
| EPar {value = {inside; lpar; rpar}; region} -> | EPar p ->
PPar {value = {inside = arg_to_pattern inside; lpar; rpar}; region} let value =
{p.value with inside = arg_to_pattern p.value.inside}
in PPar {p with value}
| EUnit u -> PUnit u | EUnit u -> PUnit u
| _ -> failwith "Not supported" | _ -> failwith "Not supported" in (* TODO: raise a proper exception *)
)
in let fun_args_to_pattern = function
let fun_args_to_pattern = (function
EAnnot { EAnnot {
value = { value = {
inside = ETuple {value=fun_args; _}, _, _; inside = ETuple {value=fun_args; _}, _, _;
@ -456,7 +450,7 @@ fun_expr:
_} -> _} ->
(* ((foo:x, bar) : type) *) (* ((foo:x, bar) : type) *)
let bindings = let bindings =
List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) List.map (arg_to_pattern <@ snd) (snd fun_args)
in arg_to_pattern (fst fun_args), bindings in arg_to_pattern (fst fun_args), bindings
| EAnnot { | EAnnot {
value = { value = {
@ -467,25 +461,23 @@ fun_expr:
(arg_to_pattern fun_arg, []) (arg_to_pattern fun_arg, [])
| EPar {value = {inside = fun_arg; _ }; _} -> | EPar {value = {inside = fun_arg; _ }; _} ->
arg_to_pattern fun_arg, [] arg_to_pattern fun_arg, []
| EAnnot e -> arg_to_pattern (EAnnot e), [] | EAnnot e ->
arg_to_pattern (EAnnot e), []
| ETuple {value = fun_args; _} -> | ETuple {value = fun_args; _} ->
let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in let bindings =
(arg_to_pattern (fst fun_args), bindings) List.map (arg_to_pattern <@ snd) (snd fun_args)
in arg_to_pattern (fst fun_args), bindings
| EUnit e -> | EUnit e ->
arg_to_pattern (EUnit e), [] arg_to_pattern (EUnit e), []
| _ -> failwith "Not supported" | _ -> failwith "Not supported" in (* TODO: raise a proper exception *)
)
in
let binders = fun_args_to_pattern $1 in let binders = fun_args_to_pattern $1 in
let f = { let f = {kwd_fun;
kwd_fun ;
binders; binders;
lhs_type=None; lhs_type=None;
arrow; arrow;
body ; body}
} in in EFun {region; value=f} }
EFun { region; value=f }
}
base_expr(right_expr): base_expr(right_expr):
let_expr(right_expr) | disj_expr_level | fun_expr { $1 } let_expr(right_expr) | disj_expr_level | fun_expr { $1 }
@ -501,35 +493,25 @@ if_then(right_expr):
let the_unit = ghost, ghost in let the_unit = ghost, ghost in
let ifnot = EUnit {region=ghost; value=the_unit} in let ifnot = EUnit {region=ghost; value=the_unit} in
let region = cover $1 $5 in let region = cover $1 $5 in
ECond { let value = {kwd_if = $1;
value = {
kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
ifso = $4; ifso = $4;
kwd_else = Region.ghost; kwd_else = ghost;
ifnot; ifnot}
}; in ECond {region; value} }
region
}
}
if_then_else(right_expr): if_then_else(right_expr):
"if" parenthesized_expr "{" closed_if ";" "}" "if" parenthesized_expr "{" closed_if ";" "}"
"else" "{" right_expr ";" "}" { "else" "{" right_expr ";" "}" {
let region = cover $1 $11 in let region = cover $1 $11 in
ECond { let value = {kwd_if = $1;
value = {
kwd_if = $1;
test = $2; test = $2;
kwd_then = $3; kwd_then = $3;
ifso = $4; ifso = $4;
kwd_else = $6; kwd_else = $6;
ifnot = $9 ifnot = $9}
}; in ECond {region; value} }
region
}
}
base_if_then_else__open(x): base_if_then_else__open(x):
base_expr(x) | if_then_else(x) { $1 } base_expr(x) | if_then_else(x) { $1 }
@ -543,17 +525,17 @@ closed_if:
switch_expr(right_expr): switch_expr(right_expr):
"switch" switch_expr_ "{" cases(right_expr) "}" { "switch" switch_expr_ "{" cases(right_expr) "}" {
let start = $1 in let start = $1
let stop = $5 in and stop = $5 in
let cases = {
value = $4;
region = nsepseq_to_region (fun x -> x.region) $4} in
let region = cover start stop let region = cover start stop
and value = { and cases = {
region = nsepseq_to_region (fun x -> x.region) $4;
value = $4} in
let value = {
kwd_match = $1; kwd_match = $1;
expr = $2; expr = $2;
lead_vbar = None; lead_vbar = None;
kwd_with = Region.ghost; kwd_with = ghost;
cases} cases}
in ECase {region; value} } in ECase {region; value} }
@ -564,8 +546,7 @@ switch_expr_:
cases(right_expr): cases(right_expr):
nseq(case_clause(right_expr)) { nseq(case_clause(right_expr)) {
let hd, tl = $1 in let hd, tl = $1 in
hd, List.map (fun f -> expr_to_region f.value.rhs, f) tl hd, List.map (fun f -> expr_to_region f.value.rhs, f) tl }
}
case_clause(right_expr): case_clause(right_expr):
"|" pattern "=>" right_expr ";"? { "|" pattern "=>" right_expr ";"? {
@ -616,11 +597,8 @@ disj_expr:
ELogic (BoolExpr (Or $1)) } ELogic (BoolExpr (Or $1)) }
conj_expr_level: conj_expr_level:
conj_expr comp_expr_level { $1 }
| comp_expr_level { $1 } | bin_op(conj_expr_level, "&&", comp_expr_level) {
conj_expr:
bin_op(conj_expr_level, "&&", comp_expr_level) {
ELogic (BoolExpr (And $1)) } ELogic (BoolExpr (And $1)) }
comp_expr_level: comp_expr_level:
@ -678,10 +656,7 @@ call_expr_level:
| None -> expr_to_region $1 in | None -> expr_to_region $1 in
match $2 with match $2 with
Some (colon, t) -> Some (colon, t) ->
let value = { let value = {lpar=ghost; inside=$1,colon,t; rpar=ghost}
lpar=Region.ghost;
inside=$1,colon,t;
rpar=Region.ghost}
in EAnnot {region; value} in EAnnot {region; value}
| None -> $1 } | None -> $1 }
@ -774,30 +749,26 @@ module_field:
selection: selection:
"[" "<int>" "]" selection { "[" "<int>" "]" selection {
let r, (h, t) = $4 in let r, (hd, tl) = $4 in
let result: (selection, dot) Utils.nsepseq = let result: (selection, dot) Utils.nsepseq =
Component $2, (Region.ghost, h) :: t Component $2, (ghost, hd) :: tl
in r, result in r, result
} }
| "." field_name selection { | "." field_name selection {
let r, (h, t) = $3 in let r, (hd, tl) = $3 in
let result: (selection, dot) Utils.nsepseq = let result: (selection, dot) Utils.nsepseq =
FieldName $2, ($1, h) :: t FieldName $2, ($1, hd) :: tl
in r, result in r, result
} }
| "." field_name { | "." field_name { $1, (FieldName $2, []) }
$1, (FieldName $2, []) | "[" "<int>" "]" { ghost, (Component $2, []) }
}
| "[" "<int>" "]" {
Region.ghost, (Component $2, []) }
projection: projection:
struct_name selection { struct_name selection {
let start = $1.region in let start = $1.region in
let stop = nsepseq_to_region selection_to_region (snd $2) in let stop = nsepseq_to_region selection_to_region (snd $2) in
let region = cover start stop let region = cover start stop
and value = { and value = {struct_name = $1;
struct_name = $1;
selector = fst $2; selector = fst $2;
field_path = snd $2} field_path = snd $2}
in {region; value} in {region; value}
@ -810,8 +781,7 @@ projection:
let start = $1.region in let start = $1.region in
let stop = nsepseq_to_region selection_to_region (snd $4) in let stop = nsepseq_to_region selection_to_region (snd $4) in
let region = cover start stop let region = cover start stop
and value = { and value = {struct_name;
struct_name;
selector = fst $4; selector = fst $4;
field_path = snd $4} field_path = snd $4}
in {region; value} } in {region; value} }
@ -835,14 +805,12 @@ sequence_or_record:
let region = cover $1 $3 in let region = cover $1 $3 in
match $2 with match $2 with
PaSequence s -> PaSequence s ->
let value: expr injection = { let value = {compound;
compound;
elements = Some s.s_elts; elements = Some s.s_elts;
terminator = s.s_terminator} terminator = s.s_terminator}
in ESeq {region; value} in ESeq {region; value}
| PaRecord r -> | PaRecord r ->
let value: field_assign reg ne_injection = { let value = {compound;
compound;
ne_elements = r.r_elts; ne_elements = r.r_elts;
terminator = r.r_terminator} terminator = r.r_terminator}
in ERecord {region; value} in ERecord {region; value}
@ -852,7 +820,7 @@ field_assignment:
field_name { field_name {
let value = { let value = {
field_name = $1; field_name = $1;
assignment = Region.ghost; assignment = ghost;
field_expr = EVar $1 } field_expr = EVar $1 }
in {$1 with value} in {$1 with value}
} }