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

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

@ -222,8 +222,8 @@ 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
@ -270,7 +270,7 @@ and statement =
and data_decl = and data_decl =
LocalConst of const_decl reg LocalConst of const_decl reg
| LocalVar of var_decl reg | LocalVar of var_decl reg
| LocalFun of fun_decl reg | LocalFun of fun_decl reg
and var_decl = { and var_decl = {
kwd_var : kwd_var; kwd_var : kwd_var;

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

@ -213,8 +213,8 @@ 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

373
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,31 +123,25 @@ 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; terminator = $5}
terminator = $5}
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,43 +186,39 @@ 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 TRecord {region; value}
in {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 TRecord {region; value} }
in {region; value} }
field_decl: field_decl:
field_name ":" type_expr { field_name ":" type_expr {
let stop = type_expr_to_region $3 in let stop = type_expr_to_region $3 in
let region = cover $1.region stop let region = cover $1.region stop
and value = {field_name = $1; colon = $2; field_type = $3} and value = {field_name=$1; colon=$2; field_type=$3}
in {region; value} } in {region; value} }
fun_expr: fun_expr:
@ -241,51 +227,42 @@ 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; ret_type = $5;
ret_type = $5; kwd_is = $6;
kwd_is = $6; block_with = Some ($7, $8);
block_with = Some ($7, $8); return = $9}
return = $9} in {region; value} }
in {region;value} }
| "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; ret_type = $5;
ret_type = $5; kwd_is = $6;
kwd_is = $6; block_with = None;
block_with = None; return = $7}
return = $7} in {region; value} }
in {region;value} }
(* 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,21 +272,19 @@ 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}
in ParamVar {region; value} in ParamVar {region; value}
} }
| "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}
in ParamConst {region; value} } in ParamConst {region; value} }
param_type: param_type:
@ -319,21 +294,19 @@ 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}
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 = { and value = {opening = Block ($1,$2);
opening = Block ($1,$2); statements;
statements; terminator;
terminator; closing = Block $4}
closing = Block $4}
in {region; value} } in {region; value} }
statement: statement:
@ -349,28 +322,26 @@ 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; equal;
equal; init;
init; terminator = None}
terminator = None}
in {region; value} } in {region; value} }
open_var_decl: 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; assign;
assign; init;
init; terminator = None}
terminator = None}
in {region; value} } in {region; value} }
unqualified_decl(OP): unqualified_decl(OP):
@ -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,14 +511,12 @@ 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} }
case_instr: case_instr:
@ -560,25 +526,23 @@ 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; cases = $5 rhs_to_region;
cases = $5 rhs_to_region; closing = End $6}
closing = End $6}
in {region; value} in {region; value}
} }
| "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; cases = $6 rhs_to_region;
cases = $6 rhs_to_region; closing = RBracket $7}
closing = RBracket $7}
in {region; value} } in {region; value} }
cases(rhs): cases(rhs):
@ -605,7 +569,7 @@ assignment:
in {region; value} } in {region; value} }
rhs: rhs:
expr { $1 } expr { $1 }
lhs: lhs:
path { Path $1 } path { Path $1 }
@ -618,33 +582,28 @@ 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; block = $5}
block = $5}
in For (ForInt {region; value}) in For (ForInt {region; value})
} }
| "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; collection = $5;
collection = $5; expr = $6;
expr = $6; block = $7}
block = $7}
in For (ForCollect {region; value}) } in For (ForCollect {region; value}) }
collection: collection:
@ -655,7 +614,7 @@ collection:
var_assign: var_assign:
var ":=" expr { var ":=" expr {
let region = cover $1.region (expr_to_region $3) let region = cover $1.region (expr_to_region $3)
and value = {name = $1; assign = $2; expr = $3} and value = {name=$1; assign=$2; expr=$3}
in {region; value} } in {region; value} }
arrow_clause: arrow_clause:
@ -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 {
@ -840,23 +793,23 @@ unary_expr:
| core_expr { $1 } | core_expr { $1 }
core_expr: core_expr:
"<int>" { EArith (Int $1) } "<int>" { EArith (Int $1) }
| "<nat>" { EArith (Nat $1) } | "<nat>" { EArith (Nat $1) }
| "<mutez>" { EArith (Mutez $1) } | "<mutez>" { EArith (Mutez $1) }
| var { EVar $1 } | var { EVar $1 }
| "<string>" { EString (String $1) } | "<string>" { EString (String $1) }
| "<bytes>" { EBytes $1 } | "<bytes>" { EBytes $1 }
| "False" { ELogic (BoolExpr (False $1)) } | "False" { ELogic (BoolExpr (False $1)) }
| "True" { ELogic (BoolExpr (True $1)) } | "True" { ELogic (BoolExpr (True $1)) }
| "Unit" { EUnit $1 } | "Unit" { EUnit $1 }
| annot_expr { EAnnot $1 } | annot_expr { EAnnot $1 }
| tuple_expr { ETuple $1 } | tuple_expr { ETuple $1 }
| list_expr { EList $1 } | list_expr { EList $1 }
| "None" { EConstr (NoneExpr $1) } | "None" { EConstr (NoneExpr $1) }
| fun_call_or_par_or_projection { $1 } | fun_call_or_par_or_projection { $1 }
| map_expr { EMap $1 } | map_expr { EMap $1 }
| set_expr { ESet $1 } | set_expr { ESet $1 }
| record_expr { ERecord $1 } | record_expr { ERecord $1 }
| "<constr>" arguments { | "<constr>" arguments {
let region = cover $1.region $2.region in let region = cover $1.region $2.region in
EConstr (ConstrApp {region; value = $1, Some $2}) EConstr (ConstrApp {region; value = $1, Some $2})
@ -871,12 +824,12 @@ core_expr:
fun_call_or_par_or_projection: fun_call_or_par_or_projection:
par(expr) arguments? { par(expr) arguments? {
let parenthesized = EPar $1 in let parenthesized = EPar $1 in
match $2 with match $2 with
None -> parenthesized None -> parenthesized
| Some args -> | Some args ->
let region_1 = $1.region in let region_1 = $1.region in
let region = cover region_1 args.region in let region = cover region_1 args.region in
ECall {region; value = parenthesized,args} ECall {region; value = parenthesized,args}
} }
| projection arguments? { | projection arguments? {
let project = EProj $1 in let project = EProj $1 in
@ -919,10 +872,9 @@ 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} }
selection: selection:
@ -953,10 +905,9 @@ 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} }
fun_call: fun_call:
@ -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 }

