I removed the definition of procedures.
Note: This immediately removes some unsupported cases of the simplifier, pertaining to the definition of procedures.
This commit is contained in:
parent
1299ecac6b
commit
00016d09bb
@ -63,7 +63,6 @@ type kwd_not = Region.t
|
|||||||
type kwd_of = Region.t
|
type kwd_of = Region.t
|
||||||
type kwd_or = Region.t
|
type kwd_or = Region.t
|
||||||
type kwd_patch = Region.t
|
type kwd_patch = Region.t
|
||||||
type kwd_procedure = Region.t
|
|
||||||
type kwd_record = Region.t
|
type kwd_record = Region.t
|
||||||
type kwd_remove = Region.t
|
type kwd_remove = Region.t
|
||||||
type kwd_set = Region.t
|
type kwd_set = Region.t
|
||||||
@ -163,7 +162,7 @@ and ast = t
|
|||||||
and declaration =
|
and declaration =
|
||||||
TypeDecl of type_decl reg
|
TypeDecl of type_decl reg
|
||||||
| ConstDecl of const_decl reg
|
| ConstDecl of const_decl reg
|
||||||
| LambdaDecl of lambda_decl
|
| FunDecl of fun_decl reg
|
||||||
|
|
||||||
and const_decl = {
|
and const_decl = {
|
||||||
kwd_const : kwd_const;
|
kwd_const : kwd_const;
|
||||||
@ -211,10 +210,6 @@ and type_tuple = (type_expr, comma) nsepseq par reg
|
|||||||
|
|
||||||
(* Function and procedure declarations *)
|
(* Function and procedure declarations *)
|
||||||
|
|
||||||
and lambda_decl =
|
|
||||||
FunDecl of fun_decl reg
|
|
||||||
| ProcDecl of proc_decl reg
|
|
||||||
|
|
||||||
and fun_decl = {
|
and fun_decl = {
|
||||||
kwd_function : kwd_function;
|
kwd_function : kwd_function;
|
||||||
name : variable;
|
name : variable;
|
||||||
@ -229,16 +224,6 @@ and fun_decl = {
|
|||||||
terminator : semi option
|
terminator : semi option
|
||||||
}
|
}
|
||||||
|
|
||||||
and proc_decl = {
|
|
||||||
kwd_procedure : kwd_procedure;
|
|
||||||
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 reg
|
and parameters = (param_decl, semi) nsepseq par reg
|
||||||
|
|
||||||
and param_decl =
|
and param_decl =
|
||||||
@ -282,7 +267,6 @@ and statement =
|
|||||||
|
|
||||||
and local_decl =
|
and local_decl =
|
||||||
LocalFun of fun_decl reg
|
LocalFun of fun_decl reg
|
||||||
| LocalProc of proc_decl reg
|
|
||||||
| LocalData of data_decl
|
| LocalData of data_decl
|
||||||
|
|
||||||
and data_decl =
|
and data_decl =
|
||||||
@ -750,7 +734,6 @@ let pattern_to_region = function
|
|||||||
|
|
||||||
let local_decl_to_region = function
|
let local_decl_to_region = function
|
||||||
LocalFun {region; _}
|
LocalFun {region; _}
|
||||||
| LocalProc {region; _}
|
|
||||||
| LocalData LocalConst {region; _}
|
| LocalData LocalConst {region; _}
|
||||||
| LocalData LocalVar {region; _} -> region
|
| LocalData LocalVar {region; _} -> region
|
||||||
|
|
||||||
|
@ -47,7 +47,6 @@ type kwd_not = Region.t
|
|||||||
type kwd_of = Region.t
|
type kwd_of = Region.t
|
||||||
type kwd_or = Region.t
|
type kwd_or = Region.t
|
||||||
type kwd_patch = Region.t
|
type kwd_patch = Region.t
|
||||||
type kwd_procedure = Region.t
|
|
||||||
type kwd_record = Region.t
|
type kwd_record = Region.t
|
||||||
type kwd_remove = Region.t
|
type kwd_remove = Region.t
|
||||||
type kwd_set = Region.t
|
type kwd_set = Region.t
|
||||||
@ -154,7 +153,7 @@ and ast = t
|
|||||||
and declaration =
|
and declaration =
|
||||||
TypeDecl of type_decl reg
|
TypeDecl of type_decl reg
|
||||||
| ConstDecl of const_decl reg
|
| ConstDecl of const_decl reg
|
||||||
| LambdaDecl of lambda_decl
|
| FunDecl of fun_decl reg
|
||||||
|
|
||||||
and const_decl = {
|
and const_decl = {
|
||||||
kwd_const : kwd_const;
|
kwd_const : kwd_const;
|
||||||
@ -200,11 +199,7 @@ and field_decl = {
|
|||||||
|
|
||||||
and type_tuple = (type_expr, comma) nsepseq par reg
|
and type_tuple = (type_expr, comma) nsepseq par reg
|
||||||
|
|
||||||
(* Function and procedure declarations *)
|
(* Function declarations *)
|
||||||
|
|
||||||
and lambda_decl =
|
|
||||||
FunDecl of fun_decl reg
|
|
||||||
| ProcDecl of proc_decl reg
|
|
||||||
|
|
||||||
and fun_decl = {
|
and fun_decl = {
|
||||||
kwd_function : kwd_function;
|
kwd_function : kwd_function;
|
||||||
@ -220,16 +215,6 @@ and fun_decl = {
|
|||||||
terminator : semi option
|
terminator : semi option
|
||||||
}
|
}
|
||||||
|
|
||||||
and proc_decl = {
|
|
||||||
kwd_procedure : kwd_procedure;
|
|
||||||
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 reg
|
and parameters = (param_decl, semi) nsepseq par reg
|
||||||
|
|
||||||
and param_decl =
|
and param_decl =
|
||||||
@ -273,7 +258,6 @@ and statement =
|
|||||||
|
|
||||||
and local_decl =
|
and local_decl =
|
||||||
LocalFun of fun_decl reg
|
LocalFun of fun_decl reg
|
||||||
| LocalProc of proc_decl reg
|
|
||||||
| LocalData of data_decl
|
| LocalData of data_decl
|
||||||
|
|
||||||
and data_decl =
|
and data_decl =
|
||||||
|
@ -67,7 +67,6 @@
|
|||||||
%token <Region.t> Of (* "of" *)
|
%token <Region.t> Of (* "of" *)
|
||||||
%token <Region.t> Or (* "or" *)
|
%token <Region.t> Or (* "or" *)
|
||||||
%token <Region.t> Patch (* "patch" *)
|
%token <Region.t> Patch (* "patch" *)
|
||||||
%token <Region.t> Procedure (* "procedure" *)
|
|
||||||
%token <Region.t> Record (* "record" *)
|
%token <Region.t> Record (* "record" *)
|
||||||
%token <Region.t> Remove (* "remove" *)
|
%token <Region.t> Remove (* "remove" *)
|
||||||
%token <Region.t> Set (* "set" *)
|
%token <Region.t> Set (* "set" *)
|
||||||
|
@ -116,7 +116,7 @@ contract:
|
|||||||
declaration:
|
declaration:
|
||||||
type_decl { TypeDecl $1 }
|
type_decl { TypeDecl $1 }
|
||||||
| const_decl { ConstDecl $1 }
|
| const_decl { ConstDecl $1 }
|
||||||
| lambda_decl { LambdaDecl $1 }
|
| fun_decl { FunDecl $1 }
|
||||||
|
|
||||||
(* Type declarations *)
|
(* Type declarations *)
|
||||||
|
|
||||||
@ -239,11 +239,7 @@ field_decl:
|
|||||||
and value = {field_name = $1; colon = $2; field_type = $3}
|
and value = {field_name = $1; colon = $2; field_type = $3}
|
||||||
in {region; value} }
|
in {region; value} }
|
||||||
|
|
||||||
(* Function and procedure declarations *)
|
(* Function declarations *)
|
||||||
|
|
||||||
lambda_decl:
|
|
||||||
fun_decl { FunDecl $1 }
|
|
||||||
| proc_decl { ProcDecl $1 }
|
|
||||||
|
|
||||||
fun_decl:
|
fun_decl:
|
||||||
Function fun_name parameters COLON type_expr Is
|
Function fun_name parameters COLON type_expr Is
|
||||||
@ -269,26 +265,6 @@ fun_decl:
|
|||||||
terminator = $11}
|
terminator = $11}
|
||||||
in {region; value}}
|
in {region; value}}
|
||||||
|
|
||||||
proc_decl:
|
|
||||||
Procedure fun_name parameters Is
|
|
||||||
seq(local_decl)
|
|
||||||
block option(SEMI)
|
|
||||||
{
|
|
||||||
let stop =
|
|
||||||
match $7 with
|
|
||||||
Some region -> region
|
|
||||||
| None -> $6.region in
|
|
||||||
let region = cover $1 stop
|
|
||||||
and value = {
|
|
||||||
kwd_procedure = $1;
|
|
||||||
name = $2;
|
|
||||||
param = $3;
|
|
||||||
kwd_is = $4;
|
|
||||||
local_decls = $5;
|
|
||||||
block = $6;
|
|
||||||
terminator = $7}
|
|
||||||
in {region; value}}
|
|
||||||
|
|
||||||
parameters:
|
parameters:
|
||||||
par(nsepseq(param_decl,SEMI)) { $1 }
|
par(nsepseq(param_decl,SEMI)) { $1 }
|
||||||
|
|
||||||
@ -375,7 +351,6 @@ open_var_decl:
|
|||||||
|
|
||||||
local_decl:
|
local_decl:
|
||||||
fun_decl { LocalFun $1 }
|
fun_decl { LocalFun $1 }
|
||||||
| proc_decl { LocalProc $1 }
|
|
||||||
| data_decl { LocalData $1 }
|
| data_decl { LocalData $1 }
|
||||||
|
|
||||||
data_decl:
|
data_decl:
|
||||||
|
@ -78,7 +78,7 @@ let rec print_tokens buffer ast =
|
|||||||
and print_decl buffer = function
|
and print_decl buffer = function
|
||||||
TypeDecl decl -> print_type_decl buffer decl
|
TypeDecl decl -> print_type_decl buffer decl
|
||||||
| ConstDecl decl -> print_const_decl buffer decl
|
| ConstDecl decl -> print_const_decl buffer decl
|
||||||
| LambdaDecl decl -> print_lambda_decl buffer decl
|
| FunDecl decl -> print_fun_decl buffer decl
|
||||||
|
|
||||||
and print_const_decl buffer {value; _} =
|
and print_const_decl buffer {value; _} =
|
||||||
let {kwd_const; name; colon; const_type;
|
let {kwd_const; name; colon; const_type;
|
||||||
@ -156,10 +156,6 @@ and print_type_tuple buffer {value; _} =
|
|||||||
print_nsepseq buffer "," print_type_expr inside;
|
print_nsepseq buffer "," print_type_expr inside;
|
||||||
print_token buffer rpar ")"
|
print_token buffer rpar ")"
|
||||||
|
|
||||||
and print_lambda_decl buffer = function
|
|
||||||
FunDecl fun_decl -> print_fun_decl buffer fun_decl
|
|
||||||
| ProcDecl proc_decl -> print_proc_decl buffer proc_decl
|
|
||||||
|
|
||||||
and print_fun_decl buffer {value; _} =
|
and print_fun_decl buffer {value; _} =
|
||||||
let {kwd_function; name; param; colon;
|
let {kwd_function; name; param; colon;
|
||||||
ret_type; kwd_is; local_decls;
|
ret_type; kwd_is; local_decls;
|
||||||
@ -176,17 +172,6 @@ and print_fun_decl buffer {value; _} =
|
|||||||
print_expr buffer return;
|
print_expr buffer return;
|
||||||
print_terminator buffer terminator
|
print_terminator buffer terminator
|
||||||
|
|
||||||
and print_proc_decl buffer {value; _} =
|
|
||||||
let {kwd_procedure; name; param; kwd_is;
|
|
||||||
local_decls; block; terminator} = value in
|
|
||||||
print_token buffer kwd_procedure "procedure";
|
|
||||||
print_var buffer name;
|
|
||||||
print_parameters buffer param;
|
|
||||||
print_token buffer kwd_is "is";
|
|
||||||
print_local_decls buffer local_decls;
|
|
||||||
print_block buffer block;
|
|
||||||
print_terminator buffer terminator
|
|
||||||
|
|
||||||
and print_parameters buffer {value; _} =
|
and print_parameters buffer {value; _} =
|
||||||
let {lpar; inside; rpar} = value in
|
let {lpar; inside; rpar} = value in
|
||||||
print_token buffer lpar "(";
|
print_token buffer lpar "(";
|
||||||
@ -234,7 +219,6 @@ and print_local_decls buffer sequence =
|
|||||||
|
|
||||||
and print_local_decl buffer = function
|
and print_local_decl buffer = function
|
||||||
LocalFun decl -> print_fun_decl buffer decl
|
LocalFun decl -> print_fun_decl buffer decl
|
||||||
| LocalProc decl -> print_proc_decl buffer decl
|
|
||||||
| LocalData decl -> print_data_decl buffer decl
|
| LocalData decl -> print_data_decl buffer decl
|
||||||
|
|
||||||
and print_data_decl buffer = function
|
and print_data_decl buffer = function
|
||||||
@ -773,9 +757,9 @@ and pp_declaration buffer ~pad:(_,pc as pad) = function
|
|||||||
| ConstDecl {value; _} ->
|
| ConstDecl {value; _} ->
|
||||||
pp_node buffer ~pad "ConstDecl";
|
pp_node buffer ~pad "ConstDecl";
|
||||||
pp_const_decl buffer ~pad:(mk_pad 1 0 pc) value
|
pp_const_decl buffer ~pad:(mk_pad 1 0 pc) value
|
||||||
| LambdaDecl lamb ->
|
| FunDecl {value; _} ->
|
||||||
pp_node buffer ~pad "LambdaDecl";
|
pp_node buffer ~pad "FunDecl";
|
||||||
pp_lambda_decl buffer ~pad:(mk_pad 1 0 pc) lamb
|
pp_fun_decl buffer ~pad:(mk_pad 1 0 pc) value
|
||||||
|
|
||||||
and pp_const_decl buffer ~pad:(_,pc) decl =
|
and pp_const_decl buffer ~pad:(_,pc) decl =
|
||||||
pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value;
|
pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value;
|
||||||
@ -841,14 +825,6 @@ and pp_type_tuple buffer ~pad:(_,pc) {value; _} =
|
|||||||
pp_type_expr buffer ~pad:(mk_pad len rank pc)
|
pp_type_expr buffer ~pad:(mk_pad len rank pc)
|
||||||
in List.iteri (List.length components |> apply) components
|
in List.iteri (List.length components |> apply) components
|
||||||
|
|
||||||
and pp_lambda_decl buffer ~pad = function
|
|
||||||
FunDecl {value; _} ->
|
|
||||||
pp_node buffer ~pad "FunDecl";
|
|
||||||
pp_fun_decl buffer ~pad value
|
|
||||||
| ProcDecl {value; _} ->
|
|
||||||
pp_node buffer ~pad "ProcDecl";
|
|
||||||
pp_proc_decl buffer ~pad value
|
|
||||||
|
|
||||||
and pp_fun_decl buffer ~pad:(_,pc) decl =
|
and pp_fun_decl buffer ~pad:(_,pc) decl =
|
||||||
let () =
|
let () =
|
||||||
let pad = mk_pad 6 0 pc in
|
let pad = mk_pad 6 0 pc in
|
||||||
@ -1256,9 +1232,6 @@ and pp_local_decl buffer ~pad:(_,pc as pad) = function
|
|||||||
LocalFun {value; _} ->
|
LocalFun {value; _} ->
|
||||||
pp_node buffer ~pad "LocalFun";
|
pp_node buffer ~pad "LocalFun";
|
||||||
pp_fun_decl buffer ~pad:(mk_pad 1 0 pc) value
|
pp_fun_decl buffer ~pad:(mk_pad 1 0 pc) value
|
||||||
| LocalProc {value; _} ->
|
|
||||||
pp_node buffer ~pad "LocalProc";
|
|
||||||
pp_proc_decl buffer ~pad:(mk_pad 1 0 pc) value
|
|
||||||
| LocalData data ->
|
| LocalData data ->
|
||||||
pp_node buffer ~pad "LocalData";
|
pp_node buffer ~pad "LocalData";
|
||||||
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data
|
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data
|
||||||
@ -1276,9 +1249,6 @@ and pp_var_decl buffer ~pad:(_,pc) decl =
|
|||||||
pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.var_type;
|
pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.var_type;
|
||||||
pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
|
pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
|
||||||
|
|
||||||
and pp_proc_decl buffer ~pad _decl =
|
|
||||||
pp_node buffer ~pad "PP_PROC_DECL"
|
|
||||||
|
|
||||||
and pp_expr buffer ~pad:(_,pc as pad) = function
|
and pp_expr buffer ~pad:(_,pc as pad) = function
|
||||||
ECase {value; _} ->
|
ECase {value; _} ->
|
||||||
pp_node buffer ~pad "ECase";
|
pp_node buffer ~pad "ECase";
|
||||||
|
@ -35,26 +35,6 @@ module Errors = struct
|
|||||||
] in
|
] in
|
||||||
error ~data title message
|
error ~data title message
|
||||||
|
|
||||||
let unsupported_proc_decl decl =
|
|
||||||
let title () = "procedure declarations" in
|
|
||||||
let message () =
|
|
||||||
Format.asprintf "procedures are not supported yet" in
|
|
||||||
let data = [
|
|
||||||
("declaration",
|
|
||||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ decl.Region.region)
|
|
||||||
] in
|
|
||||||
error ~data title message
|
|
||||||
|
|
||||||
let unsupported_local_proc region =
|
|
||||||
let title () = "local procedure declarations" in
|
|
||||||
let message () =
|
|
||||||
Format.asprintf "local procedures are not supported yet" in
|
|
||||||
let data = [
|
|
||||||
("declaration",
|
|
||||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
|
|
||||||
] in
|
|
||||||
error ~data title message
|
|
||||||
|
|
||||||
let corner_case ~loc message =
|
let corner_case ~loc message =
|
||||||
let title () = "corner case" in
|
let title () = "corner case" in
|
||||||
let content () = "We don't have a good error message for this case. \
|
let content () = "We don't have a good error message for this case. \
|
||||||
@ -88,16 +68,6 @@ module Errors = struct
|
|||||||
] in
|
] in
|
||||||
error ~data title message
|
error ~data title message
|
||||||
|
|
||||||
let unsupported_proc_calls call =
|
|
||||||
let title () = "procedure calls" in
|
|
||||||
let message () =
|
|
||||||
Format.asprintf "procedure calls are not supported yet" in
|
|
||||||
let data = [
|
|
||||||
("call_loc",
|
|
||||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ call.Region.region)
|
|
||||||
] in
|
|
||||||
error ~data title message
|
|
||||||
|
|
||||||
let unsupported_for_loops region =
|
let unsupported_for_loops region =
|
||||||
let title () = "bounded iterators" in
|
let title () = "bounded iterators" in
|
||||||
let message () =
|
let message () =
|
||||||
@ -550,8 +520,7 @@ and simpl_local_declaration : Raw.local_decl -> _ result = fun t ->
|
|||||||
let (f , loc) = r_split f in
|
let (f , loc) = r_split f in
|
||||||
let%bind (name , e) = simpl_fun_declaration ~loc f in
|
let%bind (name , e) = simpl_fun_declaration ~loc f in
|
||||||
return_let_in ~loc name e
|
return_let_in ~loc name e
|
||||||
| LocalProc d ->
|
|
||||||
fail @@ unsupported_local_proc d.Region.region
|
|
||||||
and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
|
and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
|
||||||
match t with
|
match t with
|
||||||
| LocalVar x ->
|
| LocalVar x ->
|
||||||
@ -659,13 +628,11 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap result =
|
|||||||
ok @@ Declaration_constant (name.value , type_annotation , expression)
|
ok @@ Declaration_constant (name.value , type_annotation , expression)
|
||||||
in
|
in
|
||||||
bind_map_location simpl_const_decl (Location.lift_region x)
|
bind_map_location simpl_const_decl (Location.lift_region x)
|
||||||
| LambdaDecl (FunDecl x) -> (
|
| FunDecl x -> (
|
||||||
let (x , loc) = r_split x in
|
let (x , loc) = r_split x in
|
||||||
let%bind ((name , ty_opt) , expr) = simpl_fun_declaration ~loc x in
|
let%bind ((name , ty_opt) , expr) = simpl_fun_declaration ~loc x in
|
||||||
ok @@ Location.wrap ~loc (Declaration_constant (name , ty_opt , expr))
|
ok @@ Location.wrap ~loc (Declaration_constant (name , ty_opt , expr))
|
||||||
)
|
)
|
||||||
| LambdaDecl (ProcDecl decl) ->
|
|
||||||
fail @@ unsupported_proc_decl decl
|
|
||||||
|
|
||||||
and simpl_statement : Raw.statement -> (_ -> expression result) result =
|
and simpl_statement : Raw.statement -> (_ -> expression result) result =
|
||||||
fun s ->
|
fun s ->
|
||||||
|
@ -6,14 +6,10 @@ open Ast_simplified
|
|||||||
module Raw = Parser.Pascaligo.AST
|
module Raw = Parser.Pascaligo.AST
|
||||||
module SMap = Map.String
|
module SMap = Map.String
|
||||||
|
|
||||||
module Errors : sig
|
module Errors :
|
||||||
|
sig
|
||||||
val bad_bytes : Location.t -> string -> unit -> error
|
val bad_bytes : Location.t -> string -> unit -> error
|
||||||
|
|
||||||
val unsupported_arith_op : Raw.expr -> unit -> error
|
val unsupported_arith_op : Raw.expr -> unit -> error
|
||||||
|
|
||||||
val unsupported_proc_calls : 'a Raw.reg -> unit -> error
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user