balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Single argument for lambdas

Browse Source
This commit is contained in:
Georges Dupéron 2019-03-14 16:15:42 +01:00
parent 8a11fc71eb
commit 332f18bb80
1 changed files with 57 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
AST2.ml
View File

@ -43,7 +43,7 @@ module O = struct
Sum of (type_name * type_expr) list Sum of (type_name * type_expr) list
| Record of record_key type_record | Record of record_key type_record
| TypeApp of type_constructor * (type_expr list) | 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 | Ref of type_expr
| String | String
| Int | Int
@ -59,25 +59,28 @@ module O = struct
type expr = type expr =
App of { operator: operator; arguments: expr list } App of { operator: operator; arguments: expr list }
| Var of var_name | Var of var_name
| Constant of constant | Constant of constant
| Lambda of lambda | Lambda of lambda
and decl = { name:var_name; ty:type_expr; value: expr } and decl = { name:var_name; ty:type_expr; value: expr }
and lambda = { and lambda = {
parameters: type_expr SMap.t; parameter: typed_var;
declarations: decl list; declarations: decl list;
instructions: instr list; instructions: instr list;
result: expr; result: expr;
} }
and operator = 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 | Neg | Not
| Tuple | Set | List | Tuple | Set | List
| MapLookup | MapLookup
| Function of var_name
and constant = and constant =
Unit | Int of Z.t | String of string | Bytes of MBytes.t | False | True 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 let () = ignore (l, c_None, colon, r, region) in
Constant (CNone (s_type_expr type_expr)) 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] } 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 una operator v = O.App { operator; arguments = [s_expr v] }
and s_expr : I.expr -> O.expr = 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 let () = ignore (region) in
App { operator = Function (s_name constr); arguments = s_arguments arguments } 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 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 = and s_fail ((kwd_fail, expr) : (I.kwd_fail * I.expr)) : O.instr =
let () = ignore (kwd_fail) in 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 let () = ignore (opening,terminator,close) in
s_instructions instr 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 = 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 () = 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.{ O.{
name = s_name name; 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 }); ret = s_type_expr ret_type });
value = Lambda { value = Lambda {
parameters = s_parameters param |> list_to_map; parameter = single_argument;
declarations = map s_local_decl local_decls; declarations = append
(s_parameters param |> parameters_to_decls single_argument_xxx)
(map s_local_decl local_decls);
instructions = s_block block; instructions = s_block block;
result = s_expr return 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} = 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 () = 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.{ O.{
name = s_name name; 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 }); ret = type_expr region Unit });
value = Lambda { value = Lambda {
parameters = s_parameters param |> list_to_map; parameter = single_argument;
declarations = map s_local_decl local_decls; declarations = append
(s_parameters param |> parameters_to_decls single_argument_xxx)
(map s_local_decl local_decls);
instructions = s_block block; instructions = s_block block;
result = O.Constant O.Unit 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} = 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 () = 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.{ O.{
name = s_name name; 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 }); ret = type_expr region Unit });
value = Lambda { value = Lambda {
parameters = s_parameters param |> list_to_map; parameter = single_argument;
declarations = map s_local_decl local_decls; declarations = append
(s_parameters param |> parameters_to_decls single_argument_xxx)
(map s_local_decl local_decls);
instructions = s_block block; instructions = s_block block;
result = O.Constant O.Unit result = O.Constant O.Unit
} }