I added entrypoints (and removed the parameter declaration).

I fixed the pretty-printing of strings.
This commit is contained in:
Christian Rinderknecht 2019-03-10 13:55:24 +01:00
parent 0b5932f986
commit 7dcad4779e
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
10 changed files with 116 additions and 111 deletions

73
AST.ml
View File

@ -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;
@ -210,6 +201,7 @@ and type_tuple = (type_name, comma) nsepseq par
and lambda_decl =
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 =
@ -508,6 +510,7 @@ let core_pattern_to_region = function
let local_decl_to_region = function
LocalLam FunDecl {region; _}
| LocalLam ProcDecl {region; _}
| LocalLam EntryDecl {region; _}
| LocalConst {region; _}
| LocalVar {region; _} -> region
@ -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;
@ -646,6 +641,7 @@ and print_type_tuple {value=node; _} =
and print_lambda_decl = function
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 "(";

52
AST.mli
View File

@ -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;
@ -194,6 +185,7 @@ and type_tuple = (type_name, comma) nsepseq par
and lambda_decl =
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 =

View File

@ -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);

View File

@ -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=<stages> cmdline, parser";
print_endline " --verbose=<stages> cmdline, ast";
print_endline " --version Commit hash on stdout";
print_endline " -h, --help This help";
exit 0

View File

@ -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" *)

View File

@ -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 _

View File

@ -51,9 +51,9 @@
%token <Region.t> If (* "if" *)
%token <Region.t> In (* "in" *)
%token <Region.t> Is (* "is" *)
%token <Region.t> Entrypoint (* "entrypoint" *)
%token <Region.t> For (* "for" *)
%token <Region.t> Function (* "function" *)
%token <Region.t> Parameter (* "parameter" *)
%token <Region.t> Storage (* "storage" *)
%token <Region.t> Type (* "type" *)
%token <Region.t> Of (* "of" *)

View File

@ -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 =
@ -229,6 +211,7 @@ field_decl:
lambda_decl:
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 }

View File

@ -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 ->

View File

@ -24,5 +24,5 @@ entrypoint g (const l : list (int)) is
begin
g (Unit);
fail K "in extremis"
fail "in extremis"
end