diff --git a/AST.ml b/AST.ml index 435c9770f..bd92bfaab 100644 --- a/AST.ml +++ b/AST.ml @@ -60,6 +60,7 @@ type kwd_of = Region.t type kwd_procedure = Region.t type kwd_record = Region.t type kwd_step = Region.t +type kwd_storage = Region.t type kwd_then = Region.t type kwd_to = Region.t type kwd_type = Region.t @@ -243,7 +244,7 @@ and proc_decl = { and entry_decl = { kwd_entrypoint : kwd_entrypoint; name : variable; - param : parameters; + param : entry_params; colon : colon; ret_type : type_expr; kwd_is : kwd_is; @@ -256,6 +257,20 @@ and entry_decl = { and parameters = (param_decl, semi) nsepseq par reg +and entry_params = (entry_param_decl, semi) nsepseq par reg + +and entry_param_decl = + EntryConst of param_const reg +| EntryVar of param_var reg +| EntryStore of storage reg + +and storage = { + kwd_storage : kwd_storage; + var : variable; + colon : colon; + storage_type : type_expr +} + and param_decl = ParamConst of param_const reg | ParamVar of param_var reg @@ -836,17 +851,35 @@ and print_entry_decl {value; _} = let {kwd_entrypoint; name; param; colon; ret_type; kwd_is; local_decls; block; kwd_with; return; terminator} = value in - print_token kwd_entrypoint "entrypoint"; - print_var name; - print_parameters param; - print_token colon ":"; - print_type_expr ret_type; - print_token kwd_is "is"; - print_local_decls local_decls; - print_block block; - print_token kwd_with "with"; - print_expr return; - print_terminator terminator + print_token kwd_entrypoint "entrypoint"; + print_var name; + print_entry_params param; + print_token colon ":"; + print_type_expr ret_type; + print_token kwd_is "is"; + print_local_decls local_decls; + print_block block; + print_token kwd_with "with"; + print_expr return; + print_terminator terminator + +and print_entry_params {value; _} = + let {lpar; inside; rpar} = value in + print_token lpar "("; + print_nsepseq ";" print_entry_param_decl inside; + print_token rpar ")" + +and print_entry_param_decl = function + EntryConst param_const -> print_param_const param_const +| EntryVar param_var -> print_param_var param_var +| EntryStore param_store -> print_storage param_store + +and print_storage {value; _} = + let {kwd_storage; var; colon; storage_type} = value in + print_token kwd_storage "storage"; + print_var var; + print_token colon ":"; + print_type_expr storage_type and print_parameters {value; _} = let {lpar; inside; rpar} = value in diff --git a/AST.mli b/AST.mli index 92ab2a8ad..ddf5a795a 100644 --- a/AST.mli +++ b/AST.mli @@ -44,6 +44,7 @@ type kwd_of = Region.t type kwd_procedure = Region.t type kwd_record = Region.t type kwd_step = Region.t +type kwd_storage = Region.t type kwd_then = Region.t type kwd_to = Region.t type kwd_type = Region.t @@ -227,7 +228,7 @@ and proc_decl = { and entry_decl = { kwd_entrypoint : kwd_entrypoint; name : variable; - param : parameters; + param : entry_params; colon : colon; ret_type : type_expr; kwd_is : kwd_is; @@ -240,6 +241,20 @@ and entry_decl = { and parameters = (param_decl, semi) nsepseq par reg +and entry_params = (entry_param_decl, semi) nsepseq par reg + +and entry_param_decl = + EntryConst of param_const reg +| EntryVar of param_var reg +| EntryStore of storage reg + +and storage = { + kwd_storage : kwd_storage; + var : variable; + colon : colon; + storage_type : type_expr +} + and param_decl = ParamConst of param_const reg | ParamVar of param_var reg diff --git a/LexToken.mli b/LexToken.mli index 73965263b..48b981b18 100644 --- a/LexToken.mli +++ b/LexToken.mli @@ -89,6 +89,7 @@ type t = | Procedure of Region.t (* "procedure" *) | Record of Region.t (* "record" *) | Step of Region.t (* "step" *) +| Storage of Region.t (* "storage" *) | To of Region.t (* "to" *) | Mod of Region.t (* "mod" *) | Not of Region.t (* "not" *) diff --git a/LexToken.mll b/LexToken.mll index 5994d352b..1c78d5de2 100644 --- a/LexToken.mll +++ b/LexToken.mll @@ -88,6 +88,7 @@ type t = | Procedure of Region.t | Record of Region.t | Step of Region.t +| Storage of Region.t | To of Region.t | Mod of Region.t | Not of Region.t @@ -206,6 +207,7 @@ let proj_token = function | Procedure region -> region, "Procedure" | Record region -> region, "Record" | Step region -> region, "Step" +| Storage region -> region, "Storage" | To region -> region, "To" | Mod region -> region, "Mod" | Not region -> region, "Not" @@ -289,6 +291,7 @@ let to_lexeme = function | Procedure _ -> "procedure" | Record _ -> "record" | Step _ -> "step" +| Storage _ -> "storage" | To _ -> "to" | Mod _ -> "mod" | Not _ -> "not" @@ -340,6 +343,7 @@ let keywords = [ (fun reg -> Procedure reg); (fun reg -> Record reg); (fun reg -> Step reg); + (fun reg -> Storage reg); (fun reg -> To reg); (fun reg -> Mod reg); (fun reg -> Not reg); @@ -563,6 +567,7 @@ let is_kwd = function | Procedure _ | Record _ | Step _ +| Storage _ | To _ | Mod _ | Not _ diff --git a/ParToken.mly b/ParToken.mly index 54df7f5fa..3042595da 100644 --- a/ParToken.mly +++ b/ParToken.mly @@ -66,6 +66,7 @@ %token Procedure (* "procedure" *) %token Record (* "record" *) %token Step (* "step" *) +%token Storage (* "storage" *) %token To (* "to" *) %token Mod (* "mod" *) %token Not (* "not" *) diff --git a/Parser.mly b/Parser.mly index d6b85f88c..e7429c60a 100644 --- a/Parser.mly +++ b/Parser.mly @@ -219,7 +219,7 @@ fun_decl: } entry_decl: - Entrypoint fun_name parameters COLON type_expr Is + Entrypoint fun_name entry_params COLON type_expr Is seq(local_decl) block With expr option(SEMI) { @@ -243,6 +243,9 @@ entry_decl: in {region; value} } +entry_params: + par(nsepseq(entry_param_decl,SEMI)) { $1 } + proc_decl: Procedure fun_name parameters Is seq(local_decl) @@ -289,6 +292,23 @@ param_decl: in ParamConst {region; value} } +entry_param_decl: + param_decl { + match $1 with + ParamConst const -> EntryConst const + | ParamVar var -> EntryVar var + } +| Storage var COLON type_expr { + let stop = type_expr_to_region $4 in + let region = cover $1 stop + and value = { + kwd_storage = $1; + var = $2; + colon = $3; + storage_type = $4} + in EntryStore {region; value} + } + block: Begin instruction after_instr diff --git a/Tests/a.li b/Tests/a.li index f618a5417..129a68d1f 100644 --- a/Tests/a.li +++ b/Tests/a.li @@ -1,6 +1,12 @@ type t is int * string 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 i is int; @@ -14,7 +20,7 @@ const x : v = (* Block comment *) -entrypoint g (var s : storage; const l : list (int)) +entrypoint g (storage s : u; const l : list (int)) : operation (list) is var m : map (int, string) := empty_map; var y : v := copy x with record bar = 7 end; @@ -36,4 +42,4 @@ entrypoint g (var s : storage; const l : list (int)) g (Unit); fail "in extremis" end - end with ([]: operation (list)) + end with (s, ([]: (u * operation (list))))