Index: camlp4/Camlp4Filters/Camlp4FoldGenerator.ml
===================================================================
RCS file: /caml/ocaml/camlp4/Camlp4Filters/Camlp4FoldGenerator.ml,v
retrieving revision 1.2
diff -u -p -r1.2 Camlp4FoldGenerator.ml
--- camlp4/Camlp4Filters/Camlp4FoldGenerator.ml	8 Oct 2007 14:19:34 -0000	1.2
+++ camlp4/Camlp4Filters/Camlp4FoldGenerator.ml	29 Oct 2007 12:34:53 -0000
@@ -91,6 +91,7 @@ module Make (AstFilters : Camlp4.Sig.Ast
   value builtins =
     <:class_str_item<
       method string (_ : string) : 'self_type = o;
+      method char (_ : char) : 'self_type = o;
       method int (_ : int) : 'self_type = o;
       method float (_ : float) : 'self_type = o;
       method bool (_ : bool) : 'self_type = o;
@@ -110,6 +111,12 @@ module Make (AstFilters : Camlp4.Sig.Ast
     | <:ident< $i1$.$i2$ >> -> lid_of_ident sep i1 ^ sep ^ lid_of_ident sep i2
     | _ -> assert False ];
 
+  value rec tycon_of_tycon_expr =
+    fun
+    [ <:ctyp< $id:id$ >> -> id
+    | <:ctyp< $typ$ $_$ >> -> tycon_of_tycon_expr typ
+    | _ -> assert False ];
+
   type type_decl = (string * Ast.ident * list Ast.ctyp * Ast.ctyp);
 
   value (unknown_type, fold_unknown_types) =
@@ -199,7 +206,8 @@ module Make (AstFilters : Camlp4.Sig.Ast
          <:match_case< `$i$ x -> $expr_of_ty ~obj:<:expr< o >> (Some <:expr< x >>) t$ >>
     | <:ctyp< `$i$ >> ->
          <:match_case< `$i$ -> o >>
-    | _ -> assert False ]
+    | t ->
+          <:match_case< # $id:tycon_of_tycon_expr t $ as x -> $expr_of_ty None t$ x >> ]
 
   and record_patt_of_type =
     fun
@@ -248,7 +256,7 @@ module Make (AstFilters : Camlp4.Sig.Ast
       [ [] -> acc
       | [ x :: xs ] -> lambda <:expr< fun $lid:"_f_" ^ x$ -> $acc$ >> xs ] in
     let params' = List.map string_of_type_param params in
-    let funs = lambda (fun_of_ctyp id1 ctyp) params' in
+    let funs = lambda (fun_of_ctyp id1 ctyp) (List.rev params') in
     let ty = method_type_of_type_decl type_decl in
     <:class_str_item< method $lid:id1$ : $ty$ = $funs$ >>
 
@@ -256,11 +264,25 @@ module Make (AstFilters : Camlp4.Sig.Ast
     apply_ctyp <:ctyp< $id:name$ >> params
 
   and method_type_of_type_decl (_, name, params, _) =
-    let t = ctyp_name_of_name_params name [] (* FIXME params *) in
-    match List.length params with
-    [ 1 -> <:ctyp< ! 'a . ('self_type -> 'a -> 'self_type) -> $t$ 'a -> 'self_type >>
-    | 0 -> <:ctyp< $t$ -> 'self_type >>
-    | _ -> failwith "FIXME not implemented" ]
+      let (_, t, fns, tvars) = 
+        List.fold_right
+          (fun _ (n, t, fns, tvars) ->
+             let tvar = <:ctyp< '$"a" ^ string_of_int n$ >> in
+               (n+1,
+                <:ctyp< ($t$ $tvar$) >>,
+                [(<:ctyp< 'self_type -> $tvar$ -> 'self_type >>) :: fns],
+                [tvar :: tvars]))
+          params
+          (0, <:ctyp< $id:name$ >>, [], []) in
+        match tvars with
+        [ [] -> <:ctyp< $t$ -> 'self_type >>
+        | [x :: xs] -> 
+            let tvars = List.fold_left (fun x y -> <:ctyp< $x$ $y$ >>) x xs 
+            and unquantified = List.fold_left
+                                 (fun inner fn -> <:ctyp< $fn$ -> $inner$ >>)
+                                 (<:ctyp< $t$ -> 'self_type >>)
+                                 fns in
+              <:ctyp< ! $tvars$ . $unquantified$ >>]
 
   and class_sig_item_of_type_decl _ ((name, _, _, _) as type_decl) acc =
     <:class_sig_item<
Index: camlp4/Camlp4Filters/Camlp4MapGenerator.ml
===================================================================
RCS file: /caml/ocaml/camlp4/Camlp4Filters/Camlp4MapGenerator.ml,v
retrieving revision 1.2
diff -u -p -r1.2 Camlp4MapGenerator.ml
--- camlp4/Camlp4Filters/Camlp4MapGenerator.ml	8 Oct 2007 14:19:34 -0000	1.2
+++ camlp4/Camlp4Filters/Camlp4MapGenerator.ml	29 Oct 2007 12:34:53 -0000
@@ -89,6 +89,7 @@ module Make (AstFilters : Camlp4.Sig.Ast
   value builtins =
     <:class_str_item<
       method string x : string = x;
+      method char x : char = x;
       method int x : int = x;
       method float x : float = x;
       method bool x : bool = x;
@@ -106,6 +107,7 @@ module Make (AstFilters : Camlp4.Sig.Ast
   value builtins_sig =
     <:sig_item<
       value string : string -> string;
+      value char : char -> char;
       value int : int -> int;
       value float : float -> float;
       value bool : bool -> bool;
@@ -121,6 +123,12 @@ module Make (AstFilters : Camlp4.Sig.Ast
     | <:ident< $i1$.$i2$ >> -> lid_of_ident sep i1 ^ sep ^ lid_of_ident sep i2
     | _ -> assert False ];
 
+  value rec tycon_of_tycon_expr =
+    fun
+    [ <:ctyp< $id:id$ >> -> id
+    | <:ctyp< $typ$ $_$ >> -> tycon_of_tycon_expr typ
+    | _ -> assert False ];
+
   type type_decl = (string * Ast.ident * list Ast.ctyp * Ast.ctyp);
 
   value (unknown_type, fold_unknown_types) =
@@ -196,15 +204,18 @@ module Make (AstFilters : Camlp4.Sig.Ast
          <:match_case< $uid:s$ -> $uid:s$ >>
     | _ -> assert False ]
 
-  and match_case_of_poly_sum_type =
+  and match_case_of_poly_sum_type (id, params) =
     fun
     [ <:ctyp< $t1$ | $t2$ >> ->
-         <:match_case< $match_case_of_poly_sum_type t1$ | $match_case_of_poly_sum_type t2$ >>
+         <:match_case< $match_case_of_poly_sum_type (id, params) t1$ | $match_case_of_poly_sum_type (id, params) t2$ >>
     | <:ctyp< `$i$ of $t$ >> ->
          <:match_case< `$i$ x -> `$i$ $expr_of_ty (Some <:expr< x >>) t$ >>
     | <:ctyp< `$i$ >> ->
          <:match_case< `$i$ -> `$i$ >>
-    | _ -> assert False ]
+    | t ->
+        let tycon = tycon_of_tycon_expr t 
+        and uptype = apply_ctyp <:ctyp< $lid:id$ >> params in
+          <:match_case< # $id:tycon$ as x -> ($expr_of_ty None t$ x :> $uptype$) >> ]
 
   and record_patt_of_type =
     fun
@@ -222,7 +233,7 @@ module Make (AstFilters : Camlp4.Sig.Ast
          <:rec_binding< $record_binding_of_type t1$; $record_binding_of_type t2$ >>
     | _ -> assert False ]
 
-  and fun_of_ctyp tyid =
+  and fun_of_ctyp (tyid:string) params =
     fun
     [ <:ctyp< [ $t$ ] >> ->
         <:expr< fun [ $match_case_of_sum_type t$ ] >>
@@ -237,9 +248,9 @@ module Make (AstFilters : Camlp4.Sig.Ast
         if id1 = tyid then <:expr< fun x -> x >>
         else expr_of_ty None t
     | <:ctyp< [ = $t$ ] >> | <:ctyp< [ < $t$ ] >> | <:ctyp< private [ < $t$ ] >> ->
-        <:expr< fun [ $match_case_of_poly_sum_type t$ ] >>
+        <:expr< fun [ $match_case_of_poly_sum_type (tyid, params) t$ ] >>
     | <:ctyp< [ > $t$ ] >> | <:ctyp< private [ > $t$ ] >> ->
-        <:expr< fun [ $match_case_of_poly_sum_type t$ | x -> x ] >>
+        <:expr< fun [ $match_case_of_poly_sum_type (tyid, params) t$ | x -> x ] >>
     | _ -> assert False ]
 
   and string_of_type_param t =
@@ -253,19 +264,33 @@ module Make (AstFilters : Camlp4.Sig.Ast
       [ [] -> acc
       | [ x :: xs ] -> lambda <:expr< fun $lid:"_f_" ^ x$ -> $acc$ >> xs ] in
     let params' = List.map string_of_type_param params in
-    let funs = lambda (fun_of_ctyp id1 ctyp) params' in
+    let funs = lambda (fun_of_ctyp id1 params ctyp) (List.rev params') in
     let ty = method_type_of_type_decl type_decl in
     <:class_str_item< method $lid:id1$ : $ty$ = $funs$ >>
 
-  and ctyp_name_of_name_params name params = 
-    apply_ctyp <:ctyp< $id:name$ >> params
-
   and method_type_of_type_decl (_, name, params, _) =
-    let t = ctyp_name_of_name_params name [] (* FIXME params *) in
-    match List.length params with
-    [ 1 -> <:ctyp< ! 'a 'b . ('a -> 'b) -> $t$ 'a -> $t$ 'b >>
-    | 0 -> <:ctyp< $t$ -> $t$ >>
-    | _ -> failwith "FIXME not implemented" ]
+      let (_, intype, outtype, fns, tvars) = 
+        List.fold_right
+          (fun _ (n, tin, tout, fns, tvars) ->
+             let  invar = <:ctyp< '$"a" ^ string_of_int n$ >>
+             and outvar = <:ctyp< '$"b" ^ string_of_int n$ >> in
+               (n+1,
+                <:ctyp< ($tin$ $invar$) >>,
+                <:ctyp< ($tout$ $outvar$) >>,
+                [(<:ctyp< $invar$ -> $outvar$ >>) :: fns],
+                [outvar :: [invar :: tvars]]))
+          params
+          (0, <:ctyp< $id:name$ >>, <:ctyp< $id:name$ >>, [], []) in
+        match tvars with
+        [ [] -> <:ctyp< $intype$ -> $outtype$ >>
+        | [x :: xs] -> 
+            let tvars = List.fold_left (fun x y -> <:ctyp< $x$ $y$ >>) x xs 
+            and unquantified = List.fold_left
+                                 (fun inner fn -> <:ctyp< $fn$ -> $inner$ >>)
+                                 (<:ctyp< $intype$ -> $outtype$ >>)
+                                 fns in
+              <:ctyp< ! $tvars$ . $unquantified$ >>]
+
 
   and class_sig_item_of_type_decl _ ((name, _, _, _) as type_decl) acc =
     <:class_sig_item<