In the process of optimising immediate applications as let-in [Broken].
This commit is contained in:
parent
e0fcfee2a3
commit
90a9e1a783
@ -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 {@; @[<v>%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
|
||||
|
@ -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 ;
|
||||
}
|
||||
|
@ -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 ;
|
||||
}
|
||||
|
@ -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 ->
|
||||
|
@ -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}}
|
||||
)
|
||||
|
@ -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'])
|
||||
|
Loading…
Reference in New Issue
Block a user