Finished the refactoring of the parsers.
This commit is contained in:
Christian Rinderknecht
parent
fca439558b
commit
a94ee53fd3
@ -222,8 +222,8 @@ and fun_expr = {
|
||||
}
|
||||
|
||||
and fun_decl = {
|
||||
fun_expr : fun_expr reg ;
|
||||
terminator : semi option ;
|
||||
fun_expr : fun_expr reg;
|
||||
terminator : semi option
|
||||
}
|
||||
|
||||
and parameters = (param_decl, semi) nsepseq par reg
|
||||
|
||||
@ -213,8 +213,8 @@ and fun_expr = {
|
||||
}
|
||||
|
||||
and fun_decl = {
|
||||
fun_expr : fun_expr reg ;
|
||||
terminator : semi option ;
|
||||
fun_expr : fun_expr reg;
|
||||
terminator : semi option
|
||||
}
|
||||
|
||||
and parameters = (param_decl, semi) nsepseq par reg
|
||||
|
||||
@ -107,8 +107,7 @@ sepseq(X,Sep):
|
||||
(* Main *)
|
||||
|
||||
contract:
|
||||
nseq(declaration) EOF {
|
||||
{decl = $1; eof = $2} }
|
||||
nseq(declaration) EOF { {decl=$1; eof=$2} }
|
||||
|
||||
declaration:
|
||||
type_decl { TypeDecl $1 }
|
||||
@ -124,8 +123,7 @@ type_decl:
|
||||
Some region -> region
|
||||
| None -> type_expr_to_region $4 in
|
||||
let region = cover $1 stop in
|
||||
let value = {
|
||||
kwd_type = $1;
|
||||
let value = {kwd_type = $1;
|
||||
name = $2;
|
||||
kwd_is = $3;
|
||||
type_expr = $4;
|
||||
@ -133,22 +131,17 @@ type_decl:
|
||||
in {region; value} }
|
||||
|
||||
type_expr:
|
||||
sum_type { TSum $1 }
|
||||
| record_type { TRecord $1 }
|
||||
| cartesian { $1 }
|
||||
sum_type | record_type | cartesian { $1 }
|
||||
|
||||
cartesian:
|
||||
function_type "*" nsepseq(function_type,"*") {
|
||||
function_type { $1 }
|
||||
| function_type "*" nsepseq(function_type,"*") {
|
||||
let value = Utils.nsepseq_cons $1 $2 $3 in
|
||||
let region = nsepseq_to_region type_expr_to_region value
|
||||
in TProd {region; value}
|
||||
}
|
||||
| function_type { ($1 : type_expr) }
|
||||
in TProd {region; value} }
|
||||
|
||||
function_type:
|
||||
core_type {
|
||||
$1
|
||||
}
|
||||
core_type { $1 }
|
||||
| core_type "->" function_type {
|
||||
let start = type_expr_to_region $1
|
||||
and stop = type_expr_to_region $3 in
|
||||
@ -156,9 +149,8 @@ function_type:
|
||||
TFun {region; value = $1,$2,$3} }
|
||||
|
||||
core_type:
|
||||
type_name {
|
||||
TVar $1
|
||||
}
|
||||
type_name { TVar $1 }
|
||||
| par(type_expr) { TPar $1 }
|
||||
| type_name type_tuple {
|
||||
let region = cover $1.region $2.region
|
||||
in TApp {region; value = $1,$2}
|
||||
@ -187,8 +179,6 @@ core_type:
|
||||
let tuple = {region; value={lpar; inside=inside,[]; rpar}}
|
||||
in TApp {region=total; value = type_constr, tuple}
|
||||
}
|
||||
| par(type_expr) {
|
||||
TPar $1}
|
||||
|
||||
type_tuple:
|
||||
par(nsepseq(type_expr,",")) { $1 }
|
||||
@ -196,43 +186,39 @@ type_tuple:
|
||||
sum_type:
|
||||
"|"? nsepseq(variant,"|") {
|
||||
let region = nsepseq_to_region (fun x -> x.region) $2
|
||||
in {region; value=$2} }
|
||||
in TSum {region; value=$2} }
|
||||
|
||||
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)
|
||||
and value = {constr = $1; arg = Some ($2, $3)}
|
||||
in {region; value}
|
||||
}
|
||||
| "<constr>" {
|
||||
{region=$1.region; value= {constr=$1; arg=None}} }
|
||||
and value = {constr=$1; arg = Some ($2,$3)}
|
||||
in {region; value} }
|
||||
|
||||
record_type:
|
||||
"record" sep_or_term_list(field_decl,";") "end" {
|
||||
let ne_elements, terminator = $2 in
|
||||
let region = cover $1 $3
|
||||
and value = {
|
||||
opening = Kwd $1;
|
||||
and value = {opening = Kwd $1;
|
||||
ne_elements;
|
||||
terminator;
|
||||
closing = End $3}
|
||||
in {region; value}
|
||||
in TRecord {region; value}
|
||||
}
|
||||
| "record" "[" sep_or_term_list(field_decl,";") "]" {
|
||||
let ne_elements, terminator = $3 in
|
||||
let region = cover $1 $4
|
||||
and value = {
|
||||
opening = KwdBracket ($1,$2);
|
||||
and value = {opening = KwdBracket ($1,$2);
|
||||
ne_elements;
|
||||
terminator;
|
||||
closing = RBracket $4}
|
||||
in {region; value} }
|
||||
in TRecord {region; value} }
|
||||
|
||||
field_decl:
|
||||
field_name ":" type_expr {
|
||||
let stop = type_expr_to_region $3 in
|
||||
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} }
|
||||
|
||||
fun_expr:
|
||||
@ -241,8 +227,7 @@ fun_expr:
|
||||
"with" expr {
|
||||
let stop = expr_to_region $9 in
|
||||
let region = cover $1 stop
|
||||
and value = {
|
||||
kwd_function = $1;
|
||||
and value = {kwd_function = $1;
|
||||
name = $2;
|
||||
param = $3;
|
||||
colon = $4;
|
||||
@ -250,12 +235,11 @@ fun_expr:
|
||||
kwd_is = $6;
|
||||
block_with = Some ($7, $8);
|
||||
return = $9}
|
||||
in {region;value} }
|
||||
in {region; value} }
|
||||
| "function" fun_name? parameters ":" type_expr "is" expr {
|
||||
let stop = expr_to_region $7 in
|
||||
let region = cover $1 stop
|
||||
and value = {
|
||||
kwd_function = $1;
|
||||
and value = {kwd_function = $1;
|
||||
name = $2;
|
||||
param = $3;
|
||||
colon = $4;
|
||||
@ -263,29 +247,22 @@ fun_expr:
|
||||
kwd_is = $6;
|
||||
block_with = None;
|
||||
return = $7}
|
||||
in {region;value} }
|
||||
in {region; value} }
|
||||
|
||||
|
||||
(* Function declarations *)
|
||||
|
||||
fun_decl:
|
||||
fun_expr ";"? {
|
||||
let stop =
|
||||
match $2 with
|
||||
Some region -> region
|
||||
| None -> $1.region in
|
||||
let region = cover $1.region stop
|
||||
and value = {
|
||||
fun_expr = $1;
|
||||
terminator = $2}
|
||||
open_fun_decl { $1 }
|
||||
| fun_expr ";" {
|
||||
let region = cover $1.region $2
|
||||
and value = {fun_expr=$1; terminator= Some $2}
|
||||
in {region; value} }
|
||||
|
||||
open_fun_decl:
|
||||
fun_expr {
|
||||
let region = $1.region
|
||||
and value = {
|
||||
fun_expr = $1;
|
||||
terminator = None}
|
||||
and value = {fun_expr=$1; terminator=None}
|
||||
in {region; value} }
|
||||
|
||||
parameters:
|
||||
@ -295,8 +272,7 @@ param_decl:
|
||||
"var" var ":" param_type {
|
||||
let stop = type_expr_to_region $4 in
|
||||
let region = cover $1 stop
|
||||
and value = {
|
||||
kwd_var = $1;
|
||||
and value = {kwd_var = $1;
|
||||
var = $2;
|
||||
colon = $3;
|
||||
param_type = $4}
|
||||
@ -305,8 +281,7 @@ param_decl:
|
||||
| "const" var ":" param_type {
|
||||
let stop = type_expr_to_region $4 in
|
||||
let region = cover $1 stop
|
||||
and value = {
|
||||
kwd_const = $1;
|
||||
and value = {kwd_const = $1;
|
||||
var = $2;
|
||||
colon = $3;
|
||||
param_type = $4}
|
||||
@ -319,8 +294,7 @@ block:
|
||||
"begin" sep_or_term_list(statement,";") "end" {
|
||||
let statements, terminator = $2 in
|
||||
let region = cover $1 $3
|
||||
and value = {
|
||||
opening = Begin $1;
|
||||
and value = {opening = Begin $1;
|
||||
statements;
|
||||
terminator;
|
||||
closing = End $3}
|
||||
@ -329,8 +303,7 @@ block:
|
||||
| "block" "{" sep_or_term_list(statement,";") "}" {
|
||||
let statements, terminator = $3 in
|
||||
let region = cover $1 $4
|
||||
and value = {
|
||||
opening = Block ($1,$2);
|
||||
and value = {opening = Block ($1,$2);
|
||||
statements;
|
||||
terminator;
|
||||
closing = Block $4}
|
||||
@ -349,8 +322,7 @@ open_const_decl:
|
||||
"const" unqualified_decl("=") {
|
||||
let name, colon, const_type, equal, init, stop = $2 in
|
||||
let region = cover $1 stop
|
||||
and value = {
|
||||
kwd_const = $1;
|
||||
and value = {kwd_const = $1;
|
||||
name;
|
||||
colon;
|
||||
const_type;
|
||||
@ -363,8 +335,7 @@ open_var_decl:
|
||||
"var" unqualified_decl(":=") {
|
||||
let name, colon, var_type, assign, init, stop = $2 in
|
||||
let region = cover $1 stop
|
||||
and value = {
|
||||
kwd_var = $1;
|
||||
and value = {kwd_var = $1;
|
||||
name;
|
||||
colon;
|
||||
var_type;
|
||||
@ -379,12 +350,9 @@ unqualified_decl(OP):
|
||||
in $1, $2, $3, $4, $5, region }
|
||||
|
||||
const_decl:
|
||||
open_const_decl ";" {
|
||||
let const_decl : AST.const_decl = $1.value in
|
||||
{$1 with value = {const_decl with terminator = Some $2}}
|
||||
}
|
||||
| open_const_decl { $1 }
|
||||
|
||||
open_const_decl { $1 }
|
||||
| open_const_decl ";" {
|
||||
{$1 with value = {$1.value with terminator = Some $2}} }
|
||||
|
||||
instruction:
|
||||
conditional { Cond $1 }
|
||||
@ -528,7 +496,7 @@ proc_call:
|
||||
conditional:
|
||||
"if" expr "then" if_clause ";"? "else" if_clause {
|
||||
let region = cover $1 (if_clause_to_region $7) in
|
||||
let value : conditional = {
|
||||
let value : AST.conditional = {
|
||||
kwd_if = $1;
|
||||
test = $2;
|
||||
kwd_then = $3;
|
||||
@ -543,12 +511,10 @@ if_clause:
|
||||
| clause_block { ClauseBlock $1 }
|
||||
|
||||
clause_block:
|
||||
block {
|
||||
LongBlock $1 }
|
||||
block { LongBlock $1 }
|
||||
| "{" sep_or_term_list(statement,";") "}" {
|
||||
let region = cover $1 $3 in
|
||||
let value = {
|
||||
lbrace = $1;
|
||||
let value = {lbrace = $1;
|
||||
inside = $2;
|
||||
rbrace = $3} in
|
||||
ShortBlock {value; region} }
|
||||
@ -560,8 +526,7 @@ case(rhs):
|
||||
"case" expr "of" "|"? cases(rhs) "end" {
|
||||
fun rhs_to_region ->
|
||||
let region = cover $1 $6 in
|
||||
let value = {
|
||||
kwd_case = $1;
|
||||
let value = {kwd_case = $1;
|
||||
expr = $2;
|
||||
opening = Kwd $3;
|
||||
lead_vbar = $4;
|
||||
@ -572,8 +537,7 @@ case(rhs):
|
||||
| "case" expr "of" "[" "|"? cases(rhs) "]" {
|
||||
fun rhs_to_region ->
|
||||
let region = cover $1 $7 in
|
||||
let value = {
|
||||
kwd_case = $1;
|
||||
let value = {kwd_case = $1;
|
||||
expr = $2;
|
||||
opening = KwdBracket ($3,$4);
|
||||
lead_vbar = $5;
|
||||
@ -618,17 +582,13 @@ loop:
|
||||
while_loop:
|
||||
"while" expr block {
|
||||
let region = cover $1 $3.region
|
||||
and value = {
|
||||
kwd_while = $1;
|
||||
cond = $2;
|
||||
block = $3}
|
||||
and value = {kwd_while=$1; cond=$2; block=$3}
|
||||
in While {region; value} }
|
||||
|
||||
for_loop:
|
||||
"for" var_assign "to" expr block {
|
||||
let region = cover $1 $5.region in
|
||||
let value = {
|
||||
kwd_for = $1;
|
||||
let value = {kwd_for = $1;
|
||||
assign = $2;
|
||||
kwd_to = $3;
|
||||
bound = $4;
|
||||
@ -637,8 +597,7 @@ for_loop:
|
||||
}
|
||||
| "for" var arrow_clause? "in" collection expr block {
|
||||
let region = cover $1 $7.region in
|
||||
let value = {
|
||||
kwd_for = $1;
|
||||
let value = {kwd_for = $1;
|
||||
var = $2;
|
||||
bind_to = $3;
|
||||
kwd_in = $4;
|
||||
@ -655,7 +614,7 @@ collection:
|
||||
var_assign:
|
||||
var ":=" expr {
|
||||
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} }
|
||||
|
||||
arrow_clause:
|
||||
@ -675,7 +634,7 @@ expr:
|
||||
cond_expr:
|
||||
"if" expr "then" expr ";"? "else" expr {
|
||||
let region = cover $1 (expr_to_region $7) in
|
||||
let value : cond_expr = {
|
||||
let value : AST.cond_expr = {
|
||||
kwd_if = $1;
|
||||
test = $2;
|
||||
kwd_then = $3;
|
||||
@ -686,37 +645,31 @@ cond_expr:
|
||||
in ECond {region; value} }
|
||||
|
||||
disj_expr:
|
||||
disj_expr "or" conj_expr {
|
||||
conj_expr { $1 }
|
||||
| disj_expr "or" conj_expr {
|
||||
let start = expr_to_region $1
|
||||
and stop = expr_to_region $3 in
|
||||
let region = cover start stop
|
||||
and value = {arg1=$1; op=$2; arg2=$3} in
|
||||
ELogic (BoolExpr (Or {region; value}))
|
||||
}
|
||||
| conj_expr { $1 }
|
||||
ELogic (BoolExpr (Or {region; value})) }
|
||||
|
||||
conj_expr:
|
||||
conj_expr "and" set_membership {
|
||||
set_membership { $1 }
|
||||
| conj_expr "and" set_membership {
|
||||
let start = expr_to_region $1
|
||||
and stop = expr_to_region $3 in
|
||||
let region = cover start stop
|
||||
and value = {arg1=$1; op=$2; arg2=$3}
|
||||
in ELogic (BoolExpr (And {region; value}))
|
||||
}
|
||||
| set_membership { $1 }
|
||||
in ELogic (BoolExpr (And {region; value})) }
|
||||
|
||||
set_membership:
|
||||
core_expr "contains" set_membership {
|
||||
comp_expr { $1 }
|
||||
| core_expr "contains" set_membership {
|
||||
let start = expr_to_region $1
|
||||
and stop = expr_to_region $3 in
|
||||
let region = cover start stop in
|
||||
let value = {
|
||||
set = $1;
|
||||
kwd_contains = $2;
|
||||
element = $3}
|
||||
in ESet (SetMem {region; value})
|
||||
}
|
||||
| comp_expr { $1 }
|
||||
let value = {set=$1; kwd_contains=$2; element=$3}
|
||||
in ESet (SetMem {region; value}) }
|
||||
|
||||
comp_expr:
|
||||
comp_expr "<" cat_expr {
|
||||
@ -919,8 +872,7 @@ projection:
|
||||
struct_name "." nsepseq(selection,".") {
|
||||
let stop = nsepseq_to_region selection_to_region $3 in
|
||||
let region = cover $1.region stop
|
||||
and value = {
|
||||
struct_name = $1;
|
||||
and value = {struct_name = $1;
|
||||
selector = $2;
|
||||
field_path = $3}
|
||||
in {region; value} }
|
||||
@ -953,8 +905,7 @@ record_expr:
|
||||
field_assignment:
|
||||
field_name "=" expr {
|
||||
let region = cover $1.region (expr_to_region $3)
|
||||
and value = {
|
||||
field_name = $1;
|
||||
and value = {field_name = $1;
|
||||
equal = $2;
|
||||
field_expr = $3}
|
||||
in {region; value} }
|
||||
@ -968,8 +919,7 @@ tuple_expr:
|
||||
par(tuple_comp) { $1 }
|
||||
|
||||
tuple_comp:
|
||||
expr "," nsepseq(expr,",") {
|
||||
Utils.nsepseq_cons $1 $2 $3 }
|
||||
expr "," nsepseq(expr,",") { Utils.nsepseq_cons $1 $2 $3 }
|
||||
|
||||
arguments:
|
||||
par(nsepseq(expr,",")) { $1 }
|
||||
@ -981,12 +931,11 @@ list_expr:
|
||||
(* Patterns *)
|
||||
|
||||
pattern:
|
||||
core_pattern "#" nsepseq(core_pattern,"#") {
|
||||
core_pattern { $1 }
|
||||
| core_pattern "#" nsepseq(core_pattern,"#") {
|
||||
let value = Utils.nsepseq_cons $1 $2 $3 in
|
||||
let region = nsepseq_to_region pattern_to_region value
|
||||
in PList (PCons {region; value})
|
||||
}
|
||||
| core_pattern { $1 }
|
||||
in PList (PCons {region; value}) }
|
||||
|
||||
core_pattern:
|
||||
var { PVar $1 }
|
||||
|
||||
@ -22,6 +22,8 @@ type 'a sequence_or_record =
|
||||
| PaRecord of 'a record_elements
|
||||
| PaSingleExpr of expr
|
||||
|
||||
let (<@) f g x = f (g x)
|
||||
|
||||
(* END HEADER *)
|
||||
%}
|
||||
|
||||
@ -33,13 +35,14 @@ type 'a sequence_or_record =
|
||||
%type <AST.t> contract
|
||||
%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 COLON (* 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 COLON
|
||||
|
||||
%%
|
||||
|
||||
(* RULES *)
|
||||
@ -145,9 +148,8 @@ declaration:
|
||||
|
||||
type_decl:
|
||||
"type" type_name "=" type_expr {
|
||||
let region = cover $1 (type_expr_to_region $4) in
|
||||
let value = {
|
||||
kwd_type = $1;
|
||||
let region = cover $1 (type_expr_to_region $4)
|
||||
and value = {kwd_type = $1;
|
||||
name = $2;
|
||||
eq = $3;
|
||||
type_expr = $4}
|
||||
@ -185,8 +187,8 @@ core_type:
|
||||
let constr, arg = $1, $2 in
|
||||
let start = constr.region
|
||||
and stop = arg.region in
|
||||
let region = cover start stop in
|
||||
TApp {region; value = constr,arg} }
|
||||
let region = cover start stop
|
||||
in TApp {region; value = constr,arg} }
|
||||
|
||||
sum_type:
|
||||
"|" nsepseq(variant,"|") {
|
||||
@ -197,7 +199,7 @@ variant:
|
||||
"<constr>" { {$1 with value={constr=$1; arg=None}} }
|
||||
| "<constr>" "(" cartesian ")" {
|
||||
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} }
|
||||
|
||||
record_type:
|
||||
@ -212,10 +214,7 @@ type_expr_field:
|
||||
|
||||
field_decl:
|
||||
field_name {
|
||||
let value = {
|
||||
field_name = $1;
|
||||
colon = Region.ghost;
|
||||
field_type = TVar $1}
|
||||
let value = {field_name=$1; colon=ghost; field_type = TVar $1}
|
||||
in {$1 with value}
|
||||
}
|
||||
| field_name ":" type_expr_field {
|
||||
@ -252,7 +251,8 @@ let_binding:
|
||||
{binders = PRecord $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
|
||||
}
|
||||
| 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 {
|
||||
let hd, tl = $1 in
|
||||
let start = pattern_to_region hd in
|
||||
@ -292,14 +292,12 @@ typed_pattern:
|
||||
let start = pattern_to_region $1 in
|
||||
let stop = type_expr_to_region $3 in
|
||||
let region = cover start stop in
|
||||
let value = {
|
||||
pattern = $1;
|
||||
colon = $2;
|
||||
type_expr = $3}
|
||||
let value = {pattern=$1; colon=$2; type_expr=$3}
|
||||
in {region; value} }
|
||||
|
||||
pattern:
|
||||
"[" sub_pattern "," "..." sub_pattern "]" {
|
||||
core_pattern { $1 }
|
||||
| "[" sub_pattern "," "..." sub_pattern "]" {
|
||||
let start = pattern_to_region $2 in
|
||||
let stop = pattern_to_region $5 in
|
||||
let region = cover start stop in
|
||||
@ -311,9 +309,7 @@ pattern:
|
||||
let start = pattern_to_region hd in
|
||||
let stop = last fst tl in
|
||||
let region = cover start stop
|
||||
in PTuple {value=$1; region}
|
||||
}
|
||||
| core_pattern { $1 }
|
||||
in PTuple {value=$1; region} }
|
||||
|
||||
sub_pattern:
|
||||
par(sub_pattern) { PPar $1 }
|
||||
@ -336,8 +332,7 @@ record_pattern:
|
||||
"{" sep_or_term_list(field_pattern,",") "}" {
|
||||
let ne_elements, terminator = $2 in
|
||||
let region = cover $1 $3 in
|
||||
let value = {
|
||||
compound = Braces ($1,$3);
|
||||
let value = {compound = Braces ($1,$3);
|
||||
ne_elements;
|
||||
terminator}
|
||||
in {region; value} }
|
||||
@ -383,7 +378,6 @@ interactive_expr:
|
||||
expr:
|
||||
base_cond__open(expr) | switch_expr(base_cond) { $1 }
|
||||
|
||||
|
||||
base_cond__open(x):
|
||||
base_expr(x) | conditional(x) { $1 }
|
||||
|
||||
@ -391,7 +385,7 @@ base_cond:
|
||||
base_cond__open(base_cond) { $1 }
|
||||
|
||||
type_expr_simple_args:
|
||||
"(" nsepseq(type_expr_simple, ",") ")" { $1, $2, $3 }
|
||||
par(nsepseq(type_expr_simple, ",")) { $1 }
|
||||
|
||||
type_expr_simple:
|
||||
core_expr_2 type_expr_simple_args? {
|
||||
@ -403,29 +397,27 @@ type_expr_simple:
|
||||
let app a = function
|
||||
FieldName v -> a ^ "." ^ v.value
|
||||
| Component {value = c, _; _} -> a ^ "." ^ c in
|
||||
let path =
|
||||
let value =
|
||||
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 ->
|
||||
{r with value = fst r.value}
|
||||
| EString String s -> s
|
||||
| ELogic BoolExpr (True t) -> {value="true"; region=t}
|
||||
| ELogic BoolExpr (False f) -> {value="false"; region=f}
|
||||
| _ -> failwith "Not supported"
|
||||
| ELogic BoolExpr (True t) -> {region=t; value="true"}
|
||||
| ELogic BoolExpr (False f) -> {region=f; value="false"}
|
||||
| _ -> failwith "Not supported" (* TODO: raise a proper exception *)
|
||||
in match args with
|
||||
Some (lpar, args, rpar) ->
|
||||
let region = cover (expr_to_region $1) rpar
|
||||
and value = {inside=args; lpar; rpar} in
|
||||
Some {value; _} ->
|
||||
let region = cover (expr_to_region $1) value.rpar in
|
||||
let value = constr, {region; value}
|
||||
in TApp {region; value}
|
||||
| None -> TVar constr
|
||||
}
|
||||
| "(" nsepseq(type_expr_simple, ",") ")" {
|
||||
TProd {value=$2; region = cover $1 $3}
|
||||
TProd {region = cover $1 $3; value=$2}
|
||||
}
|
||||
| "(" 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_expr_simple { $1,$2 }
|
||||
@ -433,22 +425,24 @@ type_annotation_simple:
|
||||
fun_expr:
|
||||
disj_expr_level es6_func {
|
||||
let arrow, body = $2 in
|
||||
let kwd_fun = Region.ghost in
|
||||
let kwd_fun = ghost in
|
||||
let start = expr_to_region $1 in
|
||||
let stop = expr_to_region body in
|
||||
let region = cover start stop in
|
||||
let rec arg_to_pattern = (function
|
||||
| EVar val_ -> PVar val_
|
||||
| EAnnot {value = {inside = EVar v, colon, typ; _}; region} ->
|
||||
|
||||
let rec arg_to_pattern = function
|
||||
EVar v -> PVar v
|
||||
| EAnnot {region; value = {inside = EVar v, colon, typ; _}} ->
|
||||
let value = {pattern = PVar v; colon; type_expr = typ}
|
||||
in PTyped {region; value}
|
||||
| EPar {value = {inside; lpar; rpar}; region} ->
|
||||
PPar {value = {inside = arg_to_pattern inside; lpar; rpar}; region}
|
||||
| EPar p ->
|
||||
let value =
|
||||
{p.value with inside = arg_to_pattern p.value.inside}
|
||||
in PPar {p with value}
|
||||
| EUnit u -> PUnit u
|
||||
| _ -> failwith "Not supported"
|
||||
)
|
||||
in
|
||||
let fun_args_to_pattern = (function
|
||||
| _ -> failwith "Not supported" in (* TODO: raise a proper exception *)
|
||||
|
||||
let fun_args_to_pattern = function
|
||||
EAnnot {
|
||||
value = {
|
||||
inside = ETuple {value=fun_args; _}, _, _;
|
||||
@ -456,7 +450,7 @@ fun_expr:
|
||||
_} ->
|
||||
(* ((foo:x, bar) : type) *)
|
||||
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
|
||||
| EAnnot {
|
||||
value = {
|
||||
@ -467,25 +461,23 @@ fun_expr:
|
||||
(arg_to_pattern fun_arg, [])
|
||||
| EPar {value = {inside = 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; _} ->
|
||||
let bindings = List.map (fun arg -> arg_to_pattern (snd arg)) (snd fun_args) in
|
||||
(arg_to_pattern (fst fun_args), bindings)
|
||||
let bindings =
|
||||
List.map (arg_to_pattern <@ snd) (snd fun_args)
|
||||
in arg_to_pattern (fst fun_args), bindings
|
||||
| EUnit e ->
|
||||
arg_to_pattern (EUnit e), []
|
||||
| _ -> failwith "Not supported"
|
||||
)
|
||||
in
|
||||
| _ -> failwith "Not supported" in (* TODO: raise a proper exception *)
|
||||
|
||||
let binders = fun_args_to_pattern $1 in
|
||||
let f = {
|
||||
kwd_fun ;
|
||||
binders ;
|
||||
lhs_type = None;
|
||||
arrow ;
|
||||
body ;
|
||||
} in
|
||||
EFun { region; value=f }
|
||||
}
|
||||
let f = {kwd_fun;
|
||||
binders;
|
||||
lhs_type=None;
|
||||
arrow;
|
||||
body}
|
||||
in EFun {region; value=f} }
|
||||
|
||||
base_expr(right_expr):
|
||||
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 ifnot = EUnit {region=ghost; value=the_unit} in
|
||||
let region = cover $1 $5 in
|
||||
ECond {
|
||||
value = {
|
||||
kwd_if = $1;
|
||||
let value = {kwd_if = $1;
|
||||
test = $2;
|
||||
kwd_then = $3;
|
||||
ifso = $4;
|
||||
kwd_else = Region.ghost;
|
||||
ifnot;
|
||||
};
|
||||
region
|
||||
}
|
||||
}
|
||||
kwd_else = ghost;
|
||||
ifnot}
|
||||
in ECond {region; value} }
|
||||
|
||||
if_then_else(right_expr):
|
||||
"if" parenthesized_expr "{" closed_if ";" "}"
|
||||
"else" "{" right_expr ";" "}" {
|
||||
let region = cover $1 $11 in
|
||||
ECond {
|
||||
value = {
|
||||
kwd_if = $1;
|
||||
let value = {kwd_if = $1;
|
||||
test = $2;
|
||||
kwd_then = $3;
|
||||
ifso = $4;
|
||||
kwd_else = $6;
|
||||
ifnot = $9
|
||||
};
|
||||
region
|
||||
}
|
||||
}
|
||||
ifnot = $9}
|
||||
in ECond {region; value} }
|
||||
|
||||
base_if_then_else__open(x):
|
||||
base_expr(x) | if_then_else(x) { $1 }
|
||||
@ -543,17 +525,17 @@ closed_if:
|
||||
|
||||
switch_expr(right_expr):
|
||||
"switch" switch_expr_ "{" cases(right_expr) "}" {
|
||||
let start = $1 in
|
||||
let stop = $5 in
|
||||
let cases = {
|
||||
value = $4;
|
||||
region = nsepseq_to_region (fun x -> x.region) $4} in
|
||||
let start = $1
|
||||
and stop = $5 in
|
||||
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;
|
||||
expr = $2;
|
||||
lead_vbar = None;
|
||||
kwd_with = Region.ghost;
|
||||
kwd_with = ghost;
|
||||
cases}
|
||||
in ECase {region; value} }
|
||||
|
||||
@ -564,8 +546,7 @@ switch_expr_:
|
||||
cases(right_expr):
|
||||
nseq(case_clause(right_expr)) {
|
||||
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):
|
||||
"|" pattern "=>" right_expr ";"? {
|
||||
@ -616,11 +597,8 @@ disj_expr:
|
||||
ELogic (BoolExpr (Or $1)) }
|
||||
|
||||
conj_expr_level:
|
||||
conj_expr
|
||||
| comp_expr_level { $1 }
|
||||
|
||||
conj_expr:
|
||||
bin_op(conj_expr_level, "&&", comp_expr_level) {
|
||||
comp_expr_level { $1 }
|
||||
| bin_op(conj_expr_level, "&&", comp_expr_level) {
|
||||
ELogic (BoolExpr (And $1)) }
|
||||
|
||||
comp_expr_level:
|
||||
@ -678,10 +656,7 @@ call_expr_level:
|
||||
| None -> expr_to_region $1 in
|
||||
match $2 with
|
||||
Some (colon, t) ->
|
||||
let value = {
|
||||
lpar=Region.ghost;
|
||||
inside=$1,colon,t;
|
||||
rpar=Region.ghost}
|
||||
let value = {lpar=ghost; inside=$1,colon,t; rpar=ghost}
|
||||
in EAnnot {region; value}
|
||||
| None -> $1 }
|
||||
|
||||
@ -774,30 +749,26 @@ module_field:
|
||||
|
||||
selection:
|
||||
"[" "<int>" "]" selection {
|
||||
let r, (h, t) = $4 in
|
||||
let r, (hd, tl) = $4 in
|
||||
let result: (selection, dot) Utils.nsepseq =
|
||||
Component $2, (Region.ghost, h) :: t
|
||||
Component $2, (ghost, hd) :: tl
|
||||
in r, result
|
||||
}
|
||||
| "." field_name selection {
|
||||
let r, (h, t) = $3 in
|
||||
let r, (hd, tl) = $3 in
|
||||
let result: (selection, dot) Utils.nsepseq =
|
||||
FieldName $2, ($1, h) :: t
|
||||
FieldName $2, ($1, hd) :: tl
|
||||
in r, result
|
||||
}
|
||||
| "." field_name {
|
||||
$1, (FieldName $2, [])
|
||||
}
|
||||
| "[" "<int>" "]" {
|
||||
Region.ghost, (Component $2, []) }
|
||||
| "." field_name { $1, (FieldName $2, []) }
|
||||
| "[" "<int>" "]" { ghost, (Component $2, []) }
|
||||
|
||||
projection:
|
||||
struct_name selection {
|
||||
let start = $1.region in
|
||||
let stop = nsepseq_to_region selection_to_region (snd $2) in
|
||||
let region = cover start stop
|
||||
and value = {
|
||||
struct_name = $1;
|
||||
and value = {struct_name = $1;
|
||||
selector = fst $2;
|
||||
field_path = snd $2}
|
||||
in {region; value}
|
||||
@ -810,8 +781,7 @@ projection:
|
||||
let start = $1.region in
|
||||
let stop = nsepseq_to_region selection_to_region (snd $4) in
|
||||
let region = cover start stop
|
||||
and value = {
|
||||
struct_name;
|
||||
and value = {struct_name;
|
||||
selector = fst $4;
|
||||
field_path = snd $4}
|
||||
in {region; value} }
|
||||
@ -835,14 +805,12 @@ sequence_or_record:
|
||||
let region = cover $1 $3 in
|
||||
match $2 with
|
||||
PaSequence s ->
|
||||
let value: expr injection = {
|
||||
compound;
|
||||
let value = {compound;
|
||||
elements = Some s.s_elts;
|
||||
terminator = s.s_terminator}
|
||||
in ESeq {region; value}
|
||||
| PaRecord r ->
|
||||
let value: field_assign reg ne_injection = {
|
||||
compound;
|
||||
let value = {compound;
|
||||
ne_elements = r.r_elts;
|
||||
terminator = r.r_terminator}
|
||||
in ERecord {region; value}
|
||||
@ -852,7 +820,7 @@ field_assignment:
|
||||
field_name {
|
||||
let value = {
|
||||
field_name = $1;
|
||||
assignment = Region.ghost;
|
||||
assignment = ghost;
|
||||
field_expr = EVar $1 }
|
||||
in {$1 with value}
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user