292
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
(* Solves a shift/reduce problem that happens with record and
sequences. To elaborate: [sequence_or_record_in]
can be reduced to [expr -> Ident], but also to
[field_assignment -> Ident].
*)
%nonassoc Ident %nonassoc Ident
%nonassoc COLON (* Solves a shift/reduce problem that happens with record %nonassoc COLON
and sequences. To elaborate:
- sequence_or_record_in can be reduced to
expr -> Ident, but also to
field_assignment -> Ident.
*)
%% %%
(* RULES *) (* RULES *)
@ -145,12 +148,11 @@ 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}
in {region; value} } in {region; value} }
type_expr: type_expr:
@ -176,17 +178,17 @@ core_type:
| par(type_expr) { TPar $1 } | par(type_expr) { TPar $1 }
| module_name "." type_name { | module_name "." type_name {
let module_name = $1.value in let module_name = $1.value in
let type_name = $3.value in let type_name = $3.value in
let value = module_name ^ "." ^ type_name in let value = module_name ^ "." ^ type_name in
let region = cover $1.region $3.region let region = cover $1.region $3.region
in TVar {region; value} in TVar {region; value}
} }
| type_name par(nsepseq(core_type,",") { $1 }) { | type_name par(nsepseq(core_type,",") { $1 }) {
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,10 +332,9 @@ 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} }
field_pattern: field_pattern:
@ -381,8 +376,7 @@ interactive_expr:
expr EOF { $1 } expr EOF { $1 }
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
let value = {pattern = PVar v; colon; type_expr = typ} | EAnnot {region; value = {inside = EVar v, colon, typ; _}} ->
in PTyped {region; value} let value = {pattern = PVar v; colon; type_expr = typ}
| EPar {value = {inside; lpar; rpar}; region} -> in PTyped {region; value}
PPar {value = {inside = arg_to_pattern inside; lpar; rpar}; region} | EPar p ->
| EUnit u -> PUnit u let value =
| _ -> failwith "Not supported" {p.value with inside = arg_to_pattern p.value.inside}
) in PPar {p with value}
in | EUnit u -> PUnit u
let fun_args_to_pattern = (function | _ -> failwith "Not supported" in (* TODO: raise a proper exception *)
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 = {
@ -464,28 +458,26 @@ fun_expr:
_}; _};
_} -> _} ->
(* ((foo:x, bar) : type) *) (* ((foo:x, bar) : type) *)
(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 EFun {region; value=f} }
} in
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 }
@ -500,36 +492,26 @@ if_then(right_expr):
"if" parenthesized_expr "{" closed_if "}" { "if" parenthesized_expr "{" closed_if "}" {
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 = { test = $2;
kwd_if = $1; kwd_then = $3;
test = $2; ifso = $4;
kwd_then = $3; kwd_else = ghost;
ifso = $4; ifnot}
kwd_else = Region.ghost; in ECond {region; value} }
ifnot;
};
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 = { test = $2;
kwd_if = $1; kwd_then = $3;
test = $2; ifso = $4;
kwd_then = $3; kwd_else = $6;
ifso = $4; ifnot = $9}
kwd_else = $6; in ECond {region; value} }
ifnot = $9
};
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,18 +525,18 @@ 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 = {
kwd_match = $1; region = nsepseq_to_region (fun x -> x.region) $4;
expr = $2; value = $4} in
lead_vbar = None; let value = {
kwd_with = Region.ghost; kwd_match = $1;
cases} expr = $2;
lead_vbar = None;
kwd_with = ghost;
cases}
in ECase {region; value} } in ECase {region; value} }
switch_expr_: switch_expr_:
@ -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 ";"? {
@ -591,11 +572,11 @@ disj_expr_level:
| conj_expr_level { $1 } | conj_expr_level { $1 }
| par(tuple(disj_expr_level)) type_annotation_simple? { | par(tuple(disj_expr_level)) type_annotation_simple? {
let region = $1.region in let region = $1.region in
let tuple = ETuple {value=$1.value.inside; region} in let tuple = ETuple {value=$1.value.inside; region} in
let region = let region =
match $2 with match $2 with
Some (_,s) -> cover $1.region (type_expr_to_region s) Some (_,s) -> cover $1.region (type_expr_to_region s)
| None -> region in | None -> region in
match $2 with match $2 with
Some (colon, typ) -> Some (colon, typ) ->
let value = {$1.value with inside = tuple,colon,typ} let value = {$1.value with inside = tuple,colon,typ}
@ -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,32 +749,28 @@ 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}
} }
| module_name "." field_name selection { | module_name "." field_name selection {
@ -810,10 +781,9 @@ 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} }
sequence_or_record_in: sequence_or_record_in:
@ -832,27 +802,25 @@ sequence_or_record_in:
sequence_or_record: sequence_or_record:
"{" sequence_or_record_in "}" { "{" sequence_or_record_in "}" {
let compound = Braces($1, $3) in let compound = Braces($1, $3) in
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}
| PaSingleExpr e -> e } | PaSingleExpr e -> e }
field_assignment: 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}
} }