Index: camlp4/Camlp4/Struct/Grammar/Delete.ml
===================================================================
--- camlp4/Camlp4/Struct/Grammar/Delete.ml	(revision 14037)
+++ camlp4/Camlp4/Struct/Grammar/Delete.ml	(working copy)
@@ -35,17 +35,17 @@
   open Structure;
 
 value raise_rule_not_found entry symbols =
-  let to_string f x =
+  let to_string : !'a. (_ -> 'a -> _) -> 'a -> _ = fun [f -> fun [x ->
     let buff = Buffer.create 128 in
     let ppf = Format.formatter_of_buffer buff in
     do {
       f ppf x;
       Format.pp_print_flush ppf ();
       Buffer.contents buff
-    } in
-    let entry = to_string Print.entry entry in
-    let symbols = to_string Print.print_rule symbols in
-    raise (Rule_not_found (symbols, entry))
+    }]] in
+  let entry = to_string Print.entry entry in
+  let symbols = to_string Print.print_rule symbols in
+  raise (Rule_not_found (symbols, entry))
 ;
 
 (* Deleting a rule *)
Index: camlp4/boot/Camlp4.ml
===================================================================
--- camlp4/boot/Camlp4.ml	(revision 14037)
+++ camlp4/boot/Camlp4.ml	(working copy)
@@ -18022,7 +18022,7 @@
                 open Structure
                   
                 let raise_rule_not_found entry symbols =
-                  let to_string f x =
+                  let to_string : 'a. (_ -> 'a -> _) -> 'a -> _ = fun f x ->
                     let buff = Buffer.create 128 in
                     let ppf = Format.formatter_of_buffer buff
                     in
Index: camlp4/Camlp4Filters/Camlp4FoldGenerator.ml
===================================================================
--- camlp4/Camlp4Filters/Camlp4FoldGenerator.ml	(revision 14037)
+++ camlp4/Camlp4Filters/Camlp4FoldGenerator.ml	(working copy)
@@ -547,14 +547,18 @@
 
   value processor =
     let last = ref <:ctyp<>> in
-    let generate_class' generator default c s n =
+    let generate_class'
+      : !'a 'b. (_ -> 'a -> _ -> _ -> 'b) -> 'b -> 'a -> _ -> _ -> 'b =
+      fun generator default c s n ->
       match s with
       [ "Fold"    -> generator Fold c last.val n
       | "Map"     -> generator Map c last.val n
       | "FoldMap" -> generator Fold_map c last.val n
       | _ -> default ]
     in
-    let generate_class_from_module_name generator c default m =
+    let generate_class_from_module_name
+      : !'a 'b. (_ -> 'a -> _ -> _ -> 'b) -> 'a -> 'b -> _ -> 'b =
+      fun generator c default m ->
       try Scanf.sscanf m "Camlp4%[^G]Generator" begin fun m' ->
         try Scanf.sscanf m' "%[^0-9]%d" (generate_class' generator default c)
         with [ End_of_file | Scanf.Scan_failure _ -> generate_class' generator default c m' 1 ]
Index: stdlib/arg.ml
===================================================================
--- stdlib/arg.ml	(revision 14037)
+++ stdlib/arg.ml	(working copy)
@@ -106,7 +106,7 @@
   let l = Array.length argv in
   let b = Buffer.create 200 in
   let initpos = !current in
-  let stop error =
+  let stop : 'a. _ -> 'a = fun error ->
     let progname = if initpos < l then argv.(initpos) else "(?)" in
     begin match error with
       | Unknown "-help" -> ()
Index: stdlib/printf.ml
===================================================================
--- stdlib/printf.ml	(revision 14037)
+++ stdlib/printf.ml	(working copy)
@@ -492,7 +492,7 @@
    Don't do this at home, kids. *)
 let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
 
-  let get_arg spec n =
+  let get_arg : 'a. _ -> _ -> 'a = fun spec n ->
     Obj.magic (args.(Sformat.int_of_index (get_index spec n))) in
 
   let rec scan_positional n widths i =
Index: stdlib/camlinternalOO.ml
===================================================================
--- stdlib/camlinternalOO.ml	(revision 14037)
+++ stdlib/camlinternalOO.ml	(working copy)
@@ -349,7 +349,7 @@
   init_table.env_init <- env_init
 
 let dummy_class loc =
-  let undef = fun _ -> raise (Undefined_recursive_module loc) in
+  let undef : 'a 'b.'a -> 'b = fun _ -> raise (Undefined_recursive_module loc) in
   (Obj.magic undef, undef, undef, Obj.repr 0)
 
 (**** Objects ****)
@@ -527,7 +527,7 @@
   | Closure of closure
 
 let method_impl table i arr =
