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

Finished narrowing the gap between Ligodity AST and Pascaligo AST.

Browse Source
This commit is contained in:
Christian Rinderknecht 2019-05-13 17:35:31 +02:00 committed by Georges Dupéron
parent 0796567aee
commit 011ae44b54
3 changed files with 257 additions and 216 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

155
src/parser/ligodity/AST.ml
View File

@ -201,22 +201,24 @@ and field_pattern = {
} }
and expr = and expr =
ELetIn of let_in reg ECase of expr case reg
| EFun of fun_expr | ELogic of logic_expr
| ECond of conditional | EArith of arith_expr
| ETuple of (expr, comma) Utils.nsepseq reg | EString of string_expr
| EMatch of match_expr reg | EList of list_expr
| ESeq of sequence | EConstr of constr
| ERecord of record_expr | ERecord of record_expr
| ELogic of logic_expr | EProj of projection reg
| EArith of arith_expr | EVar of variable
| EString of string_expr | ECall of (expr * expr) reg
| ECall of (expr * expr) reg | EUnit of the_unit reg
| Path of path reg | ETuple of (expr, comma) Utils.nsepseq reg
| EUnit of the_unit reg | EPar of expr par reg
| EPar of expr par reg
| EList of list_expr | ELetIn of let_in reg
| EConstr of constr | EFun of fun_expr
| ECond of conditional reg
| ESeq of sequence
and 'a injection = { and 'a injection = {
opening : opening; opening : opening;
@ -227,6 +229,7 @@ and 'a injection = {
and opening = and opening =
Begin of kwd_begin Begin of kwd_begin
| With of kwd_with
| LBrace of lbrace | LBrace of lbrace
| LBracket of lbracket | LBracket of lbracket
@ -285,13 +288,14 @@ and comp_expr =
| Equal of equal bin_op reg | Equal of equal bin_op reg
| Neq of neq bin_op reg | Neq of neq bin_op reg
and path = { and projection = {
module_proj : (constr * dot) option; struct_name : variable;
value_proj : (selection, dot) Utils.nsepseq selector : dot;
field_path : (selection, dot) Utils.nsepseq
} }
and selection = and selection =
Name of variable FieldName of variable
| Component of (string * Z.t) reg par reg | Component of (string * Z.t) reg par reg
and record_expr = field_assignment reg injection reg and record_expr = field_assignment reg injection reg
@ -304,18 +308,33 @@ and field_assignment = {
and sequence = expr injection reg and sequence = expr injection reg
and match_expr = kwd_match * expr * kwd_with * cases and 'a case = {
kwd_match : kwd_match;
expr : expr;
opening : opening;
lead_vbar : vbar option;
cases : ('a case_clause reg, vbar) Utils.nsepseq reg;
closing : closing
}
and cases = and 'a case_clause = {
vbar option * (pattern * arrow * expr, vbar) Utils.nsepseq pattern : pattern;
arrow : arrow;
rhs : 'a
}
and let_in = kwd_let * let_bindings * kwd_in * expr and let_in = kwd_let * let_bindings * kwd_in * expr
and fun_expr = (kwd_fun * variable * arrow * expr) reg and fun_expr = (kwd_fun * variable * arrow * expr) reg
and conditional = and conditional = {
IfThen of (kwd_if * expr * kwd_then * expr) reg kwd_if : kwd_if;
| IfThenElse of (kwd_if * expr * kwd_then * expr * kwd_else * expr) reg test : expr;
kwd_then : kwd_then;
ifso : expr;
kwd_else : kwd_else;
ifnot : expr
}
(* Projecting regions of the input source code *) (* Projecting regions of the input source code *)
@ -364,9 +383,8 @@ let region_of_expr = function
| EString e -> region_of_string_expr e | EString e -> region_of_string_expr e
| EList e -> region_of_list_expr e | EList e -> region_of_list_expr e
| ELetIn {region;_} | EFun {region;_} | ELetIn {region;_} | EFun {region;_}
| ECond IfThen {region;_} | ECond IfThenElse {region; _} | ECond {region;_} | ETuple {region;_} | ECase {region;_}
| ETuple {region;_} | EMatch {region;_} | ECall {region;_} | EVar {region; _} | EProj {region; _}
| ECall {region;_} | Path {region;_}
| EUnit {region;_} | EPar {region;_} | EUnit {region;_} | EPar {region;_}
| ESeq {region; _} | ERecord {region; _} | ESeq {region; _} | ERecord {region; _}
| EConstr {region; _} -> region | EConstr {region; _} -> region
@ -384,11 +402,8 @@ let norm_fun region kwd_fun pattern eq expr =
PVar v -> kwd_fun, v, eq, expr PVar v -> kwd_fun, v, eq, expr
| _ -> let value = Utils.gen_sym () in | _ -> let value = Utils.gen_sym () in
let fresh = Region.{region=Region.ghost; value} in let fresh = Region.{region=Region.ghost; value} in
let proj = Name fresh, [] in
let path = {module_proj=None; value_proj=proj} in
let path = Region.{region=Region.ghost; value=path} in
let bindings = {pattern; eq; let bindings = {pattern; eq;
lhs_type=None; let_rhs = Path path}, [] in lhs_type=None; let_rhs = EVar fresh}, [] in
let let_in = ghost_let, bindings, ghost_in, expr in let let_in = ghost_let, bindings, ghost_in, expr in
let expr = ELetIn {value=let_in; region=Region.ghost} let expr = ELetIn {value=let_in; region=Region.ghost}
in kwd_fun, fresh, ghost_arrow, expr in kwd_fun, fresh, ghost_arrow, expr
@ -452,7 +467,6 @@ let print_sepseq sep print = function
| Some seq -> print_nsepseq sep print seq | Some seq -> print_nsepseq sep print seq
let print_csv print = print_nsepseq "," print let print_csv print = print_nsepseq "," print
let print_bsv print = print_nsepseq "|" print
let print_token (reg: Region.t) conc = let print_token (reg: Region.t) conc =
Printf.printf "%s: %s\n" (reg#compact `Byte) conc Printf.printf "%s: %s\n" (reg#compact `Byte) conc
@ -512,18 +526,14 @@ and print_type_par {value={lpar;inside=t;rpar}; _} =
print_type_expr t; print_type_expr t;
print_token rpar ")" print_token rpar ")"
and print_path Region.{value; _} = and print_projection Region.{value; _} =
let {module_proj; value_proj} = value in let {struct_name; selector; field_path} = value in
let () = print_uident struct_name;
match module_proj with print_token selector ".";
None -> () print_nsepseq "." print_selection field_path
| Some (name, dot) ->
print_uident name;
print_token dot "."
in print_nsepseq "." print_selection value_proj
and print_selection = function and print_selection = function
Name id -> print_var id FieldName id -> print_var id
| Component {value; _} -> | Component {value; _} ->
let {lpar; inside; rpar} = value in let {lpar; inside; rpar} = value in
let Region.{value=lexeme,z; region} = inside in let Region.{value=lexeme,z; region} = inside in
@ -563,6 +573,7 @@ and print_injection :
and print_opening = function and print_opening = function
Begin region -> print_token region "begin" Begin region -> print_token region "begin"
| With region -> print_token region "with"
| LBrace region -> print_token region "{" | LBrace region -> print_token region "{"
| LBracket region -> print_token region "[" | LBracket region -> print_token region "["
@ -651,7 +662,7 @@ and print_expr undo = function
ELetIn {value;_} -> print_let_in undo value ELetIn {value;_} -> print_let_in undo value
| ECond cond -> print_conditional undo cond | ECond cond -> print_conditional undo cond
| ETuple {value;_} -> print_csv (print_expr undo) value | ETuple {value;_} -> print_csv (print_expr undo) value
| EMatch {value;_} -> print_match_expr undo value | ECase {value;_} -> print_match_expr undo value
| EFun {value=(kwd_fun,_,_,_) as f; _} as e -> | EFun {value=(kwd_fun,_,_,_) as f; _} as e ->
if undo then if undo then
let patterns, arrow, expr = unparse' e in let patterns, arrow, expr = unparse' e in
@ -666,7 +677,8 @@ and print_expr undo = function
| EString e -> print_string_expr undo e | EString e -> print_string_expr undo e
| ECall {value=e1,e2; _} -> print_expr undo e1; print_expr undo e2 | ECall {value=e1,e2; _} -> print_expr undo e1; print_expr undo e2
| Path p -> print_path p | EVar v -> print_var v
| EProj p -> print_projection p
| EUnit {value=lpar,rpar; _} -> | EUnit {value=lpar,rpar; _} ->
print_token lpar "("; print_token rpar ")" print_token lpar "("; print_token rpar ")"
| EPar {value={lpar;inside=e;rpar}; _} -> | EPar {value={lpar;inside=e;rpar}; _} ->
@ -749,17 +761,28 @@ and print_field_assignment undo {value; _} =
and print_sequence undo seq = print_injection (print_expr undo) seq and print_sequence undo seq = print_injection (print_expr undo) seq
and print_match_expr undo (kwd_match, expr, kwd_with, (_,cases)) = and print_match_expr undo expr =
let {kwd_match; expr; opening;
lead_vbar; cases; closing} = expr in
print_token kwd_match "match"; print_token kwd_match "match";
print_expr undo expr; print_expr undo expr;
print_token kwd_with "with"; print_opening opening;
print_bsv (print_case undo) cases; print_token_opt lead_vbar "|";
print_token Region.ghost "end" print_cases undo cases;
print_closing closing
and print_case undo (pattern, arrow, expr) = and print_token_opt = function
None -> fun _ -> ()
| Some region -> print_token region
and print_cases undo {value; _} =
print_nsepseq "|" (print_case_clause undo) value
and print_case_clause undo {value; _} =
let {pattern; arrow; rhs} = value in
print_pattern pattern; print_pattern pattern;
print_token arrow "->"; print_token arrow "->";
print_expr undo expr print_expr undo rhs
and print_let_in undo (kwd_let, let_bindings, kwd_in, expr) = and print_let_in undo (kwd_let, let_bindings, kwd_in, expr) =
print_token kwd_let "let"; print_token kwd_let "let";
@ -773,20 +796,14 @@ and print_fun_expr undo (kwd_fun, rvar, arrow, expr) =
print_token arrow "->"; print_token arrow "->";
print_expr undo expr print_expr undo expr
and print_conditional undo = function and print_conditional undo {value; _} =
IfThenElse Region.{value=kwd_if, e1, kwd_then, e2, kwd_else, e3; _} -> let open Region in
print_token Region.ghost "("; let {kwd_if; test; kwd_then; ifso; kwd_else; ifnot} = value
print_token kwd_if "if"; in print_token ghost "(";
print_expr undo e1; print_token kwd_if "if";
print_token kwd_then "then"; print_expr undo test;
print_expr undo e2; print_token kwd_then "then";
print_token kwd_else "else"; print_expr undo ifso;
print_expr undo e3; print_token kwd_else "else";
print_token Region.ghost ")" print_expr undo ifnot;
| IfThen Region.{value=kwd_if, e1, kwd_then, e2; _} -> print_token ghost ")"
print_token Region.ghost "(";
print_token kwd_if "if";
print_expr undo e1;
print_token kwd_then "then";
print_expr undo e2;
print_token Region.ghost ")"

111
src/parser/ligodity/AST.mli
View File

@ -177,23 +177,6 @@ and field_decl = {
and type_tuple = (type_expr, comma) Utils.nsepseq par and type_tuple = (type_expr, comma) Utils.nsepseq par
and 'a injection = {
opening : opening;
elements : ('a, semi) Utils.sepseq;
terminator : semi option;
closing : closing
}
and opening =
Begin of kwd_begin
| LBrace of lbrace
| LBracket of lbracket
and closing =
End of kwd_end
| RBrace of rbrace
| RBracket of rbracket
and pattern = and pattern =
PTuple of (pattern, comma) Utils.nsepseq reg (* p1, p2, ... *) PTuple of (pattern, comma) Utils.nsepseq reg (* p1, p2, ... *)
| PList of list_pattern | PList of list_pattern
@ -228,24 +211,42 @@ and field_pattern = {
} }
and expr = and expr =
ELetIn of let_in reg (* let p1 = e1 and p2 = e2 and ... in e *) ECase of expr case reg (* p1 -> e1 | p2 -> e2 | ... *)
| EFun of fun_expr (* fun x -> e *) | ELogic of logic_expr
| ECond of conditional (* if e1 then e2 else e3 *) | EArith of arith_expr
| ETuple of (expr, comma) Utils.nsepseq reg (* e1, e2, ... *) | EString of string_expr
| EMatch of match_expr reg (* p1 -> e1 | p2 -> e2 | ... *)
| ESeq of sequence (* begin e1; e2; ... ; en end *)
| ERecord of record_expr (* {f1=e1; ... } *)
| ELogic of logic_expr
| EArith of arith_expr
| EString of string_expr
| ECall of (expr * expr) reg (* f e *)
| Path of path reg (* x x.y.z *)
| EUnit of the_unit reg (* () *)
| EPar of expr par reg (* (e) *)
| EList of list_expr | EList of list_expr
| EConstr of constr | EConstr of constr
| ERecord of record_expr (* {f1=e1; ... } *)
| EProj of projection reg (* x.y.z M.x.y *)
| EVar of variable (* x *)
| ECall of (expr * expr) reg (* f e *)
| EUnit of the_unit reg (* () *)
| ETuple of (expr, comma) Utils.nsepseq reg (* e1, e2, ... *)
| EPar of expr par reg (* (e) *)
| ELetIn of let_in reg (* let p1 = e1 and p2 = e2 and ... in e *)
| EFun of fun_expr (* fun x -> e *)
| ECond of conditional reg (* if e1 then e2 else e3 *)
| ESeq of sequence (* begin e1; e2; ... ; en end *)
and 'a injection = {
opening : opening;
elements : ('a, semi) Utils.sepseq;
terminator : semi option;
closing : closing
}
and opening =
Begin of kwd_begin
| With of kwd_with
| LBrace of lbrace
| LBracket of lbracket
and closing =
End of kwd_end
| RBrace of rbrace
| RBracket of rbracket
and list_expr = and list_expr =
Cons of cat bin_op reg (* e1 :: e3 *) Cons of cat bin_op reg (* e1 :: e3 *)
@ -296,22 +297,15 @@ and comp_expr =
| Geq of geq bin_op reg | Geq of geq bin_op reg
| Equal of equal bin_op reg | Equal of equal bin_op reg
| Neq of neq bin_op reg | Neq of neq bin_op reg
(*
| Lt of (expr * lt * expr) reg
| LEq of (expr * le * expr) reg
| Gt of (expr * gt * expr) reg
| GEq of (expr * ge * expr) reg
| NEq of (expr * ne * expr) reg
| Eq of (expr * eq * expr) reg
*)
and path = { and projection = {
module_proj : (constr * dot) option; struct_name : variable;
value_proj : (selection, dot) Utils.nsepseq selector : dot;
field_path : (selection, dot) Utils.nsepseq
} }
and selection = and selection =
Name of variable FieldName of variable
| Component of (string * Z.t) reg par reg | Component of (string * Z.t) reg par reg
and record_expr = field_assignment reg injection reg and record_expr = field_assignment reg injection reg
@ -324,18 +318,33 @@ and field_assignment = {
and sequence = expr injection reg and sequence = expr injection reg
and match_expr = kwd_match * expr * kwd_with * cases and 'a case = {
kwd_match : kwd_match;
expr : expr;
opening : opening;
lead_vbar : vbar option;
cases : ('a case_clause reg, vbar) Utils.nsepseq reg;
closing : closing
}
and cases = and 'a case_clause = {
vbar option * (pattern * arrow * expr, vbar) Utils.nsepseq pattern : pattern;
arrow : arrow;
rhs : 'a
}
and let_in = kwd_let * let_bindings * kwd_in * expr and let_in = kwd_let * let_bindings * kwd_in * expr
and fun_expr = (kwd_fun * variable * arrow * expr) reg and fun_expr = (kwd_fun * variable * arrow * expr) reg
and conditional = and conditional = {
IfThen of (kwd_if * expr * kwd_then * expr) reg kwd_if : kwd_if;
| IfThenElse of (kwd_if * expr * kwd_then * expr * kwd_else * expr) reg test : expr;
kwd_then : kwd_then;
ifso : expr;
kwd_else : kwd_else;
ifnot : expr
}
(* Normalising nodes of the AST so the interpreter is more uniform and (* Normalising nodes of the AST so the interpreter is more uniform and
no source regions are lost in order to enable all manner of no source regions are lost in order to enable all manner of

207
src/parser/ligodity/Parser.mly
View File

@ -46,6 +46,21 @@ ident : reg(Ident) { $1 }
constr : reg(Constr) { $1 } constr : reg(Constr) { $1 }
string : reg(Str) { $1 } string : reg(Str) { $1 }
eof : oreg(EOF) { $1 } eof : oreg(EOF) { $1 }
vbar : sym(VBAR) { $1 }
lpar : sym(LPAR) { $1 }
rpar : sym(RPAR) { $1 }
lbracket : sym(LBRACKET) { $1 }
rbracket : sym(RBRACKET) { $1 }
lbrace : sym(LBRACE) { $1 }
rbrace : sym(RBRACE) { $1 }
comma : sym(COMMA) { $1 }
semi : sym(SEMI) { $1 }
colon : sym(COLON) { $1 }
eq : sym(EQ) { $1 }
dot : sym(DOT) { $1 }
arrow : sym(ARROW) { $1 }
wild : sym(WILD) { $1 }
cons : sym(CONS) { $1 }
(* The rule [sep_or_term(item,sep)] ("separated or terminated list") (* The rule [sep_or_term(item,sep)] ("separated or terminated list")
parses a non-empty list of items separated by [sep], and optionally parses a non-empty list of items separated by [sep], and optionally
@ -66,9 +81,9 @@ sep_or_term_list(item,sep):
(* Compound constructs *) (* Compound constructs *)
par(X): sym(LPAR) X sym(RPAR) { {lpar=$1; inside=$2; rpar=$3} } par(X): lpar X rpar { {lpar=$1; inside=$2; rpar=$3} }
brackets(X): sym(LBRACKET) X sym(RBRACKET) { brackets(X): lbracket X rbracket {
{lbracket=$1; inside=$2; rbracket=$3} } {lbracket=$1; inside=$2; rbracket=$3} }
(* Sequences (* Sequences
@ -120,12 +135,12 @@ struct_name : Ident { $1 }
(* Non-empty comma-separated values (at least two values) *) (* Non-empty comma-separated values (at least two values) *)
tuple(item): tuple(item):
item sym(COMMA) nsepseq(item,sym(COMMA)) { let h,t = $3 in $1,($2,h)::t } item comma nsepseq(item,comma) { let h,t = $3 in $1,($2,h)::t }
(* Possibly empty semicolon-separated values between brackets *) (* Possibly empty semicolon-separated values between brackets *)
list_of(item): list_of(item):
sym(LBRACKET) sepseq(item,sym(SEMI)) sym(RBRACKET) { lbracket sepseq(item,semi) rbracket {
{opening = LBracket $1; {opening = LBracket $1;
elements = $2; elements = $2;
terminator = None; terminator = None;
@ -144,7 +159,7 @@ declaration:
(* Type declarations *) (* Type declarations *)
type_decl: type_decl:
kwd(Type) type_name sym(EQ) type_expr { kwd(Type) type_name eq type_expr {
{kwd_type=$1; name=$2; eq=$3; type_expr=$4} } {kwd_type=$1; name=$2; eq=$3; type_expr=$4} }
type_expr: type_expr:
@ -160,25 +175,11 @@ fun_type:
| reg(arrow_type) { TFun $1 } | reg(arrow_type) { TFun $1 }
arrow_type: arrow_type:
core_type sym(ARROW) fun_type { $1,$2,$3 } core_type arrow fun_type { $1,$2,$3 }
core_type: core_type:
reg(path) { type_projection {
let {module_proj; value_proj} = $1.value in TAlias $1
let selection_to_string = function
Name ident -> ident.value
| Component {value={inside;_}; _} ->
fst inside.value in
let module_str =
match module_proj with
None -> ""
| Some (constr,_) -> constr.value ^ "." in
let value_str =
Utils.nsepseq_to_list value_proj
|> List.map selection_to_string
|> String.concat "." in
let alias = module_str ^ value_str
in TAlias {$1 with value=alias}
} }
| reg(core_type type_constr {$1,$2}) { | reg(core_type type_constr {$1,$2}) {
let arg, constr = $1.value in let arg, constr = $1.value in
@ -194,8 +195,18 @@ core_type:
let Region.{region; value={lpar; inside=prod; rpar}} = $1 in let Region.{region; value={lpar; inside=prod; rpar}} = $1 in
TPar Region.{region; value={lpar; inside = TProd prod; rpar}} } TPar Region.{region; value={lpar; inside = TProd prod; rpar}} }
type_projection:
type_name {
$1
}
| reg(module_name dot type_name {$1,$2,$3}) {
let open Region in
let module_name,_ , type_name = $1.value in
let value = module_name.value ^ "." ^ type_name.value
in {$1 with value} }
type_constr: type_constr:
type_name { $1 } type_name { $1 }
| kwd(Set) { Region.{value="set"; region=$1} } | kwd(Set) { Region.{value="set"; region=$1} }
| kwd(Map) { Region.{value="map"; region=$1} } | kwd(Map) { Region.{value="map"; region=$1} }
| kwd(List) { Region.{value="list"; region=$1} } | kwd(List) { Region.{value="list"; region=$1} }
@ -204,15 +215,14 @@ type_tuple:
par(tuple(type_expr)) { $1 } par(tuple(type_expr)) { $1 }
sum_type: sum_type:
ioption(sym(VBAR)) nsepseq(reg(variant), sym(VBAR)) { $2 } ioption(vbar) nsepseq(reg(variant),vbar) { $2 }
variant: variant:
constr kwd(Of) cartesian { {constr=$1; args = Some ($2,$3)} } constr kwd(Of) cartesian { {constr=$1; args = Some ($2,$3)} }
| constr { {constr=$1; args=None} } | constr { {constr=$1; args = None} }
record_type: record_type:
sym(LBRACE) sep_or_term_list(reg(field_decl),sym(SEMI)) lbrace sep_or_term_list(reg(field_decl),semi) rbrace {
sym(RBRACE) {
let elements, terminator = $2 in { let elements, terminator = $2 in {
opening = LBrace $1; opening = LBrace $1;
elements = Some elements; elements = Some elements;
@ -220,7 +230,7 @@ record_type:
closing = RBrace $3} } closing = RBrace $3} }
field_decl: field_decl:
field_name sym(COLON) type_expr { field_name colon type_expr {
{field_name=$1; colon=$2; field_type=$3} } {field_name=$1; colon=$2; field_type=$3} }
(* Non-recursive definitions *) (* Non-recursive definitions *)
@ -229,15 +239,15 @@ let_bindings:
nsepseq(let_binding, kwd(And)) { $1 } nsepseq(let_binding, kwd(And)) { $1 }
let_binding: let_binding:
ident nseq(sub_irrefutable) option(type_annotation) sym(EQ) expr { ident nseq(sub_irrefutable) type_annotation? eq expr {
let let_rhs = EFun (norm $2 $4 $5) in let let_rhs = EFun (norm $2 $4 $5) in
{pattern = PVar $1; lhs_type=$3; eq = Region.ghost; let_rhs} {pattern = PVar $1; lhs_type=$3; eq = Region.ghost; let_rhs}
} }
| irrefutable option(type_annotation) sym(EQ) expr { | irrefutable type_annotation? eq expr {
{pattern=$1; lhs_type=$2; eq=$3; let_rhs=$4} } {pattern=$1; lhs_type=$2; eq=$3; let_rhs=$4} }
type_annotation: type_annotation:
sym(COLON) type_expr { $1,$2 } colon type_expr { $1,$2 }
(* Patterns *) (* Patterns *)
@ -247,7 +257,7 @@ irrefutable:
sub_irrefutable: sub_irrefutable:
ident { PVar $1 } ident { PVar $1 }
| sym(WILD) { PWild $1 } | wild { PWild $1 }
| unit { PUnit $1 } | unit { PUnit $1 }
| reg(par(closed_irrefutable)) { PPar $1 } | reg(par(closed_irrefutable)) { PPar $1 }
@ -258,13 +268,12 @@ closed_irrefutable:
| reg(typed_pattern) { PTyped $1 } | reg(typed_pattern) { PTyped $1 }
typed_pattern: typed_pattern:
irrefutable sym(COLON) type_expr { irrefutable colon type_expr { {pattern=$1; colon=$2; type_expr=$3} }
{pattern=$1; colon=$2; type_expr=$3} }
pattern: pattern:
reg(sub_pattern sym(CONS) tail {$1,$2,$3}) { PList (PCons $1) } reg(sub_pattern cons tail {$1,$2,$3}) { PList (PCons $1) }
| reg(tuple(sub_pattern)) { PTuple $1 } | reg(tuple(sub_pattern)) { PTuple $1 }
| core_pattern { $1 } | core_pattern { $1 }
sub_pattern: sub_pattern:
reg(par(tail)) { PPar $1 } reg(par(tail)) { PPar $1 }
@ -272,7 +281,7 @@ sub_pattern:
core_pattern: core_pattern:
ident { PVar $1 } ident { PVar $1 }
| sym(WILD) { PWild $1 } | wild { PWild $1 }
| unit { PUnit $1 } | unit { PUnit $1 }
| reg(Int) { PInt $1 } | reg(Int) { PInt $1 }
| kwd(True) { PTrue $1 } | kwd(True) { PTrue $1 }
@ -284,9 +293,7 @@ core_pattern:
| reg(record_pattern) { PRecord $1 } | reg(record_pattern) { PRecord $1 }
record_pattern: record_pattern:
sym(LBRACE) lbrace sep_or_term_list(reg(field_pattern),semi) rbrace {
sep_or_term_list(reg(field_pattern),sym(SEMI))
sym(RBRACE) {
let elements, terminator = $2 in let elements, terminator = $2 in
{opening = LBrace $1; {opening = LBrace $1;
elements = Some elements; elements = Some elements;
@ -294,7 +301,7 @@ record_pattern:
closing = RBrace $3} } closing = RBrace $3} }
field_pattern: field_pattern:
field_name sym(EQ) sub_pattern { field_name eq sub_pattern {
{field_name=$1; eq=$2; pattern=$3} } {field_name=$1; eq=$2; pattern=$3} }
constr_pattern: constr_pattern:
@ -305,17 +312,17 @@ ptuple:
reg(tuple(tail)) { PTuple $1 } reg(tuple(tail)) { PTuple $1 }
unit: unit:
reg(sym(LPAR) sym(RPAR) {$1,$2}) { $1 } reg(lpar rpar {$1,$2}) { $1 }
tail: tail:
reg(sub_pattern sym(CONS) tail {$1,$2,$3}) { PList (PCons $1) } reg(sub_pattern cons tail {$1,$2,$3}) { PList (PCons $1) }
| sub_pattern { $1 } | sub_pattern { $1 }
(* Expressions *) (* Expressions *)
expr: expr:
base_cond__open(expr) { $1 } base_cond__open(expr) { $1 }
| match_expr(base_cond) { EMatch $1 } | reg(match_expr(base_cond)) { ECase $1 }
base_cond__open(x): base_cond__open(x):
base_expr(x) base_expr(x)
@ -331,57 +338,63 @@ base_expr(right_expr):
| reg(tuple(disj_expr_level)) { ETuple $1 } | reg(tuple(disj_expr_level)) { ETuple $1 }
conditional(right_expr): conditional(right_expr):
if_then_else(right_expr) reg(if_then_else(right_expr))
| if_then(right_expr) { ECond $1 } | reg(if_then(right_expr)) { ECond $1 }
if_then(right_expr): if_then(right_expr):
reg(kwd(If) expr kwd(Then) right_expr {$1,$2,$3,$4}) { IfThen $1 } kwd(If) expr kwd(Then) right_expr {
let open Region in
let the_unit = ghost, ghost in
let ifnot = EUnit {region=ghost; value=the_unit} in
{kwd_if=$1; test=$2; kwd_then=$3; ifso=$4;
kwd_else=Region.ghost; ifnot} }
if_then_else(right_expr): if_then_else(right_expr):
reg(kwd(If) expr kwd(Then) closed_if kwd(Else) right_expr { kwd(If) expr kwd(Then) closed_if kwd(Else) right_expr {
$1,$2,$3,$4,$5,$6 }) { IfThenElse $1 } {kwd_if=$1; test=$2; kwd_then=$3; ifso=$4;
kwd_else=$5; ifnot = $6} }
base_if_then_else__open(x): base_if_then_else__open(x):
base_expr(x) { $1 } base_expr(x) { $1 }
| if_then_else(x) { ECond $1 } | reg(if_then_else(x)) { ECond $1 }
base_if_then_else: base_if_then_else:
base_if_then_else__open(base_if_then_else) { $1 } base_if_then_else__open(base_if_then_else) { $1 }
closed_if: closed_if:
base_if_then_else__open(closed_if) { $1 } base_if_then_else__open(closed_if) { $1 }
| match_expr(base_if_then_else) { EMatch $1 } | reg(match_expr(base_if_then_else)) { ECase $1 }
match_expr(right_expr): match_expr(right_expr):
reg(kwd(Match) expr kwd(With) kwd(Match) expr kwd(With) vbar? reg(cases(right_expr)) {
option(sym(VBAR)) cases(right_expr) { let cases = Utils.nsepseq_rev $5.value in
$1,$2,$3, ($4, Utils.nsepseq_rev $5) }) {kwd_match = $1; expr = $2; opening = With $3;
| reg(match_nat(right_expr)) { $1 } lead_vbar = $4; cases = {$5 with value=cases};
closing = End Region.ghost}
match_nat(right_expr): }
kwd(MatchNat) expr kwd(With) | kwd(MatchNat) expr kwd(With) vbar? reg(cases(right_expr)) {
option(sym(VBAR)) cases(right_expr) {
let open Region in let open Region in
let cast_name = Name {region=ghost; value="assert_pos"} in let cases = Utils.nsepseq_rev $5.value in
let cast_path = {module_proj=None; value_proj=cast_name,[]} in let cast = EVar {region=ghost; value="assert_pos"} in
let cast_fun = Path {region=ghost; value=cast_path} in let cast = ECall {region=ghost; value=cast,$2} in
let cast = ECall {region=ghost; value=cast_fun,$2} {kwd_match = $1; expr = cast; opening = With $3;
in $1, cast, $3, ($4, Utils.nsepseq_rev $5) } lead_vbar = $4; cases = {$5 with value=cases};
closing = End Region.ghost} }
cases(right_expr): cases(right_expr):
case(right_expr) { $1, [] } reg(case_clause(right_expr)) { $1, [] }
| cases(base_cond) sym(VBAR) case(right_expr) { | cases(base_cond) vbar reg(case_clause(right_expr)) {
let h,t = $1 in $3, ($2,h)::t } let h,t = $1 in $3, ($2,h)::t }
case(right_expr): case_clause(right_expr):
pattern sym(ARROW) right_expr { $1,$2,$3 } pattern arrow right_expr { {pattern=$1; arrow=$2; rhs=$3} }
let_expr(right_expr): let_expr(right_expr):
reg(kwd(Let) let_bindings kwd(In) right_expr {$1,$2,$3,$4}) { reg(kwd(Let) let_bindings kwd(In) right_expr {$1,$2,$3,$4}) {
ELetIn $1 } ELetIn $1 }
fun_expr(right_expr): fun_expr(right_expr):
reg(kwd(Fun) nseq(irrefutable) sym(ARROW) right_expr {$1,$2,$3,$4}) { reg(kwd(Fun) nseq(irrefutable) arrow right_expr {$1,$2,$3,$4}) {
let Region.{region; value = kwd_fun, patterns, arrow, expr} = $1 let Region.{region; value = kwd_fun, patterns, arrow, expr} = $1
in EFun (norm ~reg:(region, kwd_fun) patterns arrow expr) } in EFun (norm ~reg:(region, kwd_fun) patterns arrow expr) }
@ -428,7 +441,7 @@ ge_expr:
bin_op(comp_expr_level, sym(GE), cat_expr_level) { $1 } bin_op(comp_expr_level, sym(GE), cat_expr_level) { $1 }
eq_expr: eq_expr:
bin_op(comp_expr_level, sym(EQ), cat_expr_level) { $1 } bin_op(comp_expr_level, eq, cat_expr_level) { $1 }
ne_expr: ne_expr:
bin_op(comp_expr_level, sym(NE), cat_expr_level) { $1 } bin_op(comp_expr_level, sym(NE), cat_expr_level) { $1 }
@ -449,7 +462,7 @@ cons_expr_level:
| add_expr_level { $1 } | add_expr_level { $1 }
cons_expr: cons_expr:
bin_op(add_expr_level, sym(CONS), cons_expr_level) { $1 } bin_op(add_expr_level, cons, cons_expr_level) { $1 }
add_expr_level: add_expr_level:
reg(plus_expr) { EArith (Add $1) } reg(plus_expr) { EArith (Add $1) }
@ -457,10 +470,10 @@ add_expr_level:
| mult_expr_level { $1 } | mult_expr_level { $1 }
plus_expr: plus_expr:
bin_op(add_expr_level, sym(PLUS), mult_expr_level) { $1 } bin_op(add_expr_level, sym(PLUS), mult_expr_level) { $1 }
minus_expr: minus_expr:
bin_op(add_expr_level, sym(MINUS), mult_expr_level) { $1 } bin_op(add_expr_level, sym(MINUS), mult_expr_level) { $1 }
mult_expr_level: mult_expr_level:
reg(times_expr) { EArith (Mult $1) } reg(times_expr) { EArith (Mult $1) }
@ -489,7 +502,7 @@ not_expr:
un_op(kwd(Not), core_expr) { $1 } un_op(kwd(Not), core_expr) { $1 }
call_expr_level: call_expr_level:
reg(call_expr) { ECall $1 } reg(call_expr) { ECall $1 }
| core_expr { $1 } | core_expr { $1 }
call_expr: call_expr:
@ -499,37 +512,39 @@ core_expr:
reg(Int) { EArith (Int $1) } reg(Int) { EArith (Int $1) }
| reg(Mtz) { EArith (Mtz $1) } | reg(Mtz) { EArith (Mtz $1) }
| reg(Nat) { EArith (Nat $1) } | reg(Nat) { EArith (Nat $1) }
| reg(path) { Path $1 } | ident | reg(module_field) { EVar $1 }
| reg(projection) { EProj $1 }
| string { EString (String $1) } | string { EString (String $1) }
| unit { EUnit $1 } | unit { EUnit $1 }
| kwd(False) { ELogic (BoolExpr (False $1)) } | kwd(False) { ELogic (BoolExpr (False $1)) }
| kwd(True) { ELogic (BoolExpr ( True $1)) } | kwd(True) { ELogic (BoolExpr (True $1)) }
| reg(list_of(expr)) { EList (List $1) } | reg(list_of(expr)) { EList (List $1) }
| reg(par(expr)) { EPar $1 } | reg(par(expr)) { EPar $1 }
| constr { EConstr $1 } | constr { EConstr $1 }
| reg(sequence) { ESeq $1 } | reg(sequence) { ESeq $1 }
| reg(record_expr) { ERecord $1 } | reg(record_expr) { ERecord $1 }
path: module_field:
reg(struct_name) sym(DOT) nsepseq(selection,sym(DOT)) { module_name dot field_name { $1.value ^ "." ^ $3.value }
let head, tail = $3 in
let seq = Name $1, ($2,head)::tail projection:
in {module_proj=None; value_proj=seq} reg(struct_name) dot nsepseq(selection,dot) {
{struct_name = $1; selector = $2; field_path = $3}
} }
| module_name sym(DOT) nsepseq(selection,sym(DOT)) { | reg(module_name dot field_name {$1,$3})
{module_proj = Some ($1,$2); value_proj=$3} dot nsepseq(selection,dot) {
} let open Region in
| ident { let module_name, field_name = $1.value in
{module_proj = None; value_proj = Name $1, []} } let value = module_name.value ^ "." ^ field_name.value in
let struct_name = {$1 with value} in
{struct_name; selector = $2; field_path = $3} }
selection: selection:
ident { Name $1 } field_name { FieldName $1 }
| reg(par(reg(Int))) { Component $1 } | reg(par(reg(Int))) { Component $1 }
record_expr: record_expr:
sym(LBRACE) lbrace sep_or_term_list(reg(field_assignment),semi) rbrace {
sep_or_term_list(reg(field_assignment),sym(SEMI))
sym(RBRACE) {
let elements, terminator = $2 in let elements, terminator = $2 in
{opening = LBrace $1; {opening = LBrace $1;
elements = Some elements; elements = Some elements;
@ -537,11 +552,11 @@ record_expr:
closing = RBrace $3} } closing = RBrace $3} }
field_assignment: field_assignment:
field_name sym(EQ) expr { field_name eq expr {
{field_name=$1; assignment=$2; field_expr=$3} } {field_name=$1; assignment=$2; field_expr=$3} }
sequence: sequence:
kwd(Begin) sep_or_term_list(expr,sym(SEMI)) kwd(End) { kwd(Begin) sep_or_term_list(expr,semi) kwd(End) {
let elements, terminator = $2 in let elements, terminator = $2 in
{opening = Begin $1; {opening = Begin $1;
elements = Some elements; elements = Some elements;