Finished narrowing the gap between Ligodity AST and Pascaligo AST.
This commit is contained in:
Christian Rinderknecht
Georges Dupéron
parent
0796567aee
commit
011ae44b54
@ -201,22 +201,24 @@ and field_pattern = {
|
||||
}
|
||||
|
||||
and expr =
|
||||
ELetIn of let_in reg
|
||||
| EFun of fun_expr
|
||||
| ECond of conditional
|
||||
| ETuple of (expr, comma) Utils.nsepseq reg
|
||||
| EMatch of match_expr reg
|
||||
| ESeq of sequence
|
||||
| ERecord of record_expr
|
||||
ECase of expr case reg
|
||||
| ELogic of logic_expr
|
||||
| EArith of arith_expr
|
||||
| EString of string_expr
|
||||
| ECall of (expr * expr) reg
|
||||
| Path of path reg
|
||||
| EUnit of the_unit reg
|
||||
| EPar of expr par reg
|
||||
| EList of list_expr
|
||||
| EConstr of constr
|
||||
| ERecord of record_expr
|
||||
| EProj of projection reg
|
||||
| EVar of variable
|
||||
| ECall of (expr * expr) reg
|
||||
| EUnit of the_unit reg
|
||||
| ETuple of (expr, comma) Utils.nsepseq reg
|
||||
| EPar of expr par reg
|
||||
|
||||
| ELetIn of let_in reg
|
||||
| EFun of fun_expr
|
||||
| ECond of conditional reg
|
||||
| ESeq of sequence
|
||||
|
||||
and 'a injection = {
|
||||
opening : opening;
|
||||
@ -227,6 +229,7 @@ and 'a injection = {
|
||||
|
||||
and opening =
|
||||
Begin of kwd_begin
|
||||
| With of kwd_with
|
||||
| LBrace of lbrace
|
||||
| LBracket of lbracket
|
||||
|
||||
@ -285,13 +288,14 @@ and comp_expr =
|
||||
| Equal of equal bin_op reg
|
||||
| Neq of neq bin_op reg
|
||||
|
||||
and path = {
|
||||
module_proj : (constr * dot) option;
|
||||
value_proj : (selection, dot) Utils.nsepseq
|
||||
and projection = {
|
||||
struct_name : variable;
|
||||
selector : dot;
|
||||
field_path : (selection, dot) Utils.nsepseq
|
||||
}
|
||||
|
||||
and selection =
|
||||
Name of variable
|
||||
FieldName of variable
|
||||
| Component of (string * Z.t) reg par reg
|
||||
|
||||
and record_expr = field_assignment reg injection reg
|
||||
@ -304,18 +308,33 @@ and field_assignment = {
|
||||
|
||||
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 =
|
||||
vbar option * (pattern * arrow * expr, vbar) Utils.nsepseq
|
||||
and 'a case_clause = {
|
||||
pattern : pattern;
|
||||
arrow : arrow;
|
||||
rhs : 'a
|
||||
}
|
||||
|
||||
and let_in = kwd_let * let_bindings * kwd_in * expr
|
||||
|
||||
and fun_expr = (kwd_fun * variable * arrow * expr) reg
|
||||
|
||||
and conditional =
|
||||
IfThen of (kwd_if * expr * kwd_then * expr) reg
|
||||
| IfThenElse of (kwd_if * expr * kwd_then * expr * kwd_else * expr) reg
|
||||
and conditional = {
|
||||
kwd_if : kwd_if;
|
||||
test : expr;
|
||||
kwd_then : kwd_then;
|
||||
ifso : expr;
|
||||
kwd_else : kwd_else;
|
||||
ifnot : expr
|
||||
}
|
||||
|
||||
(* Projecting regions of the input source code *)
|
||||
|
||||
@ -364,9 +383,8 @@ let region_of_expr = function
|
||||
| EString e -> region_of_string_expr e
|
||||
| EList e -> region_of_list_expr e
|
||||
| ELetIn {region;_} | EFun {region;_}
|
||||
| ECond IfThen {region;_} | ECond IfThenElse {region; _}
|
||||
| ETuple {region;_} | EMatch {region;_}
|
||||
| ECall {region;_} | Path {region;_}
|
||||
| ECond {region;_} | ETuple {region;_} | ECase {region;_}
|
||||
| ECall {region;_} | EVar {region; _} | EProj {region; _}
|
||||
| EUnit {region;_} | EPar {region;_}
|
||||
| ESeq {region; _} | ERecord {region; _}
|
||||
| EConstr {region; _} -> region
|
||||
@ -384,11 +402,8 @@ let norm_fun region kwd_fun pattern eq expr =
|
||||
PVar v -> kwd_fun, v, eq, expr
|
||||
| _ -> let value = Utils.gen_sym () 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;
|
||||
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 expr = ELetIn {value=let_in; region=Region.ghost}
|
||||
in kwd_fun, fresh, ghost_arrow, expr
|
||||
@ -452,7 +467,6 @@ let print_sepseq sep print = function
|
||||
| Some seq -> print_nsepseq sep print seq
|
||||
|
||||
let print_csv print = print_nsepseq "," print
|
||||
let print_bsv print = print_nsepseq "|" print
|
||||
|
||||
let print_token (reg: Region.t) 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_token rpar ")"
|
||||
|
||||
and print_path Region.{value; _} =
|
||||
let {module_proj; value_proj} = value in
|
||||
let () =
|
||||
match module_proj with
|
||||
None -> ()
|
||||
| Some (name, dot) ->
|
||||
print_uident name;
|
||||
print_token dot "."
|
||||
in print_nsepseq "." print_selection value_proj
|
||||
and print_projection Region.{value; _} =
|
||||
let {struct_name; selector; field_path} = value in
|
||||
print_uident struct_name;
|
||||
print_token selector ".";
|
||||
print_nsepseq "." print_selection field_path
|
||||
|
||||
and print_selection = function
|
||||
Name id -> print_var id
|
||||
FieldName id -> print_var id
|
||||
| Component {value; _} ->
|
||||
let {lpar; inside; rpar} = value in
|
||||
let Region.{value=lexeme,z; region} = inside in
|
||||
@ -563,6 +573,7 @@ and print_injection :
|
||||
|
||||
and print_opening = function
|
||||
Begin region -> print_token region "begin"
|
||||
| With region -> print_token region "with"
|
||||
| LBrace 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
|
||||
| ECond cond -> print_conditional undo cond
|
||||
| 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 ->
|
||||
if undo then
|
||||
let patterns, arrow, expr = unparse' e in
|
||||
@ -666,7 +677,8 @@ and print_expr undo = function
|
||||
| EString e -> print_string_expr undo e
|
||||
|
||||
| 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; _} ->
|
||||
print_token lpar "("; print_token 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_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_expr undo expr;
|
||||
print_token kwd_with "with";
|
||||
print_bsv (print_case undo) cases;
|
||||
print_token Region.ghost "end"
|
||||
print_opening opening;
|
||||
print_token_opt lead_vbar "|";
|
||||
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_token arrow "->";
|
||||
print_expr undo expr
|
||||
print_expr undo rhs
|
||||
|
||||
and print_let_in undo (kwd_let, let_bindings, kwd_in, expr) =
|
||||
print_token kwd_let "let";
|
||||
@ -773,20 +796,14 @@ and print_fun_expr undo (kwd_fun, rvar, arrow, expr) =
|
||||
print_token arrow "->";
|
||||
print_expr undo expr
|
||||
|
||||
and print_conditional undo = function
|
||||
IfThenElse Region.{value=kwd_if, e1, kwd_then, e2, kwd_else, e3; _} ->
|
||||
print_token Region.ghost "(";
|
||||
and print_conditional undo {value; _} =
|
||||
let open Region in
|
||||
let {kwd_if; test; kwd_then; ifso; kwd_else; ifnot} = value
|
||||
in print_token ghost "(";
|
||||
print_token kwd_if "if";
|
||||
print_expr undo e1;
|
||||
print_expr undo test;
|
||||
print_token kwd_then "then";
|
||||
print_expr undo e2;
|
||||
print_expr undo ifso;
|
||||
print_token kwd_else "else";
|
||||
print_expr undo e3;
|
||||
print_token Region.ghost ")"
|
||||
| IfThen Region.{value=kwd_if, e1, kwd_then, e2; _} ->
|
||||
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 ")"
|
||||
print_expr undo ifnot;
|
||||
print_token ghost ")"
|
||||
|
||||
@ -177,23 +177,6 @@ and field_decl = {
|
||||
|
||||
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 =
|
||||
PTuple of (pattern, comma) Utils.nsepseq reg (* p1, p2, ... *)
|
||||
| PList of list_pattern
|
||||
@ -228,24 +211,42 @@ and field_pattern = {
|
||||
}
|
||||
|
||||
and expr =
|
||||
ELetIn of let_in reg (* let p1 = e1 and p2 = e2 and ... in e *)
|
||||
| EFun of fun_expr (* fun x -> e *)
|
||||
| ECond of conditional (* if e1 then e2 else e3 *)
|
||||
| ETuple of (expr, comma) Utils.nsepseq reg (* e1, e2, ... *)
|
||||
| EMatch of match_expr reg (* p1 -> e1 | p2 -> e2 | ... *)
|
||||
| ESeq of sequence (* begin e1; e2; ... ; en end *)
|
||||
| ERecord of record_expr (* {f1=e1; ... } *)
|
||||
|
||||
ECase of expr case reg (* p1 -> e1 | p2 -> e2 | ... *)
|
||||
| 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
|
||||
| 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 =
|
||||
Cons of cat bin_op reg (* e1 :: e3 *)
|
||||
@ -296,22 +297,15 @@ and comp_expr =
|
||||
| Geq of geq bin_op reg
|
||||
| Equal of equal 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 = {
|
||||
module_proj : (constr * dot) option;
|
||||
value_proj : (selection, dot) Utils.nsepseq
|
||||
and projection = {
|
||||
struct_name : variable;
|
||||
selector : dot;
|
||||
field_path : (selection, dot) Utils.nsepseq
|
||||
}
|
||||
|
||||
and selection =
|
||||
Name of variable
|
||||
FieldName of variable
|
||||
| Component of (string * Z.t) reg par reg
|
||||
|
||||
and record_expr = field_assignment reg injection reg
|
||||
@ -324,18 +318,33 @@ and field_assignment = {
|
||||
|
||||
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 =
|
||||
vbar option * (pattern * arrow * expr, vbar) Utils.nsepseq
|
||||
and 'a case_clause = {
|
||||
pattern : pattern;
|
||||
arrow : arrow;
|
||||
rhs : 'a
|
||||
}
|
||||
|
||||
and let_in = kwd_let * let_bindings * kwd_in * expr
|
||||
|
||||
and fun_expr = (kwd_fun * variable * arrow * expr) reg
|
||||
|
||||
and conditional =
|
||||
IfThen of (kwd_if * expr * kwd_then * expr) reg
|
||||
| IfThenElse of (kwd_if * expr * kwd_then * expr * kwd_else * expr) reg
|
||||
and conditional = {
|
||||
kwd_if : kwd_if;
|
||||
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
|
||||
no source regions are lost in order to enable all manner of
|
||||
|
||||
@ -46,6 +46,21 @@ ident : reg(Ident) { $1 }
|
||||
constr : reg(Constr) { $1 }
|
||||
string : reg(Str) { $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")
|
||||
parses a non-empty list of items separated by [sep], and optionally
|
||||
@ -66,9 +81,9 @@ sep_or_term_list(item,sep):
|
||||
|
||||
(* 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} }
|
||||
|
||||
(* Sequences
|
||||
@ -120,12 +135,12 @@ struct_name : Ident { $1 }
|
||||
(* Non-empty comma-separated values (at least two values) *)
|
||||
|
||||
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 *)
|
||||
|
||||
list_of(item):
|
||||
sym(LBRACKET) sepseq(item,sym(SEMI)) sym(RBRACKET) {
|
||||
lbracket sepseq(item,semi) rbracket {
|
||||
{opening = LBracket $1;
|
||||
elements = $2;
|
||||
terminator = None;
|
||||
@ -144,7 +159,7 @@ declaration:
|
||||
(* Type declarations *)
|
||||
|
||||
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} }
|
||||
|
||||
type_expr:
|
||||
@ -160,25 +175,11 @@ fun_type:
|
||||
| reg(arrow_type) { TFun $1 }
|
||||
|
||||
arrow_type:
|
||||
core_type sym(ARROW) fun_type { $1,$2,$3 }
|
||||
core_type arrow fun_type { $1,$2,$3 }
|
||||
|
||||
core_type:
|
||||
reg(path) {
|
||||
let {module_proj; value_proj} = $1.value in
|
||||
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}
|
||||
type_projection {
|
||||
TAlias $1
|
||||
}
|
||||
| reg(core_type type_constr {$1,$2}) {
|
||||
let arg, constr = $1.value in
|
||||
@ -194,6 +195,16 @@ core_type:
|
||||
let Region.{region; value={lpar; inside=prod; rpar}} = $1 in
|
||||
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_name { $1 }
|
||||
| kwd(Set) { Region.{value="set"; region=$1} }
|
||||
@ -204,15 +215,14 @@ type_tuple:
|
||||
par(tuple(type_expr)) { $1 }
|
||||
|
||||
sum_type:
|
||||
ioption(sym(VBAR)) nsepseq(reg(variant), sym(VBAR)) { $2 }
|
||||
ioption(vbar) nsepseq(reg(variant),vbar) { $2 }
|
||||
|
||||
variant:
|
||||
constr kwd(Of) cartesian { {constr=$1; args = Some ($2,$3)} }
|
||||
| constr { {constr=$1; args = None} }
|
||||
|
||||
record_type:
|
||||
sym(LBRACE) sep_or_term_list(reg(field_decl),sym(SEMI))
|
||||
sym(RBRACE) {
|
||||
lbrace sep_or_term_list(reg(field_decl),semi) rbrace {
|
||||
let elements, terminator = $2 in {
|
||||
opening = LBrace $1;
|
||||
elements = Some elements;
|
||||
@ -220,7 +230,7 @@ record_type:
|
||||
closing = RBrace $3} }
|
||||
|
||||
field_decl:
|
||||
field_name sym(COLON) type_expr {
|
||||
field_name colon type_expr {
|
||||
{field_name=$1; colon=$2; field_type=$3} }
|
||||
|
||||
(* Non-recursive definitions *)
|
||||
@ -229,15 +239,15 @@ let_bindings:
|
||||
nsepseq(let_binding, kwd(And)) { $1 }
|
||||
|
||||
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
|
||||
{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} }
|
||||
|
||||
type_annotation:
|
||||
sym(COLON) type_expr { $1,$2 }
|
||||
colon type_expr { $1,$2 }
|
||||
|
||||
(* Patterns *)
|
||||
|
||||
@ -247,7 +257,7 @@ irrefutable:
|
||||
|
||||
sub_irrefutable:
|
||||
ident { PVar $1 }
|
||||
| sym(WILD) { PWild $1 }
|
||||
| wild { PWild $1 }
|
||||
| unit { PUnit $1 }
|
||||
| reg(par(closed_irrefutable)) { PPar $1 }
|
||||
|
||||
@ -258,11 +268,10 @@ closed_irrefutable:
|
||||
| reg(typed_pattern) { PTyped $1 }
|
||||
|
||||
typed_pattern:
|
||||
irrefutable sym(COLON) type_expr {
|
||||
{pattern=$1; colon=$2; type_expr=$3} }
|
||||
irrefutable colon type_expr { {pattern=$1; colon=$2; type_expr=$3} }
|
||||
|
||||
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 }
|
||||
| core_pattern { $1 }
|
||||
|
||||
@ -272,7 +281,7 @@ sub_pattern:
|
||||
|
||||
core_pattern:
|
||||
ident { PVar $1 }
|
||||
| sym(WILD) { PWild $1 }
|
||||
| wild { PWild $1 }
|
||||
| unit { PUnit $1 }
|
||||
| reg(Int) { PInt $1 }
|
||||
| kwd(True) { PTrue $1 }
|
||||
@ -284,9 +293,7 @@ core_pattern:
|
||||
| reg(record_pattern) { PRecord $1 }
|
||||
|
||||
record_pattern:
|
||||
sym(LBRACE)
|
||||
sep_or_term_list(reg(field_pattern),sym(SEMI))
|
||||
sym(RBRACE) {
|
||||
lbrace sep_or_term_list(reg(field_pattern),semi) rbrace {
|
||||
let elements, terminator = $2 in
|
||||
{opening = LBrace $1;
|
||||
elements = Some elements;
|
||||
@ -294,7 +301,7 @@ record_pattern:
|
||||
closing = RBrace $3} }
|
||||
|
||||
field_pattern:
|
||||
field_name sym(EQ) sub_pattern {
|
||||
field_name eq sub_pattern {
|
||||
{field_name=$1; eq=$2; pattern=$3} }
|
||||
|
||||
constr_pattern:
|
||||
@ -305,17 +312,17 @@ ptuple:
|
||||
reg(tuple(tail)) { PTuple $1 }
|
||||
|
||||
unit:
|
||||
reg(sym(LPAR) sym(RPAR) {$1,$2}) { $1 }
|
||||
reg(lpar rpar {$1,$2}) { $1 }
|
||||
|
||||
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 }
|
||||
|
||||
(* Expressions *)
|
||||
|
||||
expr:
|
||||
base_cond__open(expr) { $1 }
|
||||
| match_expr(base_cond) { EMatch $1 }
|
||||
| reg(match_expr(base_cond)) { ECase $1 }
|
||||
|
||||
base_cond__open(x):
|
||||
base_expr(x)
|
||||
@ -331,57 +338,63 @@ base_expr(right_expr):
|
||||
| reg(tuple(disj_expr_level)) { ETuple $1 }
|
||||
|
||||
conditional(right_expr):
|
||||
if_then_else(right_expr)
|
||||
| if_then(right_expr) { ECond $1 }
|
||||
reg(if_then_else(right_expr))
|
||||
| reg(if_then(right_expr)) { ECond $1 }
|
||||
|
||||
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):
|
||||
reg(kwd(If) expr kwd(Then) closed_if kwd(Else) right_expr {
|
||||
$1,$2,$3,$4,$5,$6 }) { IfThenElse $1 }
|
||||
kwd(If) expr kwd(Then) closed_if kwd(Else) right_expr {
|
||||
{kwd_if=$1; test=$2; kwd_then=$3; ifso=$4;
|
||||
kwd_else=$5; ifnot = $6} }
|
||||
|
||||
base_if_then_else__open(x):
|
||||
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__open(base_if_then_else) { $1 }
|
||||
|
||||
closed_if:
|
||||
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):
|
||||
reg(kwd(Match) expr kwd(With)
|
||||
option(sym(VBAR)) cases(right_expr) {
|
||||
$1,$2,$3, ($4, Utils.nsepseq_rev $5) })
|
||||
| reg(match_nat(right_expr)) { $1 }
|
||||
|
||||
match_nat(right_expr):
|
||||
kwd(MatchNat) expr kwd(With)
|
||||
option(sym(VBAR)) cases(right_expr) {
|
||||
kwd(Match) expr kwd(With) vbar? reg(cases(right_expr)) {
|
||||
let cases = Utils.nsepseq_rev $5.value in
|
||||
{kwd_match = $1; expr = $2; opening = With $3;
|
||||
lead_vbar = $4; cases = {$5 with value=cases};
|
||||
closing = End Region.ghost}
|
||||
}
|
||||
| kwd(MatchNat) expr kwd(With) vbar? reg(cases(right_expr)) {
|
||||
let open Region in
|
||||
let cast_name = Name {region=ghost; value="assert_pos"} in
|
||||
let cast_path = {module_proj=None; value_proj=cast_name,[]} in
|
||||
let cast_fun = Path {region=ghost; value=cast_path} in
|
||||
let cast = ECall {region=ghost; value=cast_fun,$2}
|
||||
in $1, cast, $3, ($4, Utils.nsepseq_rev $5) }
|
||||
let cases = Utils.nsepseq_rev $5.value in
|
||||
let cast = EVar {region=ghost; value="assert_pos"} in
|
||||
let cast = ECall {region=ghost; value=cast,$2} in
|
||||
{kwd_match = $1; expr = cast; opening = With $3;
|
||||
lead_vbar = $4; cases = {$5 with value=cases};
|
||||
closing = End Region.ghost} }
|
||||
|
||||
cases(right_expr):
|
||||
case(right_expr) { $1, [] }
|
||||
| cases(base_cond) sym(VBAR) case(right_expr) {
|
||||
reg(case_clause(right_expr)) { $1, [] }
|
||||
| cases(base_cond) vbar reg(case_clause(right_expr)) {
|
||||
let h,t = $1 in $3, ($2,h)::t }
|
||||
|
||||
case(right_expr):
|
||||
pattern sym(ARROW) right_expr { $1,$2,$3 }
|
||||
case_clause(right_expr):
|
||||
pattern arrow right_expr { {pattern=$1; arrow=$2; rhs=$3} }
|
||||
|
||||
let_expr(right_expr):
|
||||
reg(kwd(Let) let_bindings kwd(In) right_expr {$1,$2,$3,$4}) {
|
||||
ELetIn $1 }
|
||||
|
||||
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
|
||||
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 }
|
||||
|
||||
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:
|
||||
bin_op(comp_expr_level, sym(NE), cat_expr_level) { $1 }
|
||||
@ -449,7 +462,7 @@ cons_expr_level:
|
||||
| add_expr_level { $1 }
|
||||
|
||||
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:
|
||||
reg(plus_expr) { EArith (Add $1) }
|
||||
@ -499,7 +512,8 @@ core_expr:
|
||||
reg(Int) { EArith (Int $1) }
|
||||
| reg(Mtz) { EArith (Mtz $1) }
|
||||
| reg(Nat) { EArith (Nat $1) }
|
||||
| reg(path) { Path $1 }
|
||||
| ident | reg(module_field) { EVar $1 }
|
||||
| reg(projection) { EProj $1 }
|
||||
| string { EString (String $1) }
|
||||
| unit { EUnit $1 }
|
||||
| kwd(False) { ELogic (BoolExpr (False $1)) }
|
||||
@ -510,26 +524,27 @@ core_expr:
|
||||
| reg(sequence) { ESeq $1 }
|
||||
| reg(record_expr) { ERecord $1 }
|
||||
|
||||
path:
|
||||
reg(struct_name) sym(DOT) nsepseq(selection,sym(DOT)) {
|
||||
let head, tail = $3 in
|
||||
let seq = Name $1, ($2,head)::tail
|
||||
in {module_proj=None; value_proj=seq}
|
||||
module_field:
|
||||
module_name dot field_name { $1.value ^ "." ^ $3.value }
|
||||
|
||||
projection:
|
||||
reg(struct_name) dot nsepseq(selection,dot) {
|
||||
{struct_name = $1; selector = $2; field_path = $3}
|
||||
}
|
||||
| module_name sym(DOT) nsepseq(selection,sym(DOT)) {
|
||||
{module_proj = Some ($1,$2); value_proj=$3}
|
||||
}
|
||||
| ident {
|
||||
{module_proj = None; value_proj = Name $1, []} }
|
||||
| reg(module_name dot field_name {$1,$3})
|
||||
dot nsepseq(selection,dot) {
|
||||
let open Region in
|
||||
let module_name, field_name = $1.value in
|
||||
let value = module_name.value ^ "." ^ field_name.value in
|
||||
let struct_name = {$1 with value} in
|
||||
{struct_name; selector = $2; field_path = $3} }
|
||||
|
||||
selection:
|
||||
ident { Name $1 }
|
||||
field_name { FieldName $1 }
|
||||
| reg(par(reg(Int))) { Component $1 }
|
||||
|
||||
record_expr:
|
||||
sym(LBRACE)
|
||||
sep_or_term_list(reg(field_assignment),sym(SEMI))
|
||||
sym(RBRACE) {
|
||||
lbrace sep_or_term_list(reg(field_assignment),semi) rbrace {
|
||||
let elements, terminator = $2 in
|
||||
{opening = LBrace $1;
|
||||
elements = Some elements;
|
||||
@ -537,11 +552,11 @@ record_expr:
|
||||
closing = RBrace $3} }
|
||||
|
||||
field_assignment:
|
||||
field_name sym(EQ) expr {
|
||||
field_name eq expr {
|
||||
{field_name=$1; assignment=$2; field_expr=$3} }
|
||||
|
||||
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
|
||||
{opening = Begin $1;
|
||||
elements = Some elements;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user