-  let next () = incr i; magic arr.(!i) in
+  let next : 'a. unit -> 'a = fun () -> incr i; magic arr.(!i) in
   match next() with
     GetConst -> let x : t = next() in get_const x
   | GetVar   -> let n = next() in get_var n
Index: stdlib/scanf.ml
===================================================================
--- stdlib/scanf.ml	(revision 14037)
+++ stdlib/scanf.ml	(working copy)
@@ -1324,10 +1324,11 @@
 
   let limr = Array.length rv - 1 in
 
-  let return v = Obj.magic v () in
-  let delay f x () = f x in
-  let stack f = delay (return f) in
-  let no_stack f _x = f in
+  let return : 'a 'b 'c. ('a -> 'b) -> 'c = fun v -> Obj.magic v () in
+  let delay : 'a 'b. ('a -> 'b) -> 'a -> unit -> 'b = fun f x () -> f x in
+  let stack : 'a 'b 'd 'e. ('a -> 'b) -> 'd -> unit -> 'e =
+    fun f -> delay (return f) in
+  let no_stack : 'a 'b. 'a -> 'b -> 'a = fun f _x -> f in
 
   let rec scan fmt =
 
@@ -1380,7 +1381,8 @@
       scan_conversion skip width_opt prec_opt ir f i
 
     and scan_conversion skip width_opt prec_opt ir f i =
-      let stack = if skip then no_stack else stack in
+      let stack : 'b 'd. (unit -> 'b) -> 'd -> unit -> 'b =
+        if skip then no_stack else stack in
       let width = int_of_width_opt width_opt in
       let prec = int_of_prec_opt prec_opt in
       match Sformat.get fmt i with
Index: typing/typemod.ml
===================================================================
--- typing/typemod.ml	(revision 14037)
+++ typing/typemod.ml	(working copy)
@@ -420,7 +420,7 @@
 
 (* let signature sg = List.map (fun item -> item.sig_type) sg *)
 
-let rec transl_modtype env smty =
+let rec transl_modtype env smty : Typedtree.module_type =
   let loc = smty.pmty_loc in
   match smty.pmty_desc with
     Pmty_ident lid ->
@@ -609,7 +609,7 @@
     List.fold_left
       (fun env (id, _, mty) -> Env.add_module id mty.mty_type env)
       env curr in
-  let transition env_c curr =
+  let transition : 'a. _ -> (_ * _ * 'a) list -> _ = fun env_c curr ->
     List.map2
       (fun (_,smty) (id,id_loc,mty) -> (id, id_loc, transl_modtype env_c smty))
       sdecls curr in
Index: typing/typecore.ml
===================================================================
--- typing/typecore.ml	(revision 14037)
+++ typing/typecore.ml	(working copy)
@@ -1373,9 +1373,9 @@
 
   let ty_arrow gty ty = newty (Tarrow ("", instance_def gty, ty, Cok)) in
 
-  let bad_conversion fmt i c =
+  let bad_conversion : 'a. string -> int -> char -> 'a = fun fmt i c ->
     raise (Error (loc, Env.empty, Bad_conversion (fmt, i, c))) in
-  let incomplete_format fmt =
+  let incomplete_format : 'a. string -> 'a = fun fmt ->
     raise (Error (loc, Env.empty, Incomplete_format fmt)) in
 
   let rec type_in_format fmt =
@@ -3238,7 +3238,7 @@
 
 (* Typing of let bindings *)
 
-and type_let ?(check = fun s -> Warnings.Unused_var s)
+and type_let ?(global=false) ?(check = fun s -> Warnings.Unused_var s)
              ?(check_strict = fun s -> Warnings.Unused_var_strict s)
     env rec_flag spat_sexp_list scope allow =
   begin_def();
@@ -3368,7 +3368,7 @@
         )
       pat_list
   in
-  let exp_list =
+  let exp_gen_list =
     List.map2
       (fun (spat, sexp) (pat, slot) ->
         let sexp =
@@ -3386,9 +3386,12 @@
             let exp = type_expect exp_env sexp ty' in
             end_def ();
             check_univars env true "definition" exp pat.pat_type vars;
-            {exp with exp_type = instance env exp.exp_type}
-        | _ -> type_expect exp_env sexp pat.pat_type)
+            {exp with exp_type = instance env exp.exp_type}, true
+        | _ ->
+            type_expect exp_env sexp pat.pat_type,
+            match sexp.pexp_desc with Pexp_ident _ -> true | _ -> false)
       spat_sexp_list pat_slot_list in
+  let exp_list, gen_list = List.split exp_gen_list in
   current_slot := None;
   if is_recursive && not !rec_needed
   && Warnings.is_active Warnings.Unused_rec_flag then
@@ -3399,10 +3402,12 @@
     pat_list exp_list;
   end_def();
   List.iter2
-    (fun pat exp ->
-       if not (is_nonexpansive exp) then
+    (fun pat (exp, gen) ->
+       if not (global || gen) then
+         iter_pattern (fun pat -> generalize_structure pat.pat_type) pat
+       else if not (is_nonexpansive exp) then
          iter_pattern (fun pat -> generalize_expansive env pat.pat_type) pat)
-    pat_list exp_list;
+    pat_list exp_gen_list;
   List.iter
     (fun pat -> iter_pattern (fun pat -> generalize pat.pat_type) pat)
     pat_list;
@@ -3413,7 +3418,7 @@
 let type_binding env rec_flag spat_sexp_list scope =
   Typetexp.reset_type_variables();
   let (pat_exp_list, new_env, unpacks) =
-    type_let
+    type_let ~global:true
       ~check:(fun s -> Warnings.Unused_value_declaration s)
       ~check_strict:(fun s -> Warnings.Unused_value_declaration s)
       env rec_flag spat_sexp_list scope false
Index: typing/includecore.ml
===================================================================
--- typing/includecore.ml	(revision 14037)
+++ typing/includecore.ml	(working copy)
@@ -123,7 +123,8 @@
   | Record_representation of bool
 
 let report_type_mismatch0 first second decl ppf err =
-  let pr fmt = Format.fprintf ppf fmt in
+  let pr : 'a. ('a, Format.formatter, unit) format -> 'a
+      = fun fmt -> Format.fprintf ppf fmt in
   match err with
     Arity -> pr "They have different arities"
   | Privacy -> pr "A private type would be revealed"
Index: ocamldoc/odoc_html.ml
===================================================================
--- ocamldoc/odoc_html.ml	(revision 14037)
+++ ocamldoc/odoc_html.ml	(working copy)
@@ -508,7 +508,7 @@
       bs b "</table>\n"
 
     method html_of_Index_list b =
-      let index_if_not_empty l url m =
+      let index_if_not_empty : 'a. 'a list -> _ = fun l url m ->
         match l with
           [] -> ()
         | _ -> bp b "<li><a href=\"%s\">%s</a></li>\n" url m
@@ -977,7 +977,7 @@
     (** A function to build the header of pages. *)
     method prepare_header module_list =
       let f b ?(nav=None) ?(comments=[]) t  =
-        let link_if_not_empty l m url =
+        let link_if_not_empty : 'a. 'a list -> _ = fun l m url ->
           match l with
             [] -> ()
           | _ ->
Index: bytecomp/translmod.ml
===================================================================
--- bytecomp/translmod.ml	(revision 14037)
+++ bytecomp/translmod.ml	(working copy)
@@ -773,7 +773,8 @@
   Lprim(Psetglobal target_name, [Lprim(Pmakeblock(0, Immutable), components)])
 
 let transl_store_package component_names target_name coercion =
-  let rec make_sequence fn pos arg =
+  let rec make_sequence : 'a. (int -> 'a -> _) -> int -> 'a list -> _ =
+    fun fn pos arg ->
     match arg with
       [] -> lambda_unit
     | hd :: tl -> Lsequence(fn pos hd, make_sequence fn (pos + 1) tl) in
Index: otherlibs/labltk/jpf/jpf_font.ml
===================================================================
--- otherlibs/labltk/jpf/jpf_font.ml	(revision 14037)
+++ otherlibs/labltk/jpf/jpf_font.ml	(working copy)
@@ -131,7 +131,7 @@
   }
 
 let string_of_pattern =
-  let pat f = function
+  let pat : 'a. ('a -> string) -> 'a option -> string = fun f -> function
       Some x -> f x
     | None -> "*"
   in
Index: otherlibs/labltk/browser/searchid.ml
===================================================================
--- otherlibs/labltk/browser/searchid.ml	(revision 14037)
+++ otherlibs/labltk/browser/searchid.ml	(working copy)
@@ -396,7 +396,7 @@
 let search_string_symbol text =
   if text = "" then [] else
   let lid = snd (longident_of_string text) [] in
-  let try_lookup f k =
+  let try_lookup : 'a. _ -> 'a -> (_ * 'a) list = fun f k ->
     try let _ = f lid Env.initial in [lid, k]
     with Not_found | Env.Error _ -> []
   in
Index: otherlibs/labltk/browser/setpath.ml
===================================================================
--- otherlibs/labltk/browser/setpath.ml	(revision 14037)
+++ otherlibs/labltk/browser/setpath.ml	(working copy)
@@ -117,12 +117,12 @@
   bind_space_toggle dirbox;
   bind_space_toggle pathbox;
 
-  let add_paths _ =
+  let add_paths : 'a. 'a -> unit = fun _ ->
     add_to_path pathbox ~base:!current_dir
       ~dirs:(List.map (Listbox.curselection dirbox)
               ~f:(fun x -> Listbox.get dirbox ~index:x));
     Listbox.selection_clear dirbox ~first:(`Num 0) ~last:`End
-  and remove_paths _ =
+  and remove_paths : 'a. 'a -> unit = fun _ ->
     remove_path pathbox
       ~dirs:(List.map (Listbox.curselection pathbox)
               ~f:(fun x -> Listbox.get pathbox ~index:x))
Index: otherlibs/labltk/browser/viewer.ml
===================================================================
--- otherlibs/labltk/browser/viewer.ml	(revision 14037)
+++ otherlibs/labltk/browser/viewer.ml	(working copy)
@@ -507,7 +507,8 @@
       if i < 3 then Listbox.delete box ~first:(`Num 0) ~last:`End
       else destroy fm
     done;
-    let rec firsts n = function [] -> []
+    let rec firsts : 'a. int -> 'a list -> 'a list = fun n -> function
+        [] -> []
       | a :: l -> if n > 0 then a :: firsts (pred n) l else [] in
     shown_paths <- firsts (n-1) shown_paths;
     boxes <- firsts (max 3 n) boxes
Index: otherlibs/labltk/frx/frx_req.ml
===================================================================
--- otherlibs/labltk/frx/frx_req.ml	(revision 14037)
+++ otherlibs/labltk/frx/frx_req.ml	(working copy)
@@ -40,7 +40,7 @@
   let e =
     Entry.create t [Relief Sunken; TextVariable memory; TextWidth len] in
 
-  let activate _ =
+  let activate : 'a. 'a -> unit = fun _ ->
     let v = Entry.get e in
      Grab.release t;                    (* because of wm *)
      destroy t;                         (* so action can call open_simple *)
@@ -77,7 +77,7 @@
 
   let waiting = Textvariable.create_temporary t in
 
-  let activate _ =
+  let activate : 'a. 'a -> unit = fun _ ->
      Grab.release t;                    (* because of wm *)
      destroy t;                         (* so action can call open_simple *)
      Textvariable.set waiting "1" in
@@ -125,7 +125,7 @@
     Listbox.insert lb End elements;
 
   (* activation: we have to break() because we destroy the requester *)
-  let activate _ =
+  let activate : 'a. 'a -> unit = fun _ ->
     let l = List.map (Listbox.get lb) (Listbox.curselection lb) in
     Grab.release t;
     destroy t;
Index: otherlibs/labltk/support/rawwidget.ml
===================================================================
--- otherlibs/labltk/support/rawwidget.ml	(revision 14037)
+++ otherlibs/labltk/support/rawwidget.ml	(working copy)
@@ -67,7 +67,7 @@
 (* This one is always created by opentk *)
 let default_toplevel =
   let wname = "." in
-  let w = Typed (wname, "toplevel") in
+  let w : 'a. 'a raw_widget = Typed (wname, "toplevel") in
     Hashtbl.add table wname w;
     w
 
@@ -145,7 +145,7 @@
           then "." ^ name
           else parentpath ^ "." ^ name
     in
-      let w = Typed(path,clas) in
+      let w :'a. 'a raw_widget = Typed(path,clas) in
         Hashtbl.add table path w;
         w
 
Index: ocamlbuild/rule.ml
===================================================================
--- ocamlbuild/rule.ml	(revision 14037)
+++ ocamlbuild/rule.ml	(working copy)
@@ -260,7 +260,8 @@
                      which is deprecated and ignored."
           name
   in
-  let res_add import xs xopt =
+  let res_add : 'b. ('a -> 'b) -> 'a list -> 'a option -> 'b list =
+    fun import xs xopt ->
     let init =
       match xopt with
       | None -> []
Index: ocamlbuild/main.ml
===================================================================
--- ocamlbuild/main.ml	(revision 14037)
+++ ocamlbuild/main.ml	(working copy)
@@ -50,7 +50,7 @@
 let show_documentation () =
   let rules = Rule.get_rules () in
   let flags = Flags.get_flags () in
-  let pp fmt = Log.raw_dprintf (-1) fmt in
+  let pp : 'a. ('a,_,_) format -> 'a = fun fmt -> Log.raw_dprintf (-1) fmt in
   List.iter begin fun rule ->
     pp "%a@\n@\n" (Rule.pretty_print Resource.print_pattern) rule
   end rules;