| Description | Partial applications like (f x) where f has arity greater than 3 are expensive, since every application will lead to a closure allocation for each intermediary argument. Moreover, such functions are not inlined anymore.
This patch fixes these two behaviors:
- in cmmgen.ml, caml_curry functions are modified so that they can be applied directly, when all the remaining arguments are provided. No allocation anymore for intermediate arguments.
- in closure.ml, partial applications are detected, and, when the true arity of the function is known, an eta-expansion is performed.
Problems:
- since approximations of arguments are lost during applications, the optimization is less interesting than with the patch I sent by email, but its complexity is unchanged (the "planck" parser of Jun could trigger an exponential complexity due to the recursive call to "close")
- approximations are not known for external functions when they are bigger than the inlining threshold, so the transformation cannot be triggered for them, although it would be interesting.
|
| Attached Files |  optimize-partial-applications-3.12.0.patch [^] (4,921 bytes) 2011-06-10 08:29 [Show Content] [Hide Content]diff -rw -C 2 ocaml-3.12.0/asmcomp/closure.ml ocaml-3.12.0+partial/asmcomp/closure.ml
*** ocaml-3.12.0/asmcomp/closure.ml 2008-08-01 14:52:14.000000000 +0200
--- ocaml-3.12.0+partial/asmcomp/closure.ml 2011-06-09 19:42:20.282517002 +0200
***************
*** 493,496 ****
--- 493,499 ----
| Lfunction(kind, params, body) as funct ->
close_one_function fenv cenv (Ident.create "fun") funct
+
+ (* we want to convert [f a] in [let a' = a in fun b c -> f a b c] when
+ fun_arity > nargs *)
| Lapply(funct, args, loc) ->
let nargs = List.length args in
***************
*** 505,508 ****
--- 508,536 ----
let app = direct_apply fundesc funct ufunct uargs in
(app, strengthen_approx app approx_res)
+
+ | ((ufunct, Value_closure(fundesc, approx_res)), uargs)
+ when nargs < fundesc.fun_arity ->
+ let first_args = List.map (fun arg ->
+ (Ident.create "arg", arg) ) uargs in
+ let final_args = Array.to_list (Array.init (fundesc.fun_arity - nargs) (fun _ ->
+ Ident.create "arg")) in
+ let rec iter args body =
+ match args with
+ [] -> body
+ | (arg1, arg2) :: args ->
+ iter args
+ (Ulet ( arg1, arg2, body))
+ in
+ let internal_args =
+ (List.map (fun (arg1, arg2) -> Lvar arg1) first_args)
+ @ (List.map (fun arg -> Lvar arg ) final_args)
+ in
+ let (new_fun, approx) = close fenv cenv
+ (Lfunction(
+ Curried, final_args, Lapply(funct, internal_args, loc)))
+ in
+ let new_fun = iter first_args new_fun in
+ (new_fun, approx)
+
| ((ufunct, Value_closure(fundesc, approx_res)), uargs)
when fundesc.fun_arity > 0 && nargs > fundesc.fun_arity ->
Only in ocaml-3.12.0+partial/asmcomp: closure.ml.orig
diff -rw -C 2 ocaml-3.12.0/asmcomp/cmmgen.ml ocaml-3.12.0+partial/asmcomp/cmmgen.ml
*** ocaml-3.12.0/asmcomp/cmmgen.ml 2010-05-19 13:29:38.000000000 +0200
--- ocaml-3.12.0+partial/asmcomp/cmmgen.ml 2011-06-09 19:41:52.222516999 +0200
***************
*** 1911,1919 ****
get_field (Cvar clos) 2 ::
args @ [Cvar last_arg; Cvar clos])
! else begin
let newclos = Ident.create "clos" in
Clet(newclos,
get_field (Cvar clos) 3,
curry_fun (get_field (Cvar clos) 2 :: args) newclos (n-1))
end in
Cfunction
--- 1911,1927 ----
get_field (Cvar clos) 2 ::
args @ [Cvar last_arg; Cvar clos])
! else
! if n = arity - 1 then
! begin
let newclos = Ident.create "clos" in
Clet(newclos,
get_field (Cvar clos) 3,
curry_fun (get_field (Cvar clos) 2 :: args) newclos (n-1))
+ end else
+ begin
+ let newclos = Ident.create "clos" in
+ Clet(newclos,
+ get_field (Cvar clos) 4,
+ curry_fun (get_field (Cvar clos) 3 :: args) newclos (n-1))
end in
Cfunction
***************
*** 1934,1943 ****
{fun_name = name2;
fun_args = [arg, typ_addr; clos, typ_addr];
! fun_body = Cop(Calloc,
[alloc_closure_header 4;
Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1));
int_const 1; Cvar arg; Cvar clos]);
fun_fast = true}
! :: intermediate_curry_functions arity (num+1)
end
--- 1942,1989 ----
{fun_name = name2;
fun_args = [arg, typ_addr; clos, typ_addr];
! fun_body =
! if arity - num > 2 then
! Cop(Calloc,
! [alloc_closure_header 5;
! Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1));
! int_const (arity - num - 1);
! Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1) ^ "_app");
! Cvar arg; Cvar clos])
! else
! Cop(Calloc,
[alloc_closure_header 4;
Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1));
int_const 1; Cvar arg; Cvar clos]);
fun_fast = true}
! ::
! (if arity - num > 2 then
! let rec iter i =
! if i <= arity then
! let arg = Ident.create (Printf.sprintf "arg%d" i) in
! (arg, typ_addr) :: iter (i+1)
! else []
! in
! let direct_args = iter (num+2) in
! let rec iter i args clos =
! if i = 0 then
! Cop(Capply(typ_addr, Debuginfo.none),
! (get_field (Cvar clos) 2) :: args @ [Cvar clos])
! else
! let newclos = Ident.create "clos" in
! Clet(newclos,
! get_field (Cvar clos) 4,
! iter (i-1) (get_field (Cvar clos) 3 :: args) newclos)
! in
! let cf =
! Cfunction
! {fun_name = name1 ^ "_" ^ string_of_int (num+1) ^ "_app";
! fun_args = direct_args @ [clos, typ_addr];
! fun_body = iter (num+1)
! (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
! fun_fast = true}
! in
! cf :: intermediate_curry_functions arity (num+1)
! else
! intermediate_curry_functions arity (num+1))
end
|
Relationships 
Relationships 