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