diff --git a/AST.ml b/AST.ml index 688135a1d..c9cc7b0f7 100644 --- a/AST.ml +++ b/AST.ml @@ -42,29 +42,29 @@ let sepseq_to_region to_region = function type kwd_begin = Region.t type kwd_const = Region.t type kwd_down = Region.t +type kwd_else = Region.t +type kwd_end = Region.t +type kwd_entrypoint = Region.t type kwd_fail = Region.t +type kwd_for = Region.t +type kwd_function = Region.t type kwd_if = Region.t type kwd_in = Region.t type kwd_is = Region.t -type kwd_for = Region.t -type kwd_function = Region.t -type kwd_parameter = Region.t -type kwd_storage = Region.t -type kwd_type = Region.t -type kwd_of = Region.t -type kwd_operations = Region.t -type kwd_var = Region.t -type kwd_end = Region.t -type kwd_then = Region.t -type kwd_else = Region.t type kwd_match = Region.t -type kwd_procedure = Region.t -type kwd_null = Region.t -type kwd_record = Region.t -type kwd_step = Region.t -type kwd_to = Region.t type kwd_mod = Region.t type kwd_not = Region.t +type kwd_null = Region.t +type kwd_of = Region.t +type kwd_operations = 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 +type kwd_var = Region.t type kwd_while = Region.t type kwd_with = Region.t @@ -145,7 +145,6 @@ type 'a braces = (lbrace * 'a * rbrace) reg type t = { types : type_decl reg list; constants : const_decl reg list; - parameter : parameter_decl reg; storage : storage_decl reg; operations : operations_decl reg; lambdas : lambda_decl list; @@ -155,14 +154,6 @@ type t = { and ast = t -and parameter_decl = { - kwd_parameter : kwd_parameter; - name : variable; - colon : colon; - param_type : type_expr; - terminator : semi option -} - and storage_decl = { kwd_storage : kwd_storage; store_type : type_expr; @@ -208,8 +199,9 @@ and type_tuple = (type_name, comma) nsepseq par (* Function and procedure declarations *) and lambda_decl = - FunDecl of fun_decl reg -| ProcDecl of proc_decl reg + FunDecl of fun_decl reg +| ProcDecl of proc_decl reg +| EntryDecl of entry_decl reg and fun_decl = { kwd_function : kwd_function; @@ -235,6 +227,16 @@ and proc_decl = { terminator : semi option } +and entry_decl = { + kwd_entrypoint : kwd_entrypoint; + name : variable; + param : parameters; + kwd_is : kwd_is; + local_decls : local_decl list; + block : block reg; + terminator : semi option +} + and parameters = (param_decl, semi) nsepseq par and param_decl = @@ -506,10 +508,11 @@ let core_pattern_to_region = function | PTuple {region; _} -> region let local_decl_to_region = function - LocalLam FunDecl {region; _} -| LocalLam ProcDecl {region; _} -| LocalConst {region; _} -| LocalVar {region; _} -> region + LocalLam FunDecl {region; _} +| LocalLam ProcDecl {region; _} +| LocalLam EntryDecl {region; _} +| LocalConst {region; _} +| LocalVar {region; _} -> region (* Printing the tokens with their source regions *) @@ -543,7 +546,7 @@ let print_constr {region; value=lexeme} = (compact region) lexeme let print_string {region; value=lexeme} = - printf "%s: String \"%s\"\n" + printf "%s: String %s\n" (compact region) lexeme let print_bytes {region; value = lexeme, abstract} = @@ -560,20 +563,12 @@ let print_int {region; value = lexeme, abstract} = let rec print_tokens ast = List.iter print_type_decl ast.types; - print_parameter_decl ast.parameter; (* TODO: Constants *) print_storage_decl ast.storage; print_operations_decl ast.operations; List.iter print_lambda_decl ast.lambdas; print_block ast.block; print_token ast.eof "EOF" -and print_parameter_decl {value=node; _} = - print_token node.kwd_parameter "parameter"; - print_var node.name; - print_token node.colon ":"; - print_type_expr node.param_type; - print_terminator node.terminator - and print_storage_decl {value=node; _} = print_token node.kwd_storage "storage"; print_type_expr node.store_type; @@ -644,8 +639,9 @@ and print_type_tuple {value=node; _} = print_token rpar ")" and print_lambda_decl = function - FunDecl fun_decl -> print_fun_decl fun_decl -| ProcDecl proc_decl -> print_proc_decl proc_decl + FunDecl fun_decl -> print_fun_decl fun_decl +| ProcDecl proc_decl -> print_proc_decl proc_decl +| EntryDecl entry_decl -> print_entry_decl entry_decl and print_fun_decl {value=node; _} = print_token node.kwd_function "function"; @@ -669,6 +665,15 @@ and print_proc_decl {value=node; _} = print_block node.block; print_terminator node.terminator +and print_entry_decl {value=node; _} = + print_token node.kwd_entrypoint "entrypoint"; + print_var node.name; + print_parameters node.param; + print_token node.kwd_is "is"; + print_local_decls node.local_decls; + print_block node.block; + print_terminator node.terminator + and print_parameters {value=node; _} = let lpar, sequence, rpar = node in print_token lpar "("; diff --git a/AST.mli b/AST.mli index e8a812ec7..3454ee526 100644 --- a/AST.mli +++ b/AST.mli @@ -26,29 +26,29 @@ val sepseq_to_region : ('a -> Region.t) -> ('a,'sep) sepseq -> Region.t type kwd_begin = Region.t type kwd_const = Region.t type kwd_down = Region.t +type kwd_else = Region.t +type kwd_end = Region.t +type kwd_entrypoint = Region.t type kwd_fail = Region.t +type kwd_for = Region.t +type kwd_function = Region.t type kwd_if = Region.t type kwd_in = Region.t type kwd_is = Region.t -type kwd_for = Region.t -type kwd_function = Region.t -type kwd_parameter = Region.t -type kwd_storage = Region.t -type kwd_type = Region.t -type kwd_of = Region.t -type kwd_operations = Region.t -type kwd_var = Region.t -type kwd_end = Region.t -type kwd_then = Region.t -type kwd_else = Region.t type kwd_match = Region.t -type kwd_procedure = Region.t -type kwd_null = Region.t -type kwd_record = Region.t -type kwd_step = Region.t -type kwd_to = Region.t type kwd_mod = Region.t type kwd_not = Region.t +type kwd_null = Region.t +type kwd_of = Region.t +type kwd_operations = 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 +type kwd_var = Region.t type kwd_while = Region.t type kwd_with = Region.t @@ -129,7 +129,6 @@ type 'a braces = (lbrace * 'a * rbrace) reg type t = { types : type_decl reg list; constants : const_decl reg list; - parameter : parameter_decl reg; storage : storage_decl reg; operations : operations_decl reg; lambdas : lambda_decl list; @@ -139,14 +138,6 @@ type t = { and ast = t -and parameter_decl = { - kwd_parameter : kwd_parameter; - name : variable; - colon : colon; - param_type : type_expr; - terminator : semi option -} - and storage_decl = { kwd_storage : kwd_storage; store_type : type_expr; @@ -192,8 +183,9 @@ and type_tuple = (type_name, comma) nsepseq par (* Function and procedure declarations *) and lambda_decl = - FunDecl of fun_decl reg -| ProcDecl of proc_decl reg + FunDecl of fun_decl reg +| ProcDecl of proc_decl reg +| EntryDecl of entry_decl reg and fun_decl = { kwd_function : kwd_function; @@ -219,6 +211,16 @@ and proc_decl = { terminator : semi option } +and entry_decl = { + kwd_entrypoint : kwd_entrypoint; + name : variable; + param : parameters; + kwd_is : kwd_is; + local_decls : local_decl list; + block : block reg; + terminator : semi option +} + and parameters = (param_decl, semi) nsepseq par and param_decl = diff --git a/AST2.ml b/AST2.ml index 727136beb..76d32c547 100644 --- a/AST2.ml +++ b/AST2.ml @@ -13,7 +13,6 @@ module O = struct type var_name = string type ast = { types : type_decl list; - parameter : typed_var; storage : typed_var; operations : typed_var; declarations : decl list; @@ -152,10 +151,6 @@ let s_type_decl I.{value={kwd_type;name;kwd_is;type_expr;terminator}; region} : let () = ignore (kwd_type,kwd_is,terminator,region) in O.{ name = s_name name; ty = s_type_expr type_expr } -let s_parameter_decl I.{value={kwd_parameter;name;colon;param_type;terminator};region} : O.typed_var = - let () = ignore (kwd_parameter,colon,terminator,region) in - O.{ name = s_name name; ty = s_type_expr param_type } - let s_storage_decl I.{value={kwd_storage; store_type; terminator}; region} : O.typed_var = let () = ignore (kwd_storage,terminator,region) in O.{ name = "storage"; ty = s_type_expr store_type } @@ -348,11 +343,10 @@ let s_main_block (block: I.block reg) : O.decl = } let s_ast (ast : I.ast) : O.ast = - let I.{types;constants;parameter;storage;operations;lambdas;block;eof} = ast in + let I.{types;constants;storage;operations;lambdas;block;eof} = ast in let () = ignore (eof) in O.{ types = map s_type_decl types; - parameter = s_parameter_decl parameter; storage = s_storage_decl storage; operations = s_operations_decl operations; declarations = List.flatten [(map s_const_decl constants); diff --git a/EvalOpt.ml b/EvalOpt.ml index 8407efc39..13c9f51ad 100644 --- a/EvalOpt.ml +++ b/EvalOpt.ml @@ -20,7 +20,7 @@ let help () = print_endline " -q, --quiet No output, except errors (default)"; print_endline " --columns Columns for source locations"; print_endline " --bytes Bytes for source locations"; - print_endline " --verbose= cmdline, parser"; + print_endline " --verbose= cmdline, ast"; print_endline " --version Commit hash on stdout"; print_endline " -h, --help This help"; exit 0 diff --git a/LexToken.mli b/LexToken.mli index 5bb8335e4..ead4f230a 100644 --- a/LexToken.mli +++ b/LexToken.mli @@ -74,9 +74,9 @@ type t = | If of Region.t (* "if" *) | In of Region.t (* "in" *) | Is of Region.t (* "is" *) +| Entrypoint of Region.t (* "entrypoint" *) | For of Region.t (* "for" *) | Function of Region.t (* "function" *) -| Parameter of Region.t (* "parameter" *) | Storage of Region.t (* "storage" *) | Type of Region.t (* "type" *) | Of of Region.t (* "of" *) diff --git a/LexToken.mll b/LexToken.mll index 82fecf27d..3ad835f34 100644 --- a/LexToken.mll +++ b/LexToken.mll @@ -73,9 +73,9 @@ type t = | If of Region.t | In of Region.t | Is of Region.t +| Entrypoint of Region.t | For of Region.t | Function of Region.t -| Parameter of Region.t | Storage of Region.t | Type of Region.t | Of of Region.t @@ -192,9 +192,9 @@ let proj_token = function | If region -> region, "If" | In region -> region, "In" | Is region -> region, "Is" +| Entrypoint region -> region, "Entrypoint" | For region -> region, "For" | Function region -> region, "Function" -| Parameter region -> region, "Parameter" | Storage region -> region, "Storage" | Type region -> region, "Type" | Of region -> region, "Of" @@ -276,9 +276,9 @@ let to_lexeme = function | If _ -> "if" | In _ -> "in" | Is _ -> "is" +| Entrypoint _ -> "entrypoint" | For _ -> "for" | Function _ -> "function" -| Parameter _ -> "parameter" | Storage _ -> "storage" | Type _ -> "type" | Of _ -> "of" @@ -328,9 +328,9 @@ let keywords = [ (fun reg -> If reg); (fun reg -> In reg); (fun reg -> Is reg); + (fun reg -> Entrypoint reg); (fun reg -> For reg); (fun reg -> Function reg); - (fun reg -> Parameter reg); (fun reg -> Storage reg); (fun reg -> Type reg); (fun reg -> Of reg); @@ -552,9 +552,9 @@ let is_kwd = function | If _ | In _ | Is _ +| Entrypoint _ | For _ | Function _ -| Parameter _ | Storage _ | Type _ | Of _ diff --git a/ParToken.mly b/ParToken.mly index 87c2ffc59..b883d51e1 100644 --- a/ParToken.mly +++ b/ParToken.mly @@ -51,9 +51,9 @@ %token If (* "if" *) %token In (* "in" *) %token Is (* "is" *) +%token Entrypoint (* "entrypoint" *) %token For (* "for" *) %token Function (* "function" *) -%token Parameter (* "parameter" *) %token Storage (* "storage" *) %token Type (* "type" *) %token Of (* "of" *) diff --git a/Parser.mly b/Parser.mly index d3aca6dcc..52cb622fc 100644 --- a/Parser.mly +++ b/Parser.mly @@ -91,7 +91,6 @@ sepseq(X,Sep): program: seq(type_decl) seq(const_decl) - parameter_decl storage_decl operations_decl seq(lambda_decl) @@ -100,31 +99,14 @@ program: { types = $1; constants = $2; - parameter = $3; - storage = $4; - operations = $5; - lambdas = $6; - block = $7; - eof = $8; + storage = $3; + operations = $4; + lambdas = $5; + block = $6; + eof = $7; } } -parameter_decl: - Parameter var COLON type_expr option(SEMI) { - let stop = - match $5 with - 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 type_expr option(SEMI) { let stop = @@ -227,8 +209,9 @@ field_decl: (* Function and procedure declarations *) lambda_decl: - fun_decl { FunDecl $1 } -| proc_decl { ProcDecl $1 } + fun_decl { FunDecl $1 } +| proc_decl { ProcDecl $1 } +| entry_decl { EntryDecl $1 } fun_decl: Function fun_name parameters COLON type_expr Is @@ -276,6 +259,27 @@ proc_decl: in {region; value} } +entry_decl: + Entrypoint fun_name parameters Is + seq(local_decl) + block option(SEMI) + { + let stop = + match $7 with + None -> $6.region + | Some region -> region in + let region = cover $1 stop in + let value = { + kwd_entrypoint = $1; + name = $2; + param = $3; + kwd_is = $4; + local_decls = $5; + block = $6; + terminator = $7} + in {region; value} + } + parameters: par(nsepseq(param_decl,SEMI)) { $1 } diff --git a/ParserMain.ml b/ParserMain.ml index 682e0e274..917a56517 100644 --- a/ParserMain.ml +++ b/ParserMain.ml @@ -57,7 +57,7 @@ let tokeniser = read ~log let () = try let ast = Parser.program tokeniser buffer in - if Utils.String.Set.mem "parser" EvalOpt.verbose + if Utils.String.Set.mem "ast" EvalOpt.verbose then AST.print_tokens ast with Lexer.Error err -> diff --git a/Tests/a.li b/Tests/a.li index c3416f195..d7738af3f 100644 --- a/Tests/a.li +++ b/Tests/a.li @@ -24,5 +24,5 @@ entrypoint g (const l : list (int)) is begin g (Unit); - fail K "in extremis" + fail "in extremis" end