I extended the grammar with optional semicolons and vertical bars.

This commit is contained in:
Christian Rinderknecht 2019-03-07 17:06:02 +01:00
parent ec6cefb1ff
commit 09f790680f
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
7 changed files with 363 additions and 238 deletions

205
AST.ml
View File

@ -89,7 +89,7 @@ type rbracket = Region.t
type cons = Region.t type cons = Region.t
type vbar = Region.t type vbar = Region.t
type arrow = Region.t type arrow = Region.t
type asgnmnt = Region.t type ass = Region.t
type equal = Region.t type equal = Region.t
type colon = Region.t type colon = Region.t
type bool_or = Region.t type bool_or = Region.t
@ -143,11 +143,11 @@ type 'a braces = (lbrace * 'a * rbrace) reg
(* The Abstract Syntax Tree *) (* The Abstract Syntax Tree *)
type t = { type t = {
types : type_decl list; types : type_decl reg list;
constants : const_decl reg list; constants : const_decl reg list;
parameter : parameter_decl; parameter : parameter_decl reg;
storage : storage_decl; storage : storage_decl reg;
operations : operations_decl; operations : operations_decl reg;
lambdas : lambda_decl list; lambdas : lambda_decl list;
block : block reg; block : block reg;
eof : eof eof : eof
@ -155,15 +155,35 @@ type t = {
and ast = t and ast = t
and parameter_decl = (kwd_parameter * variable * colon * type_expr) reg and parameter_decl = {
kwd_parameter : kwd_parameter;
name : variable;
colon : colon;
param_type : type_expr;
terminator : semi option
}
and storage_decl = (kwd_storage * type_expr) reg and storage_decl = {
kwd_storage : kwd_storage;
store_type : type_expr;
terminator : semi option
}
and operations_decl = (kwd_operations * type_expr) reg and operations_decl = {
kwd_operations : kwd_operations;
op_type : type_expr;
terminator : semi option
}
(* Type declarations *) (* Type declarations *)
and type_decl = (kwd_type * type_name * kwd_is * type_expr) reg and type_decl = {
kwd_type : kwd_type;
name : type_name;
kwd_is : kwd_is;
type_expr : type_expr;
terminator : semi option
}
and type_expr = and type_expr =
Prod of cartesian Prod of cartesian
@ -201,7 +221,8 @@ and fun_decl = {
local_decls : local_decl list; local_decls : local_decl list;
block : block reg; block : block reg;
kwd_with : kwd_with; kwd_with : kwd_with;
return : expr return : expr;
terminator : semi option
} }
and proc_decl = { and proc_decl = {
@ -210,23 +231,25 @@ and proc_decl = {
param : parameters; param : parameters;
kwd_is : kwd_is; kwd_is : kwd_is;
local_decls : local_decl list; local_decls : local_decl list;
block : block reg block : block reg;
terminator : semi option
} }
and parameters = (param_decl, semi) nsepseq par and parameters = (param_decl, semi) nsepseq par
and param_const = (kwd_const * variable * colon * type_expr) reg
and param_var = (kwd_var * variable * colon * type_expr) reg
and param_decl = and param_decl =
ParamConst of param_const ParamConst of param_const
| ParamVar of param_var | ParamVar of param_var
and param_const = (kwd_const * variable * colon * type_expr) reg
and param_var = (kwd_var * variable * colon * type_expr) reg
and block = { and block = {
opening : kwd_begin; opening : kwd_begin;
instr : instructions; instr : instructions;
close : kwd_end terminator : semi option;
close : kwd_end
} }
and local_decl = and local_decl =
@ -235,20 +258,23 @@ and local_decl =
| LocalVar of var_decl reg | LocalVar of var_decl reg
and const_decl = { and const_decl = {
kwd_const : kwd_const; kwd_const : kwd_const;
name : variable; name : variable;
colon : colon; colon : colon;
vtype : type_expr; vtype : type_expr;
equal : equal; equal : equal;
init : expr init : expr;
terminator : semi option
} }
and var_decl = { and var_decl = {
kwd_var : kwd_var; kwd_var : kwd_var;
name : variable; name : variable;
colon : colon; colon : colon;
vtype : type_expr; vtype : type_expr;
asgnmnt : asgnmnt; ass : ass;
init : expr init : expr;
terminator : semi option
} }
and instructions = (instruction, semi) nsepseq reg and instructions = (instruction, semi) nsepseq reg
@ -260,7 +286,7 @@ and instruction =
and single_instr = and single_instr =
Cond of conditional reg Cond of conditional reg
| Match of match_instr reg | Match of match_instr reg
| Asgnmnt of asgnmnt_instr | Ass of ass_instr
| Loop of loop | Loop of loop
| ProcCall of fun_call | ProcCall of fun_call
| Null of kwd_null | Null of kwd_null
@ -279,6 +305,7 @@ and match_instr = {
kwd_match : kwd_match; kwd_match : kwd_match;
expr : expr; expr : expr;
kwd_with : kwd_with; kwd_with : kwd_with;
lead_vbar : vbar option;
cases : cases; cases : cases;
kwd_end : kwd_end kwd_end : kwd_end
} }
@ -287,7 +314,7 @@ and cases = (case, vbar) nsepseq reg
and case = (pattern * arrow * instruction) reg and case = (pattern * arrow * instruction) reg
and asgnmnt_instr = (variable * asgnmnt * expr) reg and ass_instr = (variable * ass * expr) reg
and loop = and loop =
While of while_loop While of while_loop
@ -301,7 +328,7 @@ and for_loop =
and for_int = { and for_int = {
kwd_for : kwd_for; kwd_for : kwd_for;
asgnmnt : asgnmnt_instr; ass : ass_instr;
down : kwd_down option; down : kwd_down option;
kwd_to : kwd_to; kwd_to : kwd_to;
bound : expr; bound : expr;
@ -454,7 +481,7 @@ let expr_to_region = function
let instr_to_region = function let instr_to_region = function
Single Cond {region;_} Single Cond {region;_}
| Single Match {region; _} | Single Match {region; _}
| Single Asgnmnt {region; _} | Single Ass {region; _}
| Single Loop While {region; _} | Single Loop While {region; _}
| Single Loop For ForInt {region; _} | Single Loop For ForInt {region; _}
| Single Loop For ForCollect {region; _} | Single Loop For ForCollect {region; _}
@ -487,7 +514,7 @@ let local_decl_to_region = function
(* Printing the tokens with their source regions *) (* Printing the tokens with their source regions *)
type visitor = { type visitor = {
asgnmnt_instr : asgnmnt_instr -> unit; ass_instr : ass_instr -> unit;
bind_to : (region * variable) option -> unit; bind_to : (region * variable) option -> unit;
block : block reg -> unit; block : block reg -> unit;
bytes : (string * MBytes.t) reg -> unit; bytes : (string * MBytes.t) reg -> unit;
@ -522,11 +549,11 @@ type visitor = {
match_instr : match_instr -> unit; match_instr : match_instr -> unit;
none_expr : none_expr -> unit; none_expr : none_expr -> unit;
nsepseq : 'a.string -> ('a -> unit) -> ('a, region) nsepseq -> unit; nsepseq : 'a.string -> ('a -> unit) -> ('a, region) nsepseq -> unit;
operations_decl : (region * type_expr) reg -> unit; operations_decl : operations_decl reg -> unit;
par_expr : expr par -> unit; par_expr : expr par -> unit;
par_type : type_expr par -> unit; par_type : type_expr par -> unit;
param_decl : param_decl -> unit; param_decl : param_decl -> unit;
parameter_decl : (region * variable * region * type_expr) reg -> unit; parameter_decl : parameter_decl reg -> unit;
parameters : parameters -> unit; parameters : parameters -> unit;
param_const : param_const -> unit; param_const : param_const -> unit;
param_var : param_var -> unit; param_var : param_var -> unit;
@ -542,14 +569,15 @@ type visitor = {
single_instr : single_instr -> unit; single_instr : single_instr -> unit;
some_app : (region * arguments) reg -> unit; some_app : (region * arguments) reg -> unit;
step : (region * expr) option -> unit; step : (region * expr) option -> unit;
storage_decl : (region * type_expr) reg -> unit; storage_decl : storage_decl reg -> unit;
string : string reg -> unit; string : string reg -> unit;
sugar : (core_pattern, region) sepseq brackets -> unit; sugar : (core_pattern, region) sepseq brackets -> unit;
sum_type : (variant, region) nsepseq reg -> unit; sum_type : (variant, region) nsepseq reg -> unit;
terminator : semi option -> unit;
token : region -> string -> unit; token : region -> string -> unit;
tuple : arguments -> unit; tuple : arguments -> unit;
type_app : (type_name * type_tuple) reg -> unit; type_app : (type_name * type_tuple) reg -> unit;
type_decl : (region * variable * region * type_expr) reg -> unit; type_decl : type_decl reg -> unit;
type_expr : type_expr -> unit; type_expr : type_expr -> unit;
type_tuple : type_tuple -> unit; type_tuple : type_tuple -> unit;
local_decl : local_decl -> unit; local_decl : local_decl -> unit;
@ -603,7 +631,8 @@ and print_int _visitor {region; value = lexeme, abstract} =
(compact region) lexeme (compact region) lexeme
(Z.to_string abstract) (Z.to_string abstract)
(* main print function *) (* Main printing function *)
and print_tokens (v: visitor) ast = and print_tokens (v: visitor) ast =
List.iter v.type_decl ast.types; List.iter v.type_decl ast.types;
v.parameter_decl ast.parameter; v.parameter_decl ast.parameter;
@ -614,28 +643,28 @@ and print_tokens (v: visitor) ast =
v.token ast.eof "EOF" v.token ast.eof "EOF"
and print_parameter_decl (v: visitor) {value=node; _} = and print_parameter_decl (v: visitor) {value=node; _} =
let kwd_parameter, variable, colon, type_expr = node in v.token node.kwd_parameter "parameter";
v.token kwd_parameter "parameter"; v.var node.name;
v.var variable; v.token node.colon ":";
v.token colon ":"; v.type_expr node.param_type;
v.type_expr type_expr v.terminator node.terminator
and print_storage_decl (v: visitor) {value=node; _} = and print_storage_decl (v: visitor) {value=node; _} =
let kwd_storage, type_expr = node in v.token node.kwd_storage "storage";
v.token kwd_storage "storage"; v.type_expr node.store_type;
v.type_expr type_expr v.terminator node.terminator
and print_operations_decl (v: visitor) {value=node; _} = and print_operations_decl (v: visitor) {value=node; _} =
let kwd_operations, type_expr = node in v.token node.kwd_operations "operations";
v.token kwd_operations "operations"; v.type_expr node.op_type;
v.type_expr type_expr v.terminator node.terminator
and print_type_decl (v: visitor) {value=node; _} = and print_type_decl (v: visitor) {value=node; _} =
let kwd_type, type_name, kwd_is, type_expr = node in v.token node.kwd_type "type";
v.token kwd_type "type"; v.var node.name;
v.var type_name; v.token node.kwd_is "is";
v.token kwd_is "is"; v.type_expr node.type_expr;
v.type_expr type_expr v.terminator node.terminator
and print_type_expr (v: visitor) = function and print_type_expr (v: visitor) = function
Prod cartesian -> v.cartesian cartesian Prod cartesian -> v.cartesian cartesian
@ -703,7 +732,8 @@ and print_fun_decl (v: visitor) {value=node; _} =
v.local_decls node.local_decls; v.local_decls node.local_decls;
v.block node.block; v.block node.block;
v.token node.kwd_with "with"; v.token node.kwd_with "with";
v.expr node.return v.expr node.return;
v.terminator node.terminator
and print_proc_decl (v: visitor) {value=node; _} = and print_proc_decl (v: visitor) {value=node; _} =
v.token node.kwd_procedure "procedure"; v.token node.kwd_procedure "procedure";
@ -711,7 +741,8 @@ and print_proc_decl (v: visitor) {value=node; _} =
v.parameters node.param; v.parameters node.param;
v.token node.kwd_is "is"; v.token node.kwd_is "is";
v.local_decls node.local_decls; v.local_decls node.local_decls;
v.block node.block v.block node.block;
v.terminator node.terminator
and print_parameters (v: visitor) {value=node; _} = and print_parameters (v: visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
@ -740,6 +771,7 @@ and print_param_var (v: visitor) {value=node; _} =
and print_block (v: visitor) {value=node; _} = and print_block (v: visitor) {value=node; _} =
v.token node.opening "begin"; v.token node.opening "begin";
v.instructions node.instr; v.instructions node.instr;
v.terminator node.terminator;
v.token node.close "end" v.token node.close "end"
and print_local_decls (v: visitor) sequence = and print_local_decls (v: visitor) sequence =
@ -751,20 +783,22 @@ and print_local_decl (v: visitor) = function
| LocalVar decl -> v.var_decl decl | LocalVar decl -> v.var_decl decl
and print_const_decl (v: visitor) {value=node; _} = and print_const_decl (v: visitor) {value=node; _} =
v.token node.kwd_const "const"; v.token node.kwd_const "const";
v.var node.name; v.var node.name;
v.token node.colon ":"; v.token node.colon ":";
v.type_expr node.vtype; v.type_expr node.vtype;
v.token node.equal "="; v.token node.equal "=";
v.expr node.init v.expr node.init;
v.terminator node.terminator
and print_var_decl (v: visitor) {value=node; _} = and print_var_decl (v: visitor) {value=node; _} =
v.token node.kwd_var "var"; v.token node.kwd_var "var";
v.var node.name; v.var node.name;
v.token node.colon ":"; v.token node.colon ":";
v.type_expr node.vtype; v.type_expr node.vtype;
v.token node.asgnmnt ":="; v.token node.ass ":=";
v.expr node.init v.expr node.init;
v.terminator node.terminator
and print_instructions (v: visitor) {value=sequence; _} = and print_instructions (v: visitor) {value=sequence; _} =
v.nsepseq ";" v.instruction sequence v.nsepseq ";" v.instruction sequence
@ -776,7 +810,7 @@ and print_instruction (v: visitor) = function
and print_single_instr (v: visitor) = function and print_single_instr (v: visitor) = function
Cond {value; _} -> v.conditional value Cond {value; _} -> v.conditional value
| Match {value; _} -> v.match_instr value | Match {value; _} -> v.match_instr value
| Asgnmnt instr -> v.asgnmnt_instr instr | Ass instr -> v.ass_instr instr
| Loop loop -> v.loop loop | Loop loop -> v.loop loop
| ProcCall fun_call -> v.fun_call fun_call | ProcCall fun_call -> v.fun_call fun_call
| Null kwd_null -> v.token kwd_null "null" | Null kwd_null -> v.token kwd_null "null"
@ -810,10 +844,10 @@ and print_case (v: visitor) {value=node; _} =
v.token arrow "->"; v.token arrow "->";
v.instruction instruction v.instruction instruction
and print_asgnmnt_instr (v: visitor) {value=node; _} = and print_ass_instr (v: visitor) {value=node; _} =
let variable, asgnmnt, expr = node in let variable, ass, expr = node in
v.var variable; v.var variable;
v.token asgnmnt ":="; v.token ass ":=";
v.expr expr v.expr expr
and print_loop (v: visitor) = function and print_loop (v: visitor) = function
@ -831,13 +865,13 @@ and print_for_loop (v: visitor) = function
| ForCollect for_collect -> v.for_collect for_collect | ForCollect for_collect -> v.for_collect for_collect
and print_for_int (v: visitor) ({value=node; _} : for_int reg) = and print_for_int (v: visitor) ({value=node; _} : for_int reg) =
v.token node.kwd_for "for"; v.token node.kwd_for "for";
v.asgnmnt_instr node.asgnmnt; v.ass_instr node.ass;
v.down node.down; v.down node.down;
v.token node.kwd_to "to"; v.token node.kwd_to "to";
v.expr node.bound; v.expr node.bound;
v.step node.step; v.step node.step;
v.block node.block v.block node.block
and print_down (v: visitor) = function and print_down (v: visitor) = function
Some kwd_down -> v.token kwd_down "down" Some kwd_down -> v.token kwd_down "down"
@ -1042,6 +1076,10 @@ and print_ptuple (v: visitor) {value=node; _} =
v.nsepseq "," v.core_pattern sequence; v.nsepseq "," v.core_pattern sequence;
v.token rpar ")" v.token rpar ")"
and print_terminator (v: visitor) = function
Some semi -> v.token semi ";"
| None -> ()
let rec visitor () : visitor = { let rec visitor () : visitor = {
nsepseq = print_nsepseq; nsepseq = print_nsepseq;
sepseq = print_sepseq; sepseq = print_sepseq;
@ -1086,7 +1124,7 @@ let rec visitor () : visitor = {
match_instr = print_match_instr (visitor ()); match_instr = print_match_instr (visitor ());
cases = print_cases (visitor ()); cases = print_cases (visitor ());
case = print_case (visitor ()); case = print_case (visitor ());
asgnmnt_instr = print_asgnmnt_instr (visitor ()); ass_instr = print_ass_instr (visitor ());
loop = print_loop (visitor ()); loop = print_loop (visitor ());
while_loop = print_while_loop (visitor ()); while_loop = print_while_loop (visitor ());
for_loop = print_for_loop (visitor ()); for_loop = print_for_loop (visitor ());
@ -1114,7 +1152,8 @@ let rec visitor () : visitor = {
list_pattern = print_list_pattern (visitor ()); list_pattern = print_list_pattern (visitor ());
sugar = print_sugar (visitor ()); sugar = print_sugar (visitor ());
raw = print_raw (visitor ()); raw = print_raw (visitor ());
ptuple = print_ptuple (visitor ()) ptuple = print_ptuple (visitor ());
terminator = print_terminator (visitor ())
} }
let print_tokens = print_tokens (visitor ()) let print_tokens = print_tokens (visitor ())

92
AST.mli
View File

@ -73,7 +73,7 @@ type rbracket = Region.t
type cons = Region.t type cons = Region.t
type vbar = Region.t type vbar = Region.t
type arrow = Region.t type arrow = Region.t
type asgnmnt = Region.t type ass = Region.t
type equal = Region.t type equal = Region.t
type colon = Region.t type colon = Region.t
type bool_or = Region.t type bool_or = Region.t
@ -127,11 +127,11 @@ type 'a braces = (lbrace * 'a * rbrace) reg
(* The Abstract Syntax Tree *) (* The Abstract Syntax Tree *)
type t = { type t = {
types : type_decl list; types : type_decl reg list;
constants : const_decl reg list; constants : const_decl reg list;
parameter : parameter_decl; parameter : parameter_decl reg;
storage : storage_decl; storage : storage_decl reg;
operations : operations_decl; operations : operations_decl reg;
lambdas : lambda_decl list; lambdas : lambda_decl list;
block : block reg; block : block reg;
eof : eof eof : eof
@ -139,15 +139,35 @@ type t = {
and ast = t and ast = t
and parameter_decl = (kwd_parameter * variable * colon * type_expr) reg and parameter_decl = {
kwd_parameter : kwd_parameter;
name : variable;
colon : colon;
param_type : type_expr;
terminator : semi option
}
and storage_decl = (kwd_storage * type_expr) reg and storage_decl = {
kwd_storage : kwd_storage;
store_type : type_expr;
terminator : semi option
}
and operations_decl = (kwd_operations * type_expr) reg and operations_decl = {
kwd_operations : kwd_operations;
op_type : type_expr;
terminator : semi option
}
(* Type declarations *) (* Type declarations *)
and type_decl = (kwd_type * type_name * kwd_is * type_expr) reg and type_decl = {
kwd_type : kwd_type;
name : type_name;
kwd_is : kwd_is;
type_expr : type_expr;
terminator : semi option
}
and type_expr = and type_expr =
Prod of cartesian Prod of cartesian
@ -185,7 +205,8 @@ and fun_decl = {
local_decls : local_decl list; local_decls : local_decl list;
block : block reg; block : block reg;
kwd_with : kwd_with; kwd_with : kwd_with;
return : expr return : expr;
terminator : semi option
} }
and proc_decl = { and proc_decl = {
@ -194,19 +215,25 @@ and proc_decl = {
param : parameters; param : parameters;
kwd_is : kwd_is; kwd_is : kwd_is;
local_decls : local_decl list; local_decls : local_decl list;
block : block reg block : block reg;
terminator : semi option
} }
and parameters = (param_decl, semi) nsepseq par and parameters = (param_decl, semi) nsepseq par
and param_decl = and param_decl =
ParamConst of (kwd_const * variable * colon * type_expr) reg ParamConst of param_const
| ParamVar of (kwd_var * variable * colon * type_expr) reg | ParamVar of param_var
and param_const = (kwd_const * variable * colon * type_expr) reg
and param_var = (kwd_var * variable * colon * type_expr) reg
and block = { and block = {
opening : kwd_begin; opening : kwd_begin;
instr : instructions; instr : instructions;
close : kwd_end terminator : semi option;
close : kwd_end
} }
and local_decl = and local_decl =
@ -215,21 +242,23 @@ and local_decl =
| LocalVar of var_decl reg | LocalVar of var_decl reg
and const_decl = { and const_decl = {
kwd_const : kwd_const; kwd_const : kwd_const;
name : variable; name : variable;
colon : colon; colon : colon;
vtype : type_expr; vtype : type_expr;
equal : equal; equal : equal;
init : expr init : expr;
terminator : semi option
} }
and var_decl = { and var_decl = {
kwd_var : kwd_var; kwd_var : kwd_var;
name : variable; name : variable;
colon : colon; colon : colon;
vtype : type_expr; vtype : type_expr;
asgnmnt : asgnmnt; ass : ass;
init : expr init : expr;
terminator : semi option
} }
and instructions = (instruction, semi) nsepseq reg and instructions = (instruction, semi) nsepseq reg
@ -241,7 +270,7 @@ and instruction =
and single_instr = and single_instr =
Cond of conditional reg Cond of conditional reg
| Match of match_instr reg | Match of match_instr reg
| Asgnmnt of asgnmnt_instr | Ass of ass_instr
| Loop of loop | Loop of loop
| ProcCall of fun_call | ProcCall of fun_call
| Null of kwd_null | Null of kwd_null
@ -260,6 +289,7 @@ and match_instr = {
kwd_match : kwd_match; kwd_match : kwd_match;
expr : expr; expr : expr;
kwd_with : kwd_with; kwd_with : kwd_with;
lead_vbar : vbar option;
cases : cases; cases : cases;
kwd_end : kwd_end kwd_end : kwd_end
} }
@ -268,7 +298,7 @@ and cases = (case, vbar) nsepseq reg
and case = (pattern * arrow * instruction) reg and case = (pattern * arrow * instruction) reg
and asgnmnt_instr = (variable * asgnmnt * expr) reg and ass_instr = (variable * ass * expr) reg
and loop = and loop =
While of while_loop While of while_loop
@ -282,7 +312,7 @@ and for_loop =
and for_int = { and for_int = {
kwd_for : kwd_for; kwd_for : kwd_for;
asgnmnt : asgnmnt_instr; ass : ass_instr;
down : kwd_down option; down : kwd_down option;
kwd_to : kwd_to; kwd_to : kwd_to;
bound : expr; bound : expr;

View File

@ -47,7 +47,7 @@ type t =
| CONS of Region.t (* "<:" *) | CONS of Region.t (* "<:" *)
| VBAR of Region.t (* "|" *) | VBAR of Region.t (* "|" *)
| ARROW of Region.t (* "->" *) | ARROW of Region.t (* "->" *)
| ASGNMNT of Region.t (* ":=" *) | ASS of Region.t (* ":=" *)
| EQUAL of Region.t (* "=" *) | EQUAL of Region.t (* "=" *)
| COLON of Region.t (* ":" *) | COLON of Region.t (* ":" *)
| OR of Region.t (* "||" *) | OR of Region.t (* "||" *)

View File

@ -46,7 +46,7 @@ type t =
| CONS of Region.t | CONS of Region.t
| VBAR of Region.t | VBAR of Region.t
| ARROW of Region.t | ARROW of Region.t
| ASGNMNT of Region.t | ASS of Region.t
| EQUAL of Region.t | EQUAL of Region.t
| COLON of Region.t | COLON of Region.t
| OR of Region.t | OR of Region.t
@ -165,7 +165,7 @@ let proj_token = function
| CONS region -> region, "CONS" | CONS region -> region, "CONS"
| VBAR region -> region, "VBAR" | VBAR region -> region, "VBAR"
| ARROW region -> region, "ARROW" | ARROW region -> region, "ARROW"
| ASGNMNT region -> region, "ASGNMNT" | ASS region -> region, "ASS"
| EQUAL region -> region, "EQUAL" | EQUAL region -> region, "EQUAL"
| COLON region -> region, "COLON" | COLON region -> region, "COLON"
| OR region -> region, "OR" | OR region -> region, "OR"
@ -249,7 +249,7 @@ let to_lexeme = function
| CONS _ -> "<:" | CONS _ -> "<:"
| VBAR _ -> "|" | VBAR _ -> "|"
| ARROW _ -> "->" | ARROW _ -> "->"
| ASGNMNT _ -> ":=" | ASS _ -> ":="
| EQUAL _ -> "=" | EQUAL _ -> "="
| COLON _ -> ":" | COLON _ -> ":"
| OR _ -> "||" | OR _ -> "||"
@ -493,7 +493,7 @@ let mk_sym lexeme region =
| "<:" -> CONS region | "<:" -> CONS region
| "|" -> VBAR region | "|" -> VBAR region
| "->" -> ARROW region | "->" -> ARROW region
| ":=" -> ASGNMNT region | ":=" -> ASS region
| "=" -> EQUAL region | "=" -> EQUAL region
| ":" -> COLON region | ":" -> COLON region
| "||" -> OR region | "||" -> OR region
@ -596,7 +596,7 @@ let is_sym = function
| CONS _ | CONS _
| VBAR _ | VBAR _
| ARROW _ | ARROW _
| ASGNMNT _ | ASS _
| EQUAL _ | EQUAL _
| COLON _ | COLON _
| OR _ | OR _

View File

@ -24,7 +24,7 @@
%token <Region.t> CONS (* "<:" *) %token <Region.t> CONS (* "<:" *)
%token <Region.t> VBAR (* "|" *) %token <Region.t> VBAR (* "|" *)
%token <Region.t> ARROW (* "->" *) %token <Region.t> ARROW (* "->" *)
%token <Region.t> ASGNMNT (* ":=" *) %token <Region.t> ASS (* ":=" *)
%token <Region.t> EQUAL (* "=" *) %token <Region.t> EQUAL (* "=" *)
%token <Region.t> COLON (* ":" *) %token <Region.t> COLON (* ":" *)
%token <Region.t> OR (* "||" *) %token <Region.t> OR (* "||" *)

View File

@ -98,45 +98,77 @@ program:
block block
EOF { EOF {
{ {
types = $1; types = $1;
constants = $2; constants = $2;
parameter = $3; parameter = $3;
storage = $4; storage = $4;
operations = $5; operations = $5;
lambdas = $6; lambdas = $6;
block = $7; block = $7;
eof = $8; eof = $8;
} }
} }
parameter_decl: parameter_decl:
Parameter var COLON type_expr { Parameter var COLON type_expr option(SEMI) {
let stop = type_expr_to_region $4 let stop =
in {region = cover $1 stop; match $5 with
value = $1,$2,$3,$4} None -> type_expr_to_region $4
| Some region -> region in
let region = cover $1 stop in
let value = {
kwd_parameter = $1;
name = $2;
colon = $3;
param_type = $4;
terminator = $5}
in {region; value}
} }
storage_decl: storage_decl:
Storage type_expr { Storage type_expr option(SEMI) {
let stop = type_expr_to_region $2 let stop =
in {region = cover $1 stop; match $3 with
value = $1,$2} None -> type_expr_to_region $2
| Some region -> region in
let region = cover $1 stop in
let value = {
kwd_storage = $1;
store_type = $2;
terminator = $3}
in {region; value}
} }
operations_decl: operations_decl:
Operations type_expr { Operations type_expr option(SEMI) {
let stop = type_expr_to_region $2 let stop =
in {region = cover $1 stop; match $3 with
value = $1,$2} None -> type_expr_to_region $2
| Some region -> region in
let region = cover $1 stop in
let value = {
kwd_operations = $1;
op_type = $2;
terminator = $3}
in {region; value}
} }
(* Type declarations *) (* Type declarations *)
type_decl: type_decl:
Type type_name Is type_expr { Type type_name Is type_expr option(SEMI) {
{region = cover $1 (type_expr_to_region $4); let stop =
value = $1,$2,$3,$4} match $5 with
} None -> type_expr_to_region $4
| Some region -> region in
let region = cover $1 stop in
let value = {
kwd_type = $1;
name = $2;
kwd_is = $3;
type_expr = $4;
terminator = $5}
in {region; value}}
type_expr: type_expr:
cartesian { Prod $1 } cartesian { Prod $1 }
@ -202,40 +234,46 @@ fun_decl:
Function fun_name parameters COLON type_expr Is Function fun_name parameters COLON type_expr Is
seq(local_decl) seq(local_decl)
block block
With expr { With expr option(SEMI) {
let region = cover $1 (expr_to_region $10) in let stop =
let value = match $11 with
{ None -> expr_to_region $10
kwd_function = $1; | Some region -> region in
name = $2; let region = cover $1 stop in
param = $3; let value = {
colon = $4; kwd_function = $1;
ret_type = $5; name = $2;
kwd_is = $6; param = $3;
local_decls = $7; colon = $4;
block = $8; ret_type = $5;
kwd_with = $9; kwd_is = $6;
return = $10; local_decls = $7;
} block = $8;
kwd_with = $9;
return = $10;
terminator = $11}
in {region; value} in {region; value}
} }
proc_decl: proc_decl:
Procedure fun_name parameters Is Procedure fun_name parameters Is
seq(local_decl) seq(local_decl)
block block option(SEMI)
{ {
let region = cover $1 $6.region in let stop =
let value = match $7 with
{ None -> $6.region
kwd_procedure = $1; | Some region -> region in
name = $2; let region = cover $1 stop in
param = $3; let value = {
kwd_is = $4; kwd_procedure = $1;
local_decls = $5; name = $2;
block = $6; param = $3;
} kwd_is = $4;
in {region; value} local_decls = $5;
block = $6;
terminator = $7}
in {region; value}
} }
parameters: parameters:
@ -255,58 +293,81 @@ param_decl:
block: block:
Begin Begin
instructions instruction after_instr
End
{ {
let region = cover $1 $3 in let instrs, terminator, close = $3 in
let value = let region = cover $1 close in
{ let value = {
opening = $1; opening = $1;
instr = $2; instr = (let value = $2, instrs in
close = $3; let region = nsepseq_to_region instr_to_region value
} in {value; region});
terminator;
close}
in {region; value} in {region; value}
} }
after_instr:
SEMI instr_or_end {
match $2 with
`Some (instr, instrs, term, close) ->
($1, instr)::instrs, term, close
| `End close ->
[], Some $1, close
}
| End {
[], None, $1
}
instr_or_end:
End {
`End $1 }
| instruction after_instr {
let instrs, term, close = $2 in
`Some ($1, instrs, term, close)
}
local_decl: local_decl:
lambda_decl { LocalLam $1 } lambda_decl { LocalLam $1 }
| const_decl { LocalConst $1 } | const_decl { LocalConst $1 }
| var_decl { LocalVar $1 } | var_decl { LocalVar $1 }
const_decl: const_decl:
Const var COLON type_expr EQUAL expr { Const var COLON type_expr EQUAL expr option(SEMI) {
let region = cover $1 (expr_to_region $6) in let stop =
match $7 with
None -> expr_to_region $6
| Some region -> region in
let region = cover $1 stop in
let value = { let value = {
kwd_const = $1; kwd_const = $1;
name = $2; name = $2;
colon = $3; colon = $3;
vtype = $4; vtype = $4;
equal = $5; equal = $5;
init = $6; init = $6;
} terminator = $7}
in {region; value} in {region; value}
} }
var_decl: var_decl:
Var var COLON type_expr ASGNMNT expr { Var var COLON type_expr ASS expr option(SEMI) {
let region = cover $1 (expr_to_region $6) in let stop =
match $7 with
None -> expr_to_region $6
| Some region -> region in
let region = cover $1 stop in
let value = { let value = {
kwd_var = $1; kwd_var = $1;
name = $2; name = $2;
colon = $3; colon = $3;
vtype = $4; vtype = $4;
asgnmnt = $5; ass = $5;
init = $6; init = $6;
} terminator = $7}
in {region; value} in {region; value}
} }
instructions:
nsepseq(instruction,SEMI) {
let region = nsepseq_to_region instr_to_region $1
in {region; value=$1}
}
instruction: instruction:
single_instr { Single $1 } single_instr { Single $1 }
| block { Block $1 } | block { Block $1 }
@ -314,14 +375,12 @@ instruction:
single_instr: single_instr:
conditional { Cond $1 } conditional { Cond $1 }
| match_instr { Match $1 } | match_instr { Match $1 }
| asgnmnt { Asgnmnt $1 } | ass { Ass $1 }
| loop { Loop $1 } | loop { Loop $1 }
| proc_call { ProcCall $1 } | proc_call { ProcCall $1 }
| Null { Null $1 } | Null { Null $1 }
| Fail expr { | Fail expr { let region = cover $1 (expr_to_region $2)
let region = cover $1 (expr_to_region $2) in Fail {region; value = $1,$2} }
in Fail {region; value = $1,$2}
}
proc_call: proc_call:
fun_call { $1 } fun_call { $1 }
@ -329,29 +388,26 @@ proc_call:
conditional: conditional:
If expr Then instruction Else instruction { If expr Then instruction Else instruction {
let region = cover $1 (instr_to_region $6) in let region = cover $1 (instr_to_region $6) in
let value = let value = {
{ kwd_if = $1;
kwd_if = $1; test = $2;
test = $2; kwd_then = $3;
kwd_then = $3; ifso = $4;
ifso = $4; kwd_else = $5;
kwd_else = $5; ifnot = $6}
ifnot = $6;
}
in {region; value} in {region; value}
} }
match_instr: match_instr:
Match expr With cases End { Match expr With option(VBAR) cases End {
let region = cover $1 $5 in let region = cover $1 $6 in
let value = let value = {
{ kwd_match = $1;
kwd_match = $1; expr = $2;
expr = $2; kwd_with = $3;
kwd_with = $3; lead_vbar = $4;
cases = $4; cases = $5;
kwd_end = $5; kwd_end = $6}
}
in {region; value} in {region; value}
} }
@ -367,8 +423,8 @@ case:
in {region; value = $1,$2,$3} in {region; value = $1,$2,$3}
} }
asgnmnt: ass:
var ASGNMNT expr { var ASS expr {
let region = cover $1.region (expr_to_region $3) let region = cover $1.region (expr_to_region $3)
in {region; value = $1,$2,$3} in {region; value = $1,$2,$3}
} }
@ -384,12 +440,12 @@ while_loop:
} }
for_loop: for_loop:
For asgnmnt Down? To expr option(step_clause) block { For ass Down? To expr option(step_clause) 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;
asgnmnt = $2; ass = $2;
down = $3; down = $3;
kwd_to = $4; kwd_to = $4;
bound = $5; bound = $5;

View File

@ -1,9 +1,9 @@
type t is int * string type t is int * string
type u is t type u is t
type v is record foo: key; bar: mutez; baz: address end type v is record foo: key; bar: mutez; baz: address end
type w is K of v * u type w is K of (U of int) (*v * u*)
parameter p : v # Line comment parameter p : v // Line comment
storage w storage w
operations u operations u
@ -19,11 +19,11 @@ procedure g (const l : list (int)) is
begin begin
match l with match l with
[] -> null [] -> null
| h<:t -> q (h+2) | h#t -> q (h+2)
end end
end end
begin begin
g (Unit) (*; g (Unit);
fail K (3, "foo")*) fail K "in extremis"
end end