Single argument for lambdas
This commit is contained in:
Georges Dupéron
parent
8a11fc71eb
commit
332f18bb80
73
AST2.ml
73
AST2.ml
@ -43,7 +43,7 @@ module O = struct
|
||||
Sum of (type_name * type_expr) list
|
||||
| Record of record_key type_record
|
||||
| TypeApp of type_constructor * (type_expr list)
|
||||
| Function of { args: type_expr list; ret: type_expr }
|
||||
| Function of { arg: type_expr; ret: type_expr }
|
||||
| Ref of type_expr
|
||||
| String
|
||||
| Int
|
||||
@ -59,25 +59,28 @@ module O = struct
|
||||
|
||||
type expr =
|
||||
App of { operator: operator; arguments: expr list }
|
||||
| Var of var_name
|
||||
| Var of var_name
|
||||
| Constant of constant
|
||||
| Lambda of lambda
|
||||
|
||||
and decl = { name:var_name; ty:type_expr; value: expr }
|
||||
|
||||
and lambda = {
|
||||
parameters: type_expr SMap.t;
|
||||
parameter: typed_var;
|
||||
declarations: decl list;
|
||||
instructions: instr list;
|
||||
result: expr;
|
||||
}
|
||||
|
||||
and operator =
|
||||
Or | And | Lt | Leq | Gt | Geq | Equal | Neq | Cat | Cons | Add | Sub | Mult | Div | Mod
|
||||
Function of var_name
|
||||
| Construcor of var_name
|
||||
| UpdateField of record_key
|
||||
| GetField of record_key
|
||||
| Or | And | Lt | Leq | Gt | Geq | Equal | Neq | Cat | Cons | Add | Sub | Mult | Div | Mod
|
||||
| Neg | Not
|
||||
| Tuple | Set | List
|
||||
| MapLookup
|
||||
| Function of var_name
|
||||
|
||||
and constant =
|
||||
Unit | Int of Z.t | String of string | Bytes of MBytes.t | False | True
|
||||
@ -227,6 +230,18 @@ let s_none {value=(l, (c_None, colon, type_expr), r); region} : O.expr =
|
||||
let () = ignore (l, c_None, colon, r, region) in
|
||||
Constant (CNone (s_type_expr type_expr))
|
||||
|
||||
let parameters_to_tuple (parameters : (string * O.type_expr) list) : O.type_expr =
|
||||
(* TODO: use records with named fields to have named arguments. *)
|
||||
let parameter_tuple = O.Record (mapi (fun i (_name,ty) -> `Component i, ty) parameters) in
|
||||
O.{ type_expr = parameter_tuple; name = None; orig = Region.ghost }
|
||||
and parameters_to_decls singleparam (parameters : (string * O.type_expr) list) : O.decl list =
|
||||
let f i (name,ty) =
|
||||
O.{ name = {name; orig=Region.ghost};
|
||||
ty = ty;
|
||||
value = App { operator = O.GetField (`Component i);
|
||||
arguments = [Var singleparam] } }
|
||||
in mapi f parameters
|
||||
|
||||
let rec bin l operator r = O.App { operator; arguments = [s_expr l; s_expr r] }
|
||||
and una operator v = O.App { operator; arguments = [s_expr v] }
|
||||
and s_expr : I.expr -> O.expr =
|
||||
@ -453,9 +468,13 @@ and s_constr_app {value=(constr, arguments); region} : O.expr =
|
||||
let () = ignore (region) in
|
||||
App { operator = Function (s_name constr); arguments = s_arguments arguments }
|
||||
|
||||
and s_arguments {value=(lpar, sequence, rpar); region} =
|
||||
and s_arguments {value=(lpar, sequence, rpar); region} : O.expr list =
|
||||
(* TODO: should return a tuple *)
|
||||
let () = ignore (lpar,rpar,region) in
|
||||
map s_expr (s_nsepseq sequence);
|
||||
match map s_expr (s_nsepseq sequence) with
|
||||
[] -> [Constant Unit]
|
||||
| [single_argument] -> [single_argument]
|
||||
| args -> [App { operator = Tuple; arguments = args }] ;
|
||||
|
||||
and s_fail ((kwd_fail, expr) : (I.kwd_fail * I.expr)) : O.instr =
|
||||
let () = ignore (kwd_fail) in
|
||||
@ -478,15 +497,27 @@ and s_block I.{value={opening;instr;terminator;close}; _} : O.instr list =
|
||||
let () = ignore (opening,terminator,close) in
|
||||
s_instructions instr
|
||||
|
||||
and gensym =
|
||||
let i = ref 0 in
|
||||
fun ty ->
|
||||
i := !i + 1;
|
||||
(* TODO: Region.ghost *)
|
||||
({name = {name=(string_of_int !i) ^ "gensym"; orig = Region.ghost}; ty} : O.typed_var)
|
||||
|
||||
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 =
|
||||
let () = ignore (kwd_function,colon,kwd_is,kwd_with,terminator,region) in
|
||||
let tuple_type = s_parameters param |> parameters_to_tuple in
|
||||
let single_argument = gensym tuple_type in
|
||||
let ({name = single_argument_xxx; ty = _} : O.typed_var) = single_argument in
|
||||
O.{
|
||||
name = s_name name;
|
||||
ty = type_expr region (Function { args = map snd (s_parameters param);
|
||||
ty = type_expr region (Function { arg = tuple_type;
|
||||
ret = s_type_expr ret_type });
|
||||
value = Lambda {
|
||||
parameters = s_parameters param |> list_to_map;
|
||||
declarations = map s_local_decl local_decls;
|
||||
parameter = single_argument;
|
||||
declarations = append
|
||||
(s_parameters param |> parameters_to_decls single_argument_xxx)
|
||||
(map s_local_decl local_decls);
|
||||
instructions = s_block block;
|
||||
result = s_expr return
|
||||
}
|
||||
@ -494,13 +525,18 @@ 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} =
|
||||
let () = ignore (kwd_procedure,kwd_is,terminator,region) in
|
||||
let tuple_type = s_parameters param |> parameters_to_tuple in
|
||||
let single_argument = gensym tuple_type in
|
||||
let ({name = single_argument_xxx; ty = _} : O.typed_var) = single_argument in
|
||||
O.{
|
||||
name = s_name name;
|
||||
ty = type_expr region (Function { args = map snd (s_parameters param);
|
||||
ty = type_expr region (Function { arg = tuple_type;
|
||||
ret = type_expr region Unit });
|
||||
value = Lambda {
|
||||
parameters = s_parameters param |> list_to_map;
|
||||
declarations = map s_local_decl local_decls;
|
||||
parameter = single_argument;
|
||||
declarations = append
|
||||
(s_parameters param |> parameters_to_decls single_argument_xxx)
|
||||
(map s_local_decl local_decls);
|
||||
instructions = s_block block;
|
||||
result = O.Constant O.Unit
|
||||
}
|
||||
@ -508,13 +544,18 @@ and s_proc_decl I.{value={kwd_procedure;name;param;kwd_is;local_decls;block;term
|
||||
|
||||
and s_entry_decl I.{value={kwd_entrypoint;name;param;kwd_is;local_decls;block;terminator}; region} =
|
||||
let () = ignore (kwd_entrypoint,kwd_is,terminator,region) in
|
||||
let tuple_type = s_parameters param |> parameters_to_tuple in
|
||||
let single_argument = gensym tuple_type in
|
||||
let ({name = single_argument_xxx; ty = _} : O.typed_var) = single_argument in
|
||||
O.{
|
||||
name = s_name name;
|
||||
ty = type_expr region (Function { args = map snd (s_parameters param);
|
||||
ty = type_expr region (Function { arg = tuple_type;
|
||||
ret = type_expr region Unit });
|
||||
value = Lambda {
|
||||
parameters = s_parameters param |> list_to_map;
|
||||
declarations = map s_local_decl local_decls;
|
||||
parameter = single_argument;
|
||||
declarations = append
|
||||
(s_parameters param |> parameters_to_decls single_argument_xxx)
|
||||
(map s_local_decl local_decls);
|
||||
instructions = s_block block;
|
||||
result = O.Constant O.Unit
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user