From 90a9e1a783496dc5a06a7996ecaa1a73994439a9 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 16 May 2019 18:17:27 +0200 Subject: [PATCH] In the process of optimising immediate applications as let-in [Broken]. --- src/ast_simplified/PP.ml | 2 +- src/ast_simplified/combinators.ml | 4 ++-- src/ast_simplified/types.ml | 4 ++-- src/simplify/camligo.ml | 9 +++++---- src/simplify/pascaligo.ml | 6 ++++-- src/transpiler/transpiler.ml | 8 ++++++++ 6 files changed, 22 insertions(+), 11 deletions(-) diff --git a/src/ast_simplified/PP.ml b/src/ast_simplified/PP.ml index 6eed2f798..cd7f81d61 100644 --- a/src/ast_simplified/PP.ml +++ b/src/ast_simplified/PP.ml @@ -44,7 +44,7 @@ let rec expression ppf (e:expression) = match e with | E_look_up (ds, ind) -> fprintf ppf "(%a)[%a]" annotated_expression ds annotated_expression ind | E_lambda {binder;input_type;output_type;result;body} -> fprintf ppf "lambda (%s:%a) : %a {@; @[%a@]@;} return %a" - binder type_expression input_type type_expression output_type + binder type_annotation input_type type_annotation output_type block body annotated_expression result | E_matching (ae, m) -> fprintf ppf "match %a with %a" annotated_expression ae (matching annotated_expression) m diff --git a/src/ast_simplified/combinators.ml b/src/ast_simplified/combinators.ml index 6744722a6..c17b457c9 100644 --- a/src/ast_simplified/combinators.ml +++ b/src/ast_simplified/combinators.ml @@ -137,8 +137,8 @@ let e_lambda (binder : string) : expression = E_lambda { binder = (make_name binder) ; - input_type = input_type ; - output_type = output_type ; + input_type = Some input_type ; + output_type = Some output_type ; result = (make_e_a result) ; body ; } diff --git a/src/ast_simplified/types.ml b/src/ast_simplified/types.ml index 583a13100..e09d12e59 100644 --- a/src/ast_simplified/types.ml +++ b/src/ast_simplified/types.ml @@ -47,8 +47,8 @@ and type_expression = and lambda = { binder: name ; - input_type: type_expression ; - output_type: type_expression ; + input_type: type_expression option; + output_type: type_expression option; result: ae ; body: block ; } diff --git a/src/simplify/camligo.ml b/src/simplify/camligo.ml index 2b15bfe89..bba10ebc1 100644 --- a/src/simplify/camligo.ml +++ b/src/simplify/camligo.ml @@ -456,16 +456,17 @@ let let_entry : _ -> _ result = fun l -> List.mapi aux [ (param_name , param_ty) ; ((unwrap storage_name) , storage_ty)] in let%bind (body' , result) = expression_last_instruction (unwrap e) in + let input_type' = input_nty.type_expression in + let output_type' = O.(t_pair (t_list t_operation , storage_ty)) in let lambda = - let output_type = O.(t_pair (t_list t_operation , storage_ty)) in O.{ binder = input_nty.type_name ; - input_type = input_nty.type_expression ; - output_type ; + input_type = Some input_type'; + output_type = Some output_type'; result ; body = tpl_declarations @ body' ; } in - let type_annotation = Some (O.T_function (lambda.input_type , lambda.output_type)) in + let type_annotation = Some (O.T_function (input_type', output_type')) in ok @@ O.Declaration_constant {name = (unwrap n) ; annotated_expression = {expression = O.E_lambda lambda ; type_annotation}} let let_init_storage : _ -> _ result = fun l -> diff --git a/src/simplify/pascaligo.ml b/src/simplify/pascaligo.ml index 87944d47e..f8eb95cfa 100644 --- a/src/simplify/pascaligo.ml +++ b/src/simplify/pascaligo.ml @@ -345,7 +345,8 @@ and simpl_fun_declaration : Raw.fun_decl -> named_expression result = fun x -> let%bind result = simpl_expression return in let%bind output_type = simpl_type_expression ret_type in let body = local_declarations @ instructions in - let expression = E_lambda {binder ; input_type ; output_type ; result ; body } in + let expression = E_lambda {binder ; input_type = Some input_type; + output_type = Some output_type; result ; body } in let type_annotation = Some (T_function (input_type, output_type)) in ok {name;annotated_expression = {expression;type_annotation}} ) @@ -384,7 +385,8 @@ and simpl_fun_declaration : Raw.fun_decl -> named_expression result = fun x -> let body = tpl_declarations @ local_declarations @ instructions in let%bind result = simpl_expression return in - let expression = E_lambda {binder ; input_type ; output_type ; result ; body } in + let expression = E_lambda {binder ; input_type = Some input_type; + output_type = Some output_type; result ; body } in let type_annotation = Some (T_function (input_type, output_type)) in ok {name = name.value;annotated_expression = {expression;type_annotation}} ) diff --git a/src/transpiler/transpiler.ml b/src/transpiler/transpiler.ml index 96192c01b..e497008bd 100644 --- a/src/transpiler/transpiler.ml +++ b/src/transpiler/transpiler.ml @@ -235,6 +235,14 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express ok @@ Combinators.Expression.make_tpl (expr, tv) in let f = translate_annotated_expression env in match ae.expression with + (* Optimise immediate application as a let-in *) + | E_application ({expression = E_lambda {binder; input_type; output_type=_; body=[]; result}; _}, + rhs) -> + let%bind ty' = translate_type input_type in + let%bind rhs' = translate_annotated_expression env rhs in + let result_env = Environment.(add (binder, ty') env) in + let%bind result' = translate_annotated_expression result_env result in + return (E_let_in ((binder, ty'), rhs', result')) | E_failwith ae -> ( let%bind ae' = translate_annotated_expression env ae in return @@ E_constant ("FAILWITH" , [ae'])