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

Storage and operations are now explicitly named.

Browse Source 
Refactoring of AST to enable the detection of incomplete pattern
matchings by the OCaml compiler. Some record fields renamed for
better readability.
This commit is contained in:
Christian Rinderknecht 2019-03-10 19:41:27 +01:00
parent 7dcad4779e
commit 8746802571
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
8 changed files with 427 additions and 358 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

411
AST.ml
View File

@ -154,14 +154,28 @@ type t = {
and ast = t and ast = t
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
const_type : type_expr;
equal : equal;
init : expr;
terminator : semi option
}
and storage_decl = { and storage_decl = {
kwd_storage : kwd_storage; kwd_storage : kwd_storage;
name : variable;
colon : colon;
store_type : type_expr; store_type : type_expr;
terminator : semi option terminator : semi option
} }
and operations_decl = { and operations_decl = {
kwd_operations : kwd_operations; kwd_operations : kwd_operations;
name : variable;
colon : colon;
op_type : type_expr; op_type : type_expr;
terminator : semi option terminator : semi option
} }
@ -259,21 +273,11 @@ and local_decl =
| LocalConst of const_decl reg | LocalConst of const_decl reg
| LocalVar of var_decl reg | LocalVar of var_decl reg
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
vtype : type_expr;
equal : equal;
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; var_type : type_expr;
ass : ass; ass : ass;
init : expr; init : expr;
terminator : semi option terminator : semi option
@ -436,12 +440,12 @@ and list_pattern =
open! Region open! Region
let type_expr_to_region = function let type_expr_to_region = function
Prod node -> node.region Prod {region; _}
| Sum node -> node.region | Sum {region; _}
| Record node -> node.region | Record {region; _}
| TypeApp node -> node.region | TypeApp {region; _}
| ParType node -> node.region | ParType {region; _}
| TAlias node -> node.region | TAlias {region; _} -> region
let expr_to_region = function let expr_to_region = function
Or {region; _} Or {region; _}
@ -562,29 +566,53 @@ let print_int {region; value = lexeme, abstract} =
(* Main printing function *) (* Main printing function *)
let rec print_tokens ast = let rec print_tokens ast =
List.iter print_type_decl ast.types; let {types; constants; storage; operations;
print_storage_decl ast.storage; lambdas; block; eof} = ast in
print_operations_decl ast.operations; List.iter print_type_decl types;
List.iter print_lambda_decl ast.lambdas; List.iter print_const_decl constants;
print_block ast.block; print_storage_decl storage;
print_token ast.eof "EOF" print_operations_decl operations;
List.iter print_lambda_decl lambdas;
print_block block;
print_token eof "EOF"
and print_storage_decl {value=node; _} = and print_const_decl {value; _} =
print_token node.kwd_storage "storage"; let {kwd_const; name; colon; const_type;
print_type_expr node.store_type; equal; init; terminator} = value in
print_terminator node.terminator print_token kwd_const "const";
print_var name;
print_token colon ":";
print_type_expr const_type;
print_token equal "=";
print_expr init;
print_terminator terminator
and print_operations_decl {value=node; _} = and print_storage_decl {value; _} =
print_token node.kwd_operations "operations"; let {kwd_storage; name; colon;
print_type_expr node.op_type; store_type; terminator} = value in
print_terminator node.terminator print_token kwd_storage "storage";
print_var name;
print_token colon ":";
print_type_expr store_type;
print_terminator terminator
and print_type_decl {value=node; _} = and print_operations_decl {value; _} =
print_token node.kwd_type "type"; let {kwd_operations; name; colon;
print_var node.name; op_type; terminator} = value in
print_token node.kwd_is "is"; print_token kwd_operations "operations";
print_type_expr node.type_expr; print_var name;
print_terminator node.terminator print_token colon ":";
print_type_expr op_type;
print_terminator terminator
and print_type_decl {value; _} =
let {kwd_type; name; kwd_is;
type_expr; terminator} = value in
print_token kwd_type "type";
print_var name;
print_token kwd_is "is";
print_type_expr type_expr;
print_terminator terminator
and print_type_expr = function and print_type_expr = function
Prod cartesian -> print_cartesian cartesian Prod cartesian -> print_cartesian cartesian
@ -594,31 +622,31 @@ and print_type_expr = function
| ParType par_type -> print_par_type par_type | ParType par_type -> print_par_type par_type
| TAlias type_alias -> print_var type_alias | TAlias type_alias -> print_var type_alias
and print_cartesian {value=sequence; _} = and print_cartesian {value; _} =
print_nsepseq "*" print_type_expr sequence print_nsepseq "*" print_type_expr value
and print_variant {value=node; _} = and print_variant {value; _} =
let constr, kwd_of, cartesian = node in let constr, kwd_of, cartesian = value in
print_constr constr; print_constr constr;
print_token kwd_of "of"; print_token kwd_of "of";
print_cartesian cartesian print_cartesian cartesian
and print_sum_type {value=sequence; _} = and print_sum_type {value; _} =
print_nsepseq "|" print_variant sequence print_nsepseq "|" print_variant value
and print_record_type {value=node; _} = and print_record_type {value; _} =
let kwd_record, field_decls, kwd_end = node in let kwd_record, field_decls, kwd_end = value in
print_token kwd_record "record"; print_token kwd_record "record";
print_field_decls field_decls; print_field_decls field_decls;
print_token kwd_end "end" print_token kwd_end "end"
and print_type_app {value=node; _} = and print_type_app {value; _} =
let type_name, type_tuple = node in let type_name, type_tuple = value in
print_var type_name; print_var type_name;
print_type_tuple type_tuple print_type_tuple type_tuple
and print_par_type {value=node; _} = and print_par_type {value; _} =
let lpar, type_expr, rpar = node in let lpar, type_expr, rpar = value in
print_token lpar "("; print_token lpar "(";
print_type_expr type_expr; print_type_expr type_expr;
print_token rpar ")" print_token rpar ")"
@ -626,14 +654,14 @@ and print_par_type {value=node; _} =
and print_field_decls sequence = and print_field_decls sequence =
print_nsepseq ";" print_field_decl sequence print_nsepseq ";" print_field_decl sequence
and print_field_decl {value=node; _} = and print_field_decl {value; _} =
let var, colon, type_expr = node in let var, colon, type_expr = value in
print_var var; print_var var;
print_token colon ":"; print_token colon ":";
print_type_expr type_expr print_type_expr type_expr
and print_type_tuple {value=node; _} = and print_type_tuple {value; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = value in
print_token lpar "("; print_token lpar "(";
print_nsepseq "," print_var sequence; print_nsepseq "," print_var sequence;
print_token rpar ")" print_token rpar ")"
@ -643,39 +671,46 @@ and print_lambda_decl = function
| ProcDecl proc_decl -> print_proc_decl proc_decl | ProcDecl proc_decl -> print_proc_decl proc_decl
| EntryDecl entry_decl -> print_entry_decl entry_decl | EntryDecl entry_decl -> print_entry_decl entry_decl
and print_fun_decl {value=node; _} = and print_fun_decl {value; _} =
print_token node.kwd_function "function"; let {kwd_function; name; param; colon;
print_var node.name; ret_type; kwd_is; local_decls;
print_parameters node.param; block; kwd_with; return; terminator} = value in
print_token node.colon ":"; print_token kwd_function "function";
print_type_expr node.ret_type; print_var name;
print_token node.kwd_is "is"; print_parameters param;
print_local_decls node.local_decls; print_token colon ":";
print_block node.block; print_type_expr ret_type;
print_token node.kwd_with "with"; print_token kwd_is "is";
print_expr node.return; print_local_decls local_decls;
print_terminator node.terminator print_block block;
print_token kwd_with "with";
print_expr return;
print_terminator terminator
and print_proc_decl {value=node; _} = and print_proc_decl {value; _} =
print_token node.kwd_procedure "procedure"; let {kwd_procedure; name; param; kwd_is;
print_var node.name; local_decls; block; terminator} = value in
print_parameters node.param; print_token kwd_procedure "procedure";
print_token node.kwd_is "is"; print_var name;
print_local_decls node.local_decls; print_parameters param;
print_block node.block; print_token kwd_is "is";
print_terminator node.terminator print_local_decls local_decls;
print_block block;
print_terminator terminator
and print_entry_decl {value=node; _} = and print_entry_decl {value; _} =
print_token node.kwd_entrypoint "entrypoint"; let {kwd_entrypoint; name; param; kwd_is;
print_var node.name; local_decls; block; terminator} = value in
print_parameters node.param; print_token kwd_entrypoint "entrypoint";
print_token node.kwd_is "is"; print_var name;
print_local_decls node.local_decls; print_parameters param;
print_block node.block; print_token kwd_is "is";
print_terminator node.terminator print_local_decls local_decls;
print_block block;
print_terminator terminator
and print_parameters {value=node; _} = and print_parameters {value; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = value in
print_token lpar "("; print_token lpar "(";
print_nsepseq ";" print_param_decl sequence; print_nsepseq ";" print_param_decl sequence;
print_token rpar ")" print_token rpar ")"
@ -684,25 +719,26 @@ and print_param_decl = function
ParamConst param_const -> print_param_const param_const ParamConst param_const -> print_param_const param_const
| ParamVar param_var -> print_param_var param_var | ParamVar param_var -> print_param_var param_var
and print_param_const {value=node; _} = and print_param_const {value; _} =
let kwd_const, variable, colon, type_expr = node in let kwd_const, variable, colon, type_expr = value in
print_token kwd_const "const"; print_token kwd_const "const";
print_var variable; print_var variable;
print_token colon ":"; print_token colon ":";
print_type_expr type_expr print_type_expr type_expr
and print_param_var {value=node; _} = and print_param_var {value; _} =
let kwd_var, variable, colon, type_expr = node in let kwd_var, variable, colon, type_expr = value in
print_token kwd_var "var"; print_token kwd_var "var";
print_var variable; print_var variable;
print_token colon ":"; print_token colon ":";
print_type_expr type_expr print_type_expr type_expr
and print_block {value=node; _} = and print_block {value; _} =
print_token node.opening "begin"; let {opening; instr; terminator; close} = value in
print_instructions node.instr; print_token opening "begin";
print_terminator node.terminator; print_instructions instr;
print_token node.close "end" print_terminator terminator;
print_token close "end"
and print_local_decls sequence = and print_local_decls sequence =
List.iter print_local_decl sequence List.iter print_local_decl sequence
@ -712,26 +748,19 @@ and print_local_decl = function
| LocalConst decl -> print_const_decl decl | LocalConst decl -> print_const_decl decl
| LocalVar decl -> print_var_decl decl | LocalVar decl -> print_var_decl decl
and print_const_decl {value=node; _} = and print_var_decl {value; _} =
print_token node.kwd_const "const"; let {kwd_var; name; colon; var_type;
print_var node.name; ass; init; terminator} = value in
print_token node.colon ":"; print_token kwd_var "var";
print_type_expr node.vtype; print_var name;
print_token node.equal "="; print_token colon ":";
print_expr node.init; print_type_expr var_type;
print_terminator node.terminator print_token ass ":=";
print_expr init;
print_terminator terminator
and print_var_decl {value=node; _} = and print_instructions {value; _} =
print_token node.kwd_var "var"; print_nsepseq ";" print_instruction value
print_var node.name;
print_token node.colon ":";
print_type_expr node.vtype;
print_token node.ass ":=";
print_expr node.init;
print_terminator node.terminator
and print_instructions {value=sequence; _} =
print_nsepseq ";" print_instruction sequence
and print_instruction = function and print_instruction = function
Single instr -> print_single_instr instr Single instr -> print_single_instr instr
@ -751,31 +780,40 @@ and print_fail (kwd_fail, expr) =
print_expr expr print_expr expr
and print_conditional node = and print_conditional node =
print_token node.kwd_if "if"; let {kwd_if; test; kwd_then; ifso;
print_expr node.test; kwd_else; ifnot} = node in
print_token node.kwd_then "then"; print_token kwd_if "if";
print_instruction node.ifso; print_expr test;
print_token node.kwd_else "else"; print_token kwd_then "then";
print_instruction node.ifnot print_instruction ifso;
print_token kwd_else "else";
print_instruction ifnot
and print_match_instr node = and print_match_instr node =
print_token node.kwd_match "match"; let {kwd_match; expr; kwd_with;
print_expr node.expr; lead_vbar; cases; kwd_end} = node in
print_token node.kwd_with "with"; print_token kwd_match "match";
print_cases node.cases; print_expr expr;
print_token node.kwd_end "end" print_token kwd_with "with";
print_token_opt lead_vbar "|";
print_cases cases;
print_token kwd_end "end"
and print_cases {value=sequence; _} = and print_token_opt = function
print_nsepseq "|" print_case sequence None -> fun _ -> ()
| Some region -> print_token region
and print_case {value=node; _} = and print_cases {value; _} =
let pattern, arrow, instruction = node in print_nsepseq "|" print_case value
and print_case {value; _} =
let pattern, arrow, instruction = value in
print_pattern pattern; print_pattern pattern;
print_token arrow "->"; print_token arrow "->";
print_instruction instruction print_instruction instruction
and print_ass_instr {value=node; _} = and print_ass_instr {value; _} =
let variable, ass, expr = node in let variable, ass, expr = value in
print_var variable; print_var variable;
print_token ass ":="; print_token ass ":=";
print_expr expr print_expr expr
@ -784,8 +822,8 @@ and print_loop = function
While while_loop -> print_while_loop while_loop While while_loop -> print_while_loop while_loop
| For for_loop -> print_for_loop for_loop | For for_loop -> print_for_loop for_loop
and print_while_loop {value=node; _} = and print_while_loop {value; _} =
let kwd_while, expr, block = node in let kwd_while, expr, block = value in
print_token kwd_while "while"; print_token kwd_while "while";
print_expr expr; print_expr expr;
print_block block print_block block
@ -794,14 +832,16 @@ and print_for_loop = function
ForInt for_int -> print_for_int for_int ForInt for_int -> print_for_int for_int
| ForCollect for_collect -> print_for_collect for_collect | ForCollect for_collect -> print_for_collect for_collect
and print_for_int ({value=node; _} : for_int reg) = and print_for_int ({value; _} : for_int reg) =
print_token node.kwd_for "for"; let {kwd_for; ass; down; kwd_to;
print_ass_instr node.ass; bound; step; block} = value in
print_down node.down; print_token kwd_for "for";
print_token node.kwd_to "to"; print_ass_instr ass;
print_expr node.bound; print_down down;
print_step node.step; print_token kwd_to "to";
print_block node.block print_expr bound;
print_step step;
print_block block
and print_down = function and print_down = function
Some kwd_down -> print_token kwd_down "down" Some kwd_down -> print_token kwd_down "down"
@ -813,13 +853,15 @@ and print_step = function
print_expr expr print_expr expr
| None -> () | None -> ()
and print_for_collect ({value=node; _} : for_collect reg) = and print_for_collect ({value; _} : for_collect reg) =
print_token node.kwd_for "for"; let {kwd_for; var; bind_to;
print_var node.var; kwd_in; expr; block} = value in
print_bind_to node.bind_to; print_token kwd_for "for";
print_token node.kwd_in "in"; print_var var;
print_expr node.expr; print_bind_to bind_to;
print_block node.block print_token kwd_in "in";
print_expr expr;
print_block block
and print_bind_to = function and print_bind_to = function
Some (arrow, variable) -> Some (arrow, variable) ->
@ -847,7 +889,7 @@ and print_expr = function
| Cat {value = expr1, cat, expr2; _} -> | Cat {value = expr1, cat, expr2; _} ->
print_expr expr1; print_token cat "^"; print_expr expr2 print_expr expr1; print_token cat "^"; print_expr expr2
| Cons {value = expr1, cons, expr2; _} -> | Cons {value = expr1, cons, expr2; _} ->
print_expr expr1; print_token cons "<:"; print_expr expr2 print_expr expr1; print_token cons "#"; print_expr expr2
| Add {value = expr1, add, expr2; _} -> | Add {value = expr1, add, expr2; _} ->
print_expr expr1; print_token add "+"; print_expr expr2 print_expr expr1; print_token add "+"; print_expr expr2
| Sub {value = expr1, sub, expr2; _} -> | Sub {value = expr1, sub, expr2; _} ->
@ -881,20 +923,21 @@ and print_expr = function
| MapLookUp lookup -> print_map_lookup lookup | MapLookUp lookup -> print_map_lookup lookup
| ParExpr pexpr -> print_par_expr pexpr | ParExpr pexpr -> print_par_expr pexpr
and print_tuple {value=node; _} = and print_tuple {value; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = value in
print_token lpar "("; print_token lpar "(";
print_nsepseq "," print_expr sequence; print_nsepseq "," print_expr sequence;
print_token rpar ")" print_token rpar ")"
and print_list {value=node; _} = and print_list {value; _} =
let lbra, sequence, rbra = node in let lbra, sequence, rbra = value in
print_token lbra "["; print_token lbra "[";
print_nsepseq "," print_expr sequence; print_nsepseq "," print_expr sequence;
print_token rbra "]" print_token rbra "]"
and print_empty_list {value=node; _} = and print_empty_list {value; _} =
let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in let lpar, (lbracket, rbracket, colon, type_expr),
rpar = value in
print_token lpar "("; print_token lpar "(";
print_token lbracket "["; print_token lbracket "[";
print_token rbracket "]"; print_token rbracket "]";
@ -902,14 +945,15 @@ and print_empty_list {value=node; _} =
print_type_expr type_expr; print_type_expr type_expr;
print_token rpar ")" print_token rpar ")"
and print_set {value=node; _} = and print_set {value; _} =
let lbrace, sequence, rbrace = node in let lbrace, sequence, rbrace = value in
print_token lbrace "{"; print_token lbrace "{";
print_nsepseq "," print_expr sequence; print_nsepseq "," print_expr sequence;
print_token rbrace "}" print_token rbrace "}"
and print_empty_set {value=node; _} = and print_empty_set {value; _} =
let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in let lpar, (lbrace, rbrace, colon, type_expr),
rpar = value in
print_token lpar "("; print_token lpar "(";
print_token lbrace "{"; print_token lbrace "{";
print_token rbrace "}"; print_token rbrace "}";
@ -917,45 +961,46 @@ and print_empty_set {value=node; _} =
print_type_expr type_expr; print_type_expr type_expr;
print_token rpar ")" print_token rpar ")"
and print_none_expr {value=node; _} = and print_none_expr {value; _} =
let lpar, (c_None, colon, type_expr), rpar = node in let lpar, (c_None, colon, type_expr), rpar = value in
print_token lpar "("; print_token lpar "(";
print_token c_None "None"; print_token c_None "None";
print_token colon ":"; print_token colon ":";
print_type_expr type_expr; print_type_expr type_expr;
print_token rpar ")" print_token rpar ")"
and print_fun_call {value=node; _} = and print_fun_call {value; _} =
let fun_name, arguments = node in let fun_name, arguments = value in
print_var fun_name; print_var fun_name;
print_tuple arguments print_tuple arguments
and print_constr_app {value=node; _} = and print_constr_app {value; _} =
let constr, arguments = node in let constr, arguments = value in
print_constr constr; print_constr constr;
print_tuple arguments print_tuple arguments
and print_some_app {value=node; _} = and print_some_app {value; _} =
let c_Some, arguments = node in let c_Some, arguments = value in
print_token c_Some "Some"; print_token c_Some "Some";
print_tuple arguments print_tuple arguments
and print_map_lookup {value=node; _} = and print_map_lookup {value; _} =
let {value = lbracket, expr, rbracket; _} = node.index in let {map_name; selector; index} = value in
print_var node.map_name; let {value = lbracket, expr, rbracket; _} = index in
print_token node.selector "."; print_var map_name;
print_token selector ".";
print_token lbracket "["; print_token lbracket "[";
print_expr expr; print_expr expr;
print_token rbracket "]" print_token rbracket "]"
and print_par_expr {value=node; _} = and print_par_expr {value; _} =
let lpar, expr, rpar = node in let lpar, expr, rpar = value in
print_token lpar "("; print_token lpar "(";
print_expr expr; print_expr expr;
print_token rpar ")" print_token rpar ")"
and print_pattern {value=sequence; _} = and print_pattern {value; _} =
print_nsepseq "<:" print_core_pattern sequence print_nsepseq "#" print_core_pattern value
and print_core_pattern = function and print_core_pattern = function
PVar var -> print_var var PVar var -> print_var var
@ -971,13 +1016,13 @@ and print_core_pattern = function
| PList pattern -> print_list_pattern pattern | PList pattern -> print_list_pattern pattern
| PTuple ptuple -> print_ptuple ptuple | PTuple ptuple -> print_ptuple ptuple
and print_psome {value=node; _} = and print_psome {value; _} =
let c_Some, patterns = node in let c_Some, patterns = value in
print_token c_Some "Some"; print_token c_Some "Some";
print_patterns patterns print_patterns patterns
and print_patterns {value=node; _} = and print_patterns {value; _} =
let lpar, core_pattern, rpar = node in let lpar, core_pattern, rpar = value in
print_token lpar "("; print_token lpar "(";
print_core_pattern core_pattern; print_core_pattern core_pattern;
print_token rpar ")" print_token rpar ")"
@ -986,22 +1031,22 @@ and print_list_pattern = function
Sugar sugar -> print_sugar sugar Sugar sugar -> print_sugar sugar
| Raw raw -> print_raw raw | Raw raw -> print_raw raw
and print_sugar {value=node; _} = and print_sugar {value; _} =
let lbracket, sequence, rbracket = node in let lbracket, sequence, rbracket = value in
print_token lbracket "["; print_token lbracket "[";
print_sepseq "," print_core_pattern sequence; print_sepseq "," print_core_pattern sequence;
print_token rbracket "]" print_token rbracket "]"
and print_raw {value=node; _} = and print_raw {value; _} =
let lpar, (core_pattern, cons, pattern), rpar = node in let lpar, (core_pattern, cons, pattern), rpar = value in
print_token lpar "("; print_token lpar "(";
print_core_pattern core_pattern; print_core_pattern core_pattern;
print_token cons "<:"; print_token cons "#";
print_pattern pattern; print_pattern pattern;
print_token rpar ")" print_token rpar ")"
and print_ptuple {value=node; _} = and print_ptuple {value; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = value in
print_token lpar "("; print_token lpar "(";
print_nsepseq "," print_core_pattern sequence; print_nsepseq "," print_core_pattern sequence;
print_token rpar ")" print_token rpar ")"

26
AST.mli
View File

@ -138,14 +138,28 @@ type t = {
and ast = t and ast = t
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
const_type : type_expr;
equal : equal;
init : expr;
terminator : semi option
}
and storage_decl = { and storage_decl = {
kwd_storage : kwd_storage; kwd_storage : kwd_storage;
name : variable;
colon : colon;
store_type : type_expr; store_type : type_expr;
terminator : semi option terminator : semi option
} }
and operations_decl = { and operations_decl = {
kwd_operations : kwd_operations; kwd_operations : kwd_operations;
name : variable;
colon : colon;
op_type : type_expr; op_type : type_expr;
terminator : semi option terminator : semi option
} }
@ -243,21 +257,11 @@ and local_decl =
| LocalConst of const_decl reg | LocalConst of const_decl reg
| LocalVar of var_decl reg | LocalVar of var_decl reg
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
vtype : type_expr;
equal : equal;
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; var_type : type_expr;
ass : ass; ass : ass;
init : expr; init : expr;
terminator : semi option terminator : semi option

240
AST2.ml
View File

@ -2,59 +2,74 @@
exception TODO of string exception TODO of string
module I = AST
open Region open Region
module SMap = Map.Make(String) module In = AST
module O = struct module SMap = Utils.String.Map
module Out =
struct
type type_name = string type type_name = string
type var_name = string type variable = string
type ast = { type ast = {
types : type_decl list; types : type_decl list;
storage : typed_var; storage : typed_var;
operations : typed_var; operations : typed_var;
declarations : decl list; declarations : decl list;
prev : I.ast; prev : In.t;
} }
and typed_var = { name:var_name; ty:type_expr }
and type_decl = { name:string; ty:type_expr } and typed_var = {name: variable; ty: type_expr}
and decl = { name:var_name; ty:type_expr; value: expr } and type_decl = {name: variable; ty: type_expr}
and decl = {name: variable; ty: type_expr; value: expr}
and type_expr = and type_expr =
Prod of type_expr list Prod of type_expr list
| Sum of (type_name * type_expr) list | Sum of (type_name * type_expr) list
| Record of (type_name * type_expr) list | Record of (type_name * type_expr) list
| TypeApp of type_name * type_expr list | TypeApp of type_name * type_expr list
| Function of { args: type_expr list; ret: type_expr } | Function of {args: type_expr list; ret: type_expr}
| Ref of type_expr | Ref of type_expr
| Unit | Unit
| Int | Int
| TODO | TODO
and expr = and expr =
App of { operator: operator; arguments: expr list } App of {operator: operator; arguments: expr list}
| Variable of var_name | Variable of variable
| Constant of constant | Constant of constant
| Lambda of { | Lambda of lambda
parameters: type_expr SMap.t;
declarations: decl list; and lambda = {
instructions: instr list; parameters : type_expr SMap.t;
result: expr; declarations : decl list;
instructions : instr list;
result : expr
} }
and operator = Add | Sub | Lt | Gt | Function of string and operator = Add | Sub | Lt | Gt | Function of string
and constant = and constant =
Unit Unit
| Int of int | Int of Z.t
and instr = and instr =
| Assignment of { name: var_name; value: expr } Assignment of { name: variable; value: expr }
| While of { condition: expr; body: instr list } | While of { condition: expr; body: instr list }
| ForCollection of { list: expr; key: var_name; value: var_name option; body: instr list } | ForCollection of { list: expr; key: variable;
value: variable option;
body: instr list }
| If of { condition: expr; ifso: instr list; ifnot: instr list } | If of { condition: expr; ifso: instr list; ifnot: instr list }
| Match of { expr: expr; cases: (pattern * instr list) list } | Match of { expr: expr; cases: (pattern * instr list) list }
| DropUnit of expr (* expr returns unit, drop the result. *) | DropUnit of expr (* expr returns unit, drop the result. *)
| Fail of { expr: expr } | Fail of { expr: expr }
| Null
and pattern = and pattern =
PVar of var_name PVar of variable
| PWild | PWild
| PInt of Z.t | PInt of Z.t
| PBytes of MBytes.t | PBytes of MBytes.t
@ -65,20 +80,20 @@ module O = struct
| PNone | PNone
| PSome of pattern | PSome of pattern
| Cons of pattern * pattern | Cons of pattern * pattern
| Null
| PTuple of pattern list | PTuple of pattern list
end end
(* open Sanity: *) let map f l = List.(rev_map f l |> rev)
let (|>) v f = f v (* pipe f to v *)
let (@@) f v = f v (* apply f on v *) (* TODO: check that List.to_seq, SMap.of_seq are not broken
let (@.) f g x = f (g x) (* compose *)
let map f l = List.rev (List.rev_map f l)
(* TODO: check that List.to_seq, List.append and SMap.of_seq are not broken
(i.e. check that they are tail-recursive) *) (i.e. check that they are tail-recursive) *)
let append_map f l = map f l |> List.flatten let append_map f l = map f l |> List.flatten
let append l1 l2 = List.append l1 l2
let list_to_map l = l |> List.to_seq |> SMap.of_seq let append l = List.(rev l |> rev_append)
let list_to_map l = l |> List.to_seq |> SMap.of_seq (* Why lazy ? *)
let fold_map f a l = let fold_map f a l =
let f (acc, l) elem = let f (acc, l) elem =
let acc', elem' = f acc elem let acc', elem' = f acc elem
@ -96,40 +111,39 @@ let s_sepseq : ('a,'sep) Utils.sepseq -> 'a list =
None -> [] None -> []
| Some nsepseq -> s_nsepseq nsepseq | Some nsepseq -> s_nsepseq nsepseq
let s_name {value=name; region} : O.var_name = let s_name ({value=name; region}: string reg) =
let () = ignore (region) in ignore region; name
name
let rec s_cartesian {value=sequence; region} : O.type_expr = let rec s_cartesian {value=sequence; region} : Out.type_expr =
let () = ignore (region) in let () = ignore region in
Prod (map s_type_expr (s_nsepseq sequence)) Prod (map s_type_expr (s_nsepseq sequence))
and s_sum_type {value=sequence; region} : O.type_expr = and s_sum_type {value=sequence; region} : Out.type_expr =
let () = ignore (region) in let () = ignore region in
let _todo = sequence in let _todo = sequence in
(* Sum (map s_type_expr (s_nsepseq sequence)) *) (* Sum (map s_type_expr (s_nsepseq sequence)) *)
TODO TODO
and s_record_type {value=(kwd_record, field_decls, kwd_end); region} : O.type_expr = and s_record_type {value=(kwd_record, field_decls, kwd_end); region} : Out.type_expr =
let () = ignore (kwd_record,region,kwd_end) in let () = ignore (kwd_record,region,kwd_end) in
let _todo = (* s_field_decls *) field_decls in let _todo = (* s_field_decls *) field_decls in
TODO TODO
and s_type_app {value=node; region} : O.type_expr = and s_type_app {value=node; region} : Out.type_expr =
let () = ignore (region) in let () = ignore region in
let _todo = node in let _todo = node in
TODO TODO
(* let type_name, type_tuple = node in *) (* let type_name, type_tuple = node in *)
(* s_var type_name; *) (* s_var type_name; *)
(* s_type_tuple type_tuple *) (* s_type_tuple type_tuple *)
and s_par_type {value=node; region} : O.type_expr = and s_par_type {value=node; region} : Out.type_expr =
let () = ignore (region) in let () = ignore region in
let _todo = node in let _todo = node in
TODO TODO
and s_var {region; value=lexeme} : O.type_expr = and s_var {region; value=lexeme} : Out.type_expr =
let () = ignore (region) in let () = ignore region in
let _todo = lexeme in let _todo = lexeme in
TODO TODO
@ -138,7 +152,7 @@ and s_var {region; value=lexeme} : O.type_expr =
s_type_expr type_expr; s_type_expr type_expr;
s_token rpar ")"*) s_token rpar ")"*)
and s_type_expr : I.type_expr -> O.type_expr = function and s_type_expr : In.type_expr -> Out.type_expr = function
Prod cartesian -> s_cartesian cartesian Prod cartesian -> s_cartesian cartesian
| Sum sum_type -> s_sum_type sum_type | Sum sum_type -> s_sum_type sum_type
| Record record_type -> s_record_type record_type | Record record_type -> s_record_type record_type
@ -147,93 +161,97 @@ and s_type_expr : I.type_expr -> O.type_expr = function
| TAlias type_alias -> s_var type_alias | TAlias type_alias -> s_var type_alias
let s_type_decl I.{value={kwd_type;name;kwd_is;type_expr;terminator}; region} : O.type_decl = let s_type_decl In.{value={kwd_type;name;kwd_is;type_expr;terminator}; region} : Out.type_decl =
let () = ignore (kwd_type,kwd_is,terminator,region) in let () = ignore (kwd_type,kwd_is,terminator,region) in
O.{ name = s_name name; ty = s_type_expr type_expr } Out.{ name = s_name name; ty = s_type_expr type_expr }
let s_storage_decl I.{value={kwd_storage; store_type; terminator}; region} : O.typed_var = let s_storage_decl In.{value={kwd_storage; store_type; terminator}; region} : Out.typed_var =
let () = ignore (kwd_storage,terminator,region) in let () = ignore (kwd_storage,terminator,region) in
O.{ name = "storage"; ty = s_type_expr store_type } Out.{ name = "storage"; ty = s_type_expr store_type }
let s_operations_decl I.{value={kwd_operations;op_type;terminator}; region} : O.typed_var = let s_operations_decl In.{value={kwd_operations;op_type;terminator}; region} : Out.typed_var =
let () = ignore (kwd_operations,terminator,region) in let () = ignore (kwd_operations,terminator,region) in
O.{ name = "operations"; ty = s_type_expr op_type } Out.{ name = "operations"; ty = s_type_expr op_type }
let s_expr : I.expr -> O.expr = function let s_expr : In.expr -> Out.expr = function
| _ -> raise (TODO "simplify expressions") | _ -> raise (TODO "simplify expressions")
let s_case : I.case -> O.pattern * (O.instr list) = function let s_case : In.case -> Out.pattern * (Out.instr list) = function
| _ -> raise (TODO "simplify pattern matching cases") | _ -> raise (TODO "simplify pattern matching cases")
let s_const_decl I.{value={kwd_const;name;colon;vtype;equal;init;terminator}; region} : O.decl = let s_const_decl In.{value; region} : Out.decl =
let In.{kwd_const; name; colon;
const_type; equal; init; terminator} = value in
let () = ignore (kwd_const,colon,equal,terminator,region) in let () = ignore (kwd_const,colon,equal,terminator,region) in
O.{ name = s_name name; ty = s_type_expr vtype; value = s_expr init } Out.{name = s_name name;
ty = s_type_expr const_type;
value = s_expr init}
let s_param_const {value=(kwd_const,variable,colon,type_expr); region} : string * O.type_expr = let s_param_const {value=(kwd_const,variable,colon,type_expr); region} : string * Out.type_expr =
let () = ignore (kwd_const,colon,region) in let () = ignore (kwd_const,colon,region) in
s_name variable, s_type_expr type_expr s_name variable, s_type_expr type_expr
let s_param_var {value=(kwd_var,variable,colon,type_expr); region} : string * O.type_expr = let s_param_var {value=(kwd_var,variable,colon,type_expr); region} : string * Out.type_expr =
let () = ignore (kwd_var,colon,region) in let () = ignore (kwd_var,colon,region) in
s_name variable, s_type_expr type_expr s_name variable, s_type_expr type_expr
let s_param_decl : I.param_decl -> string * O.type_expr = function let s_param_decl : In.param_decl -> string * Out.type_expr = function
ParamConst p -> s_param_const p ParamConst p -> s_param_const p
| ParamVar p -> s_param_var p | ParamVar p -> s_param_var p
let s_parameters ({value=(lpar,param_decl,rpar);region} : I.parameters) : (string * O.type_expr) list = let s_parameters ({value=(lpar,param_decl,rpar);region} : In.parameters) : (string * Out.type_expr) list =
let () = ignore (lpar,rpar,region) in let () = ignore (lpar,rpar,region) in
let l = (s_nsepseq param_decl) in let l = (s_nsepseq param_decl) in
map s_param_decl l map s_param_decl l
let rec s_var_decl I.{value={kwd_var;name;colon;vtype;ass;init;terminator}; region} : O.decl = let rec s_var_decl {value; region} : Out.decl =
let () = ignore (kwd_var,colon,ass,terminator,region) in let In.{kwd_var; name; colon;
O.{ var_type; ass; init; terminator} = value in
name = s_name name; let () = ignore (kwd_var, colon, ass, terminator, region) in
ty = s_type_expr vtype; Out.{name = s_name name;
value = s_expr init ty = s_type_expr var_type;
} value = s_expr init}
and s_local_decl : I.local_decl -> O.decl = function and s_local_decl : In.local_decl -> Out.decl = function
LocalLam decl -> s_lambda_decl decl LocalLam decl -> s_lambda_decl decl
| LocalConst decl -> s_const_decl decl | LocalConst decl -> s_const_decl decl
| LocalVar decl -> s_var_decl decl | LocalVar decl -> s_var_decl decl
and s_instructions ({value=sequence; region} : I.instructions) : O.instr list = and s_instructions ({value=sequence; region} : In.instructions) : Out.instr list =
let () = ignore (region) in let () = ignore region in
append_map s_instruction (s_nsepseq sequence) append_map s_instruction (s_nsepseq sequence)
and s_instruction : I.instruction -> O.instr list = function and s_instruction : In.instruction -> Out.instr list = function
Single instr -> s_single_instr instr Single instr -> s_single_instr instr
| Block block -> (s_block block) | Block block -> (s_block block)
and s_conditional I.{kwd_if;test;kwd_then;ifso;kwd_else;ifnot} : O.instr = and s_conditional In.{kwd_if;test;kwd_then;ifso;kwd_else;ifnot} : Out.instr =
let () = ignore (kwd_if,kwd_then,kwd_else) in let () = ignore (kwd_if,kwd_then,kwd_else) in
If { condition = s_expr test; ifso = s_instruction ifso; ifnot = s_instruction ifnot } If { condition = s_expr test; ifso = s_instruction ifso; ifnot = s_instruction ifnot }
and s_match_instr I.{kwd_match;expr;kwd_with;lead_vbar;cases;kwd_end} : O.instr = and s_match_instr In.{kwd_match;expr;kwd_with;lead_vbar;cases;kwd_end} : Out.instr =
let {value=cases;region} = cases in let {value=cases;region} = cases in
let () = ignore (kwd_match,kwd_with,lead_vbar,kwd_end,region) in let () = ignore (kwd_match,kwd_with,lead_vbar,kwd_end,region) in
Match { expr = s_expr expr; cases = map s_case (s_nsepseq cases) } Match { expr = s_expr expr; cases = map s_case (s_nsepseq cases) }
and s_ass_instr {value=(variable,ass,expr); region} : O.instr = and s_ass_instr {value=(variable,ass,expr); region} : Out.instr =
let () = ignore (ass,region) in let () = ignore (ass,region) in
Assignment { name = s_name variable; value = s_expr expr } Assignment { name = s_name variable; value = s_expr expr }
and s_while_loop {value=(kwd_while, expr, block); region} : O.instr list = and s_while_loop {value=(kwd_while, expr, block); region} : Out.instr list =
let () = ignore (kwd_while,region) in let () = ignore (kwd_while,region) in
[While {condition = s_expr expr; body = s_block block}] [While {condition = s_expr expr; body = s_block block}]
and s_for_loop : I.for_loop -> O.instr list = function and s_for_loop : In.for_loop -> Out.instr list = function
ForInt for_int -> s_for_int for_int ForInt for_int -> s_for_int for_int
| ForCollect for_collect -> s_for_collect for_collect | ForCollect for_collect -> s_for_collect for_collect
and s_for_int ({value={kwd_for;ass;down;kwd_to;bound;step;block}; region} : I.for_int reg) : O.instr list = and s_for_int ({value={kwd_for;ass;down;kwd_to;bound;step;block}; region} : In.for_int reg) : Out.instr list =
let {value=(variable,ass_kwd,expr);region = ass_region} = ass in let {value=(variable,ass_kwd,expr);region = ass_region} = ass in
let () = ignore (kwd_for,ass_region,ass_kwd,kwd_to,region) in let () = ignore (kwd_for,ass_region,ass_kwd,kwd_to,region) in
let name = s_name variable in let name = s_name variable in
let condition, operator = match down with Some kwd_down -> ignore kwd_down; O.Gt, O.Sub let condition, operator = match down with Some kwd_down -> ignore kwd_down; Out.Gt, Out.Sub
| None -> O.Lt, O.Add in | None -> Out.Lt, Out.Add in
let step = s_step step let step = s_step step
in [ in [
Assignment { name; value = s_expr expr }; Assignment { name; value = s_expr expr };
@ -241,17 +259,17 @@ and s_for_int ({value={kwd_for;ass;down;kwd_to;bound;step;block}; region} : I.fo
While { While {
condition = App { operator = condition; condition = App { operator = condition;
arguments = [Variable name; s_expr bound] }; arguments = [Variable name; s_expr bound] };
body = append (s_block block) body = List.append (s_block block)
[O.Assignment { name; [Out.Assignment { name;
value = App { operator; value = App { operator;
arguments = [Variable name; step]}}] arguments = [Variable name; step]}}]
} }
] ]
and s_for_collect ({value={kwd_for;var;bind_to;kwd_in;expr;block}; _} : I.for_collect reg) : O.instr list = and s_for_collect ({value={kwd_for;var;bind_to;kwd_in;expr;block}; _} : In.for_collect reg) : Out.instr list =
let () = ignore (kwd_for,kwd_in) in let () = ignore (kwd_for,kwd_in) in
[ [
O.ForCollection { Out.ForCollection {
list = s_expr expr; list = s_expr expr;
key = s_name var; key = s_name var;
value = s_bind_to bind_to; value = s_bind_to bind_to;
@ -259,34 +277,31 @@ and s_for_collect ({value={kwd_for;var;bind_to;kwd_in;expr;block}; _} : I.for_co
} }
] ]
and s_step : (I.kwd_step * I.expr) option -> O.expr = function and s_step : (In.kwd_step * In.expr) option -> Out.expr = function
Some (kwd_step, expr) -> let () = ignore (kwd_step) in s_expr expr Some (kwd_step, expr) -> let () = ignore (kwd_step) in s_expr expr
| None -> Constant (Int 1) | None -> Constant (Int Z.one)
and s_bind_to : (I.arrow * I.variable) option -> O.var_name option = function and s_bind_to : (In.arrow * In.variable) option -> Out.variable option = function
Some (arrow, variable) -> let () = ignore (arrow) in Some (s_name variable) Some (arrow, variable) ->
| None -> None let () = ignore arrow in Some (s_name variable)
| None -> None
and s_loop : I.loop -> O.instr list = function and s_loop : In.loop -> Out.instr list = function
While while_loop -> s_while_loop while_loop While while_loop -> s_while_loop while_loop
| For for_loop -> s_for_loop for_loop | For for_loop -> s_for_loop for_loop
and s_fun_call {value=(fun_name, arguments); region} : O.expr = and s_fun_call {value=(fun_name, arguments); region} : Out.expr =
let () = ignore (region) in let () = ignore region in
App { operator = Function (s_name fun_name); arguments = s_arguments arguments } App { operator = Function (s_name fun_name); arguments = s_arguments arguments }
and s_arguments {value=(lpar, sequence, rpar); region} = and s_arguments {value=(lpar, sequence, rpar); region} =
let () = ignore (lpar,rpar,region) in let () = ignore (lpar, rpar, region) in
map s_expr (s_nsepseq sequence); map s_expr (s_nsepseq sequence);
and s_fail ((kwd_fail, expr) : (I.kwd_fail * I.expr)) : O.instr = and s_fail ((kwd_fail, expr) : (In.kwd_fail * In.expr)) : Out.instr =
let () = ignore (kwd_fail) in ignore kwd_fail; Fail {expr = s_expr expr}
Fail { expr = s_expr expr }
and s_single_instr : In.single_instr -> Out.instr list = function
and s_single_instr : I.single_instr -> O.instr list = function
Cond {value; _} -> [s_conditional value] Cond {value; _} -> [s_conditional value]
| Match {value; _} -> [s_match_instr value] | Match {value; _} -> [s_match_instr value]
| Ass instr -> [s_ass_instr instr] | Ass instr -> [s_ass_instr instr]
@ -296,13 +311,13 @@ and s_single_instr : I.single_instr -> O.instr list = function
[] []
| Fail {value; _} -> [s_fail value] | Fail {value; _} -> [s_fail value]
and s_block I.{value={opening;instr;terminator;close}; _} : O.instr list = and s_block In.{value={opening;instr;terminator;close}; _} : Out.instr list =
let () = ignore (opening,terminator,close) in let () = ignore (opening,terminator,close) in
s_instructions instr s_instructions instr
and s_fun_decl I.{value={kwd_function;name;param;colon;ret_type;kwd_is;local_decls;block;kwd_with;return;terminator}; region} : O.decl = and s_fun_decl In.{value={kwd_function;name;param;colon;ret_type;kwd_is;local_decls;block;kwd_with;return;terminator}; region} : Out.decl =
let () = ignore (kwd_function,colon,kwd_is,kwd_with,terminator,region) in let () = ignore (kwd_function,colon,kwd_is,kwd_with,terminator,region) in
O.{ Out.{
name = s_name name; name = s_name name;
ty = Function { args = map snd (s_parameters param); ret = s_type_expr ret_type }; ty = Function { args = map snd (s_parameters param); ret = s_type_expr ret_type };
value = Lambda { value = Lambda {
@ -313,39 +328,40 @@ and s_fun_decl I.{value={kwd_function;name;param;colon;ret_type;kwd_is;local_dec
} }
} }
and s_proc_decl I.{value={kwd_procedure;name;param;kwd_is;local_decls;block;terminator}; region} = and s_proc_decl In.{value={kwd_procedure;name;param;kwd_is;local_decls;block;terminator}; region} =
let () = ignore (kwd_procedure,kwd_is,terminator,region) in let () = ignore (kwd_procedure,kwd_is,terminator,region) in
O.{ Out.{
name = s_name name; name = s_name name;
ty = Function { args = map snd (s_parameters param); ret = Unit }; ty = Function { args = map snd (s_parameters param); ret = Unit };
value = Lambda { value = Lambda {
parameters = s_parameters param |> list_to_map; parameters = s_parameters param |> list_to_map;
declarations = map s_local_decl local_decls; declarations = map s_local_decl local_decls;
instructions = s_block block; instructions = s_block block;
result = O.Constant O.Unit result = Out.Constant Out.Unit
} }
} }
and s_lambda_decl : I.lambda_decl -> O.decl = function and s_lambda_decl : In.lambda_decl -> Out.decl = function
FunDecl fun_decl -> s_fun_decl fun_decl FunDecl fun_decl -> s_fun_decl fun_decl
| ProcDecl proc_decl -> s_proc_decl proc_decl | ProcDecl proc_decl -> s_proc_decl proc_decl
| EntryDecl entry_decl -> failwith "TODO"
let s_main_block (block: I.block reg) : O.decl = let s_main_block (block: In.block reg) : Out.decl =
O.{ Out.{
name = "main"; name = "main";
ty = Function { args = []; ret = Unit }; ty = Function { args = []; ret = Unit };
value = Lambda { value = Lambda {
parameters = SMap.empty; parameters = SMap.empty;
declarations = []; declarations = [];
instructions = s_block block; instructions = s_block block;
result = O.Constant O.Unit result = Out.Constant Out.Unit
} }
} }
let s_ast (ast : I.ast) : O.ast = let s_ast (ast : In.ast) : Out.ast =
let I.{types;constants;storage;operations;lambdas;block;eof} = ast in let In.{types;constants;storage;operations;lambdas;block;eof} = ast in
let () = ignore (eof) in let () = ignore (eof) in
O.{ Out.{
types = map s_type_decl types; types = map s_type_decl types;
storage = s_storage_decl storage; storage = s_storage_decl storage;
operations = s_operations_decl operations; operations = s_operations_decl operations;

2
LexToken.mli
View File

@ -44,7 +44,7 @@ type t =
| RBRACE of Region.t (* "}" *) | RBRACE of Region.t (* "}" *)
| LBRACKET of Region.t (* "[" *) | LBRACKET of Region.t (* "[" *)
| RBRACKET of Region.t (* "]" *) | RBRACKET of Region.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 (* "->" *)
| ASS of Region.t (* ":=" *) | ASS of Region.t (* ":=" *)

2
Lexer.mll
View File

@ -443,7 +443,7 @@ let esc = "\\n" | "\\\"" | "\\\\" | "\\b"
| "\\r" | "\\t" | "\\x" byte | "\\r" | "\\t" | "\\x" byte
let symbol = ';' | ',' let symbol = ';' | ','
| '(' | ')' | '{' | '}' | '[' | ']' | '(' | ')' | '{' | '}' | '[' | ']'
| "#" | '|' | "->" | ":=" | '=' | ':' | '#' | '|' | "->" | ":=" | '=' | ':'
| "||" | "&&" | '<' | "<=" | '>' | ">=" | "=/=" | "||" | "&&" | '<' | "<=" | '>' | ">=" | "=/="
| '+' | '-' | '*' | '.' | '_' | '^' | '+' | '-' | '*' | '.' | '_' | '^'

2
ParToken.mly
View File

@ -21,7 +21,7 @@
%token <Region.t> RBRACE (* "}" *) %token <Region.t> RBRACE (* "}" *)
%token <Region.t> LBRACKET (* "[" *) %token <Region.t> LBRACKET (* "[" *)
%token <Region.t> RBRACKET (* "]" *) %token <Region.t> RBRACKET (* "]" *)
%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> ASS (* ":=" *) %token <Region.t> ASS (* ":=" *)

28
Parser.mly
View File

@ -108,30 +108,34 @@ program:
} }
storage_decl: storage_decl:
Storage type_expr option(SEMI) { Storage var COLON type_expr option(SEMI) {
let stop = let stop =
match $3 with match $5 with
None -> type_expr_to_region $2 None -> type_expr_to_region $4
| Some region -> region in | Some region -> region in
let region = cover $1 stop in let region = cover $1 stop in
let value = { let value = {
kwd_storage = $1; kwd_storage = $1;
store_type = $2; name = $2;
terminator = $3} colon = $3;
store_type = $4;
terminator = $5}
in {region; value} in {region; value}
} }
operations_decl: operations_decl:
Operations type_expr option(SEMI) { Operations var COLON type_expr option(SEMI) {
let stop = let stop =
match $3 with match $5 with
None -> type_expr_to_region $2 None -> type_expr_to_region $4
| Some region -> region in | Some region -> region in
let region = cover $1 stop in let region = cover $1 stop in
let value = { let value = {
kwd_operations = $1; kwd_operations = $1;
op_type = $2; name = $2;
terminator = $3} colon = $3;
op_type = $4;
terminator = $5}
in {region; value} in {region; value}
} }
@ -347,7 +351,7 @@ const_decl:
kwd_const = $1; kwd_const = $1;
name = $2; name = $2;
colon = $3; colon = $3;
vtype = $4; const_type = $4;
equal = $5; equal = $5;
init = $6; init = $6;
terminator = $7} terminator = $7}
@ -365,7 +369,7 @@ var_decl:
kwd_var = $1; kwd_var = $1;
name = $2; name = $2;
colon = $3; colon = $3;
vtype = $4; var_type = $4;
ass = $5; ass = $5;
init = $6; init = $6;
terminator = $7} terminator = $7}

4
Tests/a.li
View File

@ -3,8 +3,8 @@ 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 (U of int) (*v * u*) type w is K of (U of int) (*v * u*)
storage w // Line comment storage s : w // Line comment
operations u operations o : u;
(* Block comment *) (* Block comment *)