--- /usr/src/ocaml-4.00.1/typing/typecore.ml	2012-07-30 20:59:07.000000000 +0200
+++ typing/typecore.ml	2012-10-26 23:03:25.000000000 +0200
@@ -2417,7 +2417,7 @@
         match (expand_head env ty_fun).desc with
         | Tarrow (l,ty_arg,ty_fun,_) when is_optional l ->
             make_args
-              ((Some(option_none (instance env ty_arg) sarg.pexp_loc), Optional)
+              ((l, Some(option_none (instance env ty_arg) sarg.pexp_loc), Optional)
                :: args)
               ty_fun
         | Tarrow (l,_,ty_res',_) when l = "" || !Clflags.classic ->
@@ -2453,9 +2453,7 @@
         { texp with exp_type = ty_fun; exp_desc =
           Texp_function("", [eta_pat, {texp with exp_type = ty_res; exp_desc =
                     Texp_apply (texp,
-                      (List.map (fun (label, exp) ->
-                          ("", label, exp)) args)@
-                                               ["", Some eta_var, Required])}],
+                      args @ ["", Some eta_var, Required])}],
                         Total) } in
       if warn then Location.prerr_warning texp.exp_loc
           (Warnings.Without_principality "eliminated optional argument");

diff --git a/typing/typecore.ml b/typing/typecore.ml
index 848c8e6..0561de4 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -1476,14 +1476,43 @@ and type_argument env sarg ty_expected' =
   | _, {pexp_desc = Pexp_function(l,_,_)} when not (is_optional l) ->
       type_expect env sarg ty_expected
   | {desc = Tarrow("",ty_arg,ty_res,_); level = lv}, _ ->
-      (* apply optional arguments when expected type is "" *)
-      (* we must be very careful about not breaking the semantics *)
+      (* We are in the situation of typing the argument
+         of an application`f a`, with
+           f : (t -> u) -> v
+           a : ?l1:t1 -> ?l2:t2 -> ... -> ?ln:tn -> t -> u
+
+         In this situation, we will implicitly coerce the argument `a`
+         into the desired type `t -> u` by feeding the default 'None'
+         argument to its optional parameters.
+         
+         Note that functions with optional arguments must always have
+         a non-optinal argument after their optional argument, that's
+         how we now that, after ?l1..?ln, the type of a is still an
+         function type `t -> u`. (We allow to coerce only if f's
+         function argument expects no optional parameter at all, not
+         only less than `a` requests.)
+
+         `f (a ~l1:None ~l2:None ... ~ln:None)` would be type-correct,
+         but would not respect the semantics we expect: we want the
+         application of the default arguments to happen when `a` is
+         used as a function (passed an argument of type `t`). To
+         respect that semantics, we delay the application of the
+         default argument to whenever `a` is used as a function inside
+         `f`, by eta-expansion
+
+         f (let x = a in fun (y:t) -> x ~l1:None ... ~ln:None y)
+
+         (Note that the use of `let x = a in` preserves the evaluation
+         of `a` at the application site `f a`, instead of being delayed
+         and repeated by the eta-expansion closure.)
+      *)
       if !Clflags.principal then begin_def ();
       let texp = type_exp env sarg in
       if !Clflags.principal then begin
         end_def ();
         generalize_structure texp.exp_type
       end;
+      (* collect the optional labels ~l1 .. ~ln for application of None *)
       let rec make_args args ty_fun =
         match (expand_head env ty_fun).desc with
         | Tarrow (l,ty_arg,ty_fun,_) when is_optional l ->
@@ -1507,7 +1536,7 @@ and type_argument env sarg ty_expected' =
       end else begin
       unify_exp env {texp with exp_type = ty_fun} ty_expected;
       if args = [] then texp else
-      (* eta-expand to avoid side effects *)
+      (* eta-expand (delay application-time side effects) *)
       let var_pair name ty =
         let id = Ident.create name in
         {pat_desc = Tpat_var id; pat_type = ty;
@@ -1525,7 +1554,8 @@ and type_argument env sarg ty_expected' =
       if warn then Location.prerr_warning texp.exp_loc
           (Warnings.Without_principality "eliminated optional argument");
       if is_nonexpansive texp then func texp else
-      (* let-expand to have side effects *)
+      (* let-expand (avoid having side-effects of [texp] delayed by
+         eta-expanding) *)
       let let_pat, let_var = var_pair "let" texp.exp_type in
       re { texp with exp_type = ty_fun; exp_desc =
            Texp_let (Nonrecursive, [let_pat, texp], func let_var) }