Camlp4 has been bootstrapped!dothat

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/dothat@12347 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

6 files changed, 37 insertions, 26 deletions

diff --git a/boot/ocamlc b/boot/ocamlc
index 1f12185..63e869f 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index 0132332..c27be01 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
index a4a9042..0beed0b 100644
--- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
+++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
@@ -25,6 +25,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
   open Camlp4_import.Parsetree;
   open Camlp4_import.Longident;
   open Camlp4_import.Asttypes;
+  open Camlp4_import.Reftypes;
   open Ast;
 
   value constructors_arity () =
@@ -417,7 +418,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     fun
     [ <:patt@loc< $lid:s$ >> -> mkpat loc (Ppat_var s)
     | <:patt@loc< $id:i$ >> ->
-        let p = Ppat_construct (long_uident ~conv_con i)
+        let p = Ppat_construct (Pconstr (long_uident ~conv_con i))
                   None (constructors_arity ())
         in mkpat loc p
     | PaAli loc p1 p2 ->
@@ -431,7 +432,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     | PaAnt loc _ -> error loc "antiquotation not allowed here"
     | PaAny loc -> mkpat loc Ppat_any
     | <:patt@loc< $uid:s$ ($tup:<:patt@loc_any< _ >>$) >> ->
-        mkpat loc (Ppat_construct (lident (conv_con s))
+        mkpat loc (Ppat_construct (Pconstr (lident (conv_con s)))
               (Some (mkpat loc_any Ppat_any)) False)
     | PaApp loc _ _ as f ->
         let (f, al) = patt_fa [] f in
@@ -505,7 +506,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
         error (loc_of_patt p) "invalid pattern" ]
   and mklabpat =
     fun
-    [ <:patt< $i$ = $p$ >> -> (ident ~conv_lid:conv_lab i, patt p)
+    [ <:patt< $i$ = $p$ >> -> (Plabel (ident ~conv_lid:conv_lab i), patt p)
     | p -> error (loc_of_patt p) "invalid pattern" ];
 
   value rec expr_fa al =
@@ -556,7 +557,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
           match sep_expr_acc [] e with
           [ [(loc, ml, <:expr< $uid:s$ >>) :: l] ->
               let ca = constructors_arity () in
-              (mkexp loc (Pexp_construct (mkli (conv_con s) ml) None ca), l)
+              (mkexp loc (Pexp_construct (Pconstr (mkli (conv_con s) ml)) None ca), l)
           | [(loc, ml, <:expr< $lid:s$ >>) :: l] ->
               (mkexp loc (Pexp_ident (mkli s ml)), l)
           | [(_, [], e) :: l] -> (expr e, l)
@@ -568,7 +569,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
               match e2 with
               [ <:expr< $lid:s$ >> ->
                   let loc = Loc.merge loc_bp loc_ep
-                  in  (loc, mkexp loc (Pexp_field e1 (mkli (conv_lab s) ml)))
+                  in  (loc, mkexp loc (Pexp_field e1 (Plabel (mkli (conv_lab s) ml))))
               | _ -> error (loc_of_expr e2) "lowercase identifier expected" ])
             (loc, e) l
         in
@@ -721,12 +722,12 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     | <:expr@loc< ($tup:_$) >> -> error loc "singleton tuple"
     | ExTyc loc e t -> mkexp loc (Pexp_constraint (expr e) (Some (ctyp t)) None)
     | <:expr@loc< () >> ->
-        mkexp loc (Pexp_construct (lident "()") None True)
+        mkexp loc (Pexp_construct (Pconstr (lident "()")) None True)
     | <:expr@loc< $lid:s$ >> ->
         mkexp loc (Pexp_ident (lident s))
     | <:expr@loc< $uid:s$ >> ->
         (* let ca = constructors_arity () in *)
-        mkexp loc (Pexp_construct (lident (conv_con s)) None True)
+        mkexp loc (Pexp_construct (Pconstr (lident (conv_con s))) None True)
     | ExVrn loc s -> mkexp loc (Pexp_variant s None)
     | ExWhi loc e1 el ->
         let e2 = ExSeq loc el in
@@ -770,7 +771,7 @@ module Make (Ast : Sig.Camlp4Ast) = struct
     match x with
     [ <:rec_binding< $x$; $y$ >> ->
          mklabexp x (mklabexp y acc)
-    | <:rec_binding< $i$ = $e$ >> -> [(ident ~conv_lid:conv_lab i, expr e) :: acc]
+    | <:rec_binding< $i$ = $e$ >> -> [(Plabel (ident ~conv_lid:conv_lab i), expr e) :: acc]
     | _ -> assert False ]
   and mkideexp x acc =
     match x with
diff --git a/camlp4/Camlp4Top/Rprint.ml b/camlp4/Camlp4Top/Rprint.ml
index 978397d..fbfc3ca 100644
--- a/camlp4/Camlp4Top/Rprint.ml
+++ b/camlp4/Camlp4Top/Rprint.ml
@@ -70,6 +70,14 @@ value rec print_ident ppf =
       fprintf ppf "%a(%a)" print_ident id1 print_ident id2 ]
 ;
 
+value print_constructor_ref ppf = fun
+  [ Oconstr li -> print_ident ppf li
+  | Oconstr_ty li tyname -> fprintf ppf "%a.^%s" print_ident li tyname];
+
+value print_label_ref ppf = fun
+  [ Olabel li -> print_ident ppf li
+  | Olabel_ty li tyname -> fprintf ppf "%a.^%s" print_ident li tyname];
+
 value value_ident ppf name =
   if List.mem name ["or"; "mod"; "land"; "lor"; "lxor"; "lsl"; "lsr"; "asr"]
   then
@@ -87,7 +95,7 @@ value print_out_value ppf tree =
   let rec print_tree ppf =
     fun
     [ Oval_constr name ([_ :: _] as params) ->
-        fprintf ppf "@[<1>%a@ %a@]" print_ident name
+        fprintf ppf "@[<1>%a@ %a@]" print_constructor_ref name
           (print_tree_list print_simple_tree "") params
     | Oval_variant name (Some param) ->
         fprintf ppf "@[<2>`%s@ %a@]" name print_simple_tree param
@@ -107,9 +115,9 @@ value print_out_value ppf tree =
         fprintf ppf "@[<1>[%a]@]" (print_tree_list print_tree ";") tl
     | Oval_array tl ->
         fprintf ppf "@[<2>[|%a|]@]" (print_tree_list print_tree ";") tl
-    | Oval_constr (Oide_ident "true") [] -> fprintf ppf "True"
-    | Oval_constr (Oide_ident "false") [] -> fprintf ppf "False"
-    | Oval_constr name [] -> print_ident ppf name
+    | Oval_constr (Oconstr (Oide_ident "true")) [] -> fprintf ppf "True"
+    | Oval_constr (Oconstr (Oide_ident "false")) [] -> fprintf ppf "False"
+    | Oval_constr name [] -> print_constructor_ref ppf name
     | Oval_variant name None -> fprintf ppf "`%s" name
     | Oval_stuff s -> fprintf ppf "%s" s
     | Oval_record fel ->
@@ -125,12 +133,12 @@ value print_out_value ppf tree =
     | [(name, tree) :: fields] ->
         let name =
           match name with
-          [ Oide_ident "contents" -> Oide_ident "val"
+          [ Olabel (Oide_ident "contents") -> Olabel (Oide_ident "val")
           | x -> x ]
         in
         do {
           if not first then fprintf ppf ";@ " else ();
-          fprintf ppf "@[<1>%a=@,%a@]" print_ident name (cautious print_tree)
+          fprintf ppf "@[<1>%a=@,%a@]" print_label_ref name (cautious print_tree)
             tree;
           print_fields False ppf fields
         } ]
diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml
index 6702e8a..4c4e875 100644
--- a/camlp4/boot/Camlp4.ml
+++ b/camlp4/boot/Camlp4.ml
@@ -13344,6 +13344,8 @@ module Struct =
             open Camlp4_import.Longident
               
             open Camlp4_import.Asttypes
+
+            open Camlp4_import.Reftypes
               
             open Ast
               
@@ -13789,7 +13791,7 @@ module Struct =
               | Ast.PaId (loc, (Ast.IdLid (_, s))) -> mkpat loc (Ppat_var s)
               | Ast.PaId (loc, i) ->
                   let p =
-                    Ppat_construct (long_uident ~conv_con i, None,
+                    Ppat_construct (Pconstr (long_uident ~conv_con i), None,
                       constructors_arity ())
                   in mkpat loc p
               | PaAli (loc, p1, p2) ->
@@ -13804,25 +13806,25 @@ module Struct =
               | Ast.PaApp (loc, (Ast.PaId (_, (Ast.IdUid (_, s)))),
                   (Ast.PaTup (_, (Ast.PaAny loc_any)))) ->
                   mkpat loc
-                    (Ppat_construct (lident (conv_con s),
+                    (Ppat_construct (Pconstr (lident (conv_con s)),
                        Some (mkpat loc_any Ppat_any), false))
               | (PaApp (loc, _, _) as f) ->
                   let (f, al) = patt_fa [] f in
                   let al = List.map patt al
                   in
                     (match (patt f).ppat_desc with
-                     | Ppat_construct (li, None, _) ->
+                     | Ppat_construct (Pconstr li, None, _) ->
                          if constructors_arity ()
                          then
                            mkpat loc
-                             (Ppat_construct (li,
+                             (Ppat_construct (Pconstr li,
                                 Some (mkpat loc (Ppat_tuple al)), true))
                          else
                            (let a =
                               match al with
                               | [ a ] -> a
                               | _ -> mkpat loc (Ppat_tuple al)
-                            in mkpat loc (Ppat_construct (li, Some a, false)))
+                            in mkpat loc (Ppat_construct (Pconstr li, Some a, false)))
                      | Ppat_variant (s, None) ->
                          let a =
                            if constructors_arity ()
@@ -13910,7 +13912,7 @@ module Struct =
             and mklabpat =
               function
               | Ast.PaEq (_, i, p) ->
-                  ((ident ~conv_lid: conv_lab i), (patt p))
+                  (Plabel (ident ~conv_lid: conv_lab i), (patt p))
               | p -> error (loc_of_patt p) "invalid pattern"
               
             let rec expr_fa al =
@@ -13961,7 +13963,7 @@ module Struct =
                          let ca = constructors_arity ()
                          in
                            ((mkexp loc
-                               (Pexp_construct (mkli (conv_con s) ml, None,
+                               (Pexp_construct (Pconstr (mkli (conv_con s) ml), None,
                                   ca))),
                             l)
                      | (loc, ml, Ast.ExId (_, (Ast.IdLid (_, s)))) :: l ->
@@ -13977,7 +13979,7 @@ module Struct =
                              in
                                (loc,
                                 (mkexp loc
-                                   (Pexp_field (e1, mkli (conv_lab s) ml))))
+                                   (Pexp_field (e1, Plabel (mkli (conv_lab s) ml)))))
                          | _ ->
                              error (loc_of_expr e2)
                                "lowercase identifier expected")
@@ -14179,12 +14181,12 @@ module Struct =
               | ExTyc (loc, e, t) ->
                   mkexp loc (Pexp_constraint (expr e, Some (ctyp t), None))
               | Ast.ExId (loc, (Ast.IdUid (_, "()"))) ->
-                  mkexp loc (Pexp_construct (lident "()", None, true))
+                  mkexp loc (Pexp_construct (Pconstr (lident "()"), None, true))
               | Ast.ExId (loc, (Ast.IdLid (_, s))) ->
                   mkexp loc (Pexp_ident (lident s))
               | Ast.ExId (loc, (Ast.IdUid (_, s))) ->
                   mkexp loc
-                    (Pexp_construct (lident (conv_con s), None, true))
+                    (Pexp_construct (Pconstr (lident (conv_con s)), None, true))
               | ExVrn (loc, s) -> mkexp loc (Pexp_variant (s, None))
               | ExWhi (loc, e1, el) ->
                   let e2 = ExSeq (loc, el)
@@ -14230,7 +14232,7 @@ module Struct =
               match x with
               | Ast.RbSem (_, x, y) -> mklabexp x (mklabexp y acc)
               | Ast.RbEq (_, i, e) ->
-                  ((ident ~conv_lid: conv_lab i), (expr e)) :: acc
+                  (Plabel (ident ~conv_lid: conv_lab i), (expr e)) :: acc
               | _ -> assert false
             and mkideexp x acc =
               match x with
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 4275f16..6028c86 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -1227,7 +1227,7 @@ record_pattern_end:
     opt_semi                                    { Closed }
   | SEMI UNDERSCORE opt_semi                    { Open }
 ;
-  
+
 /* Primitive declarations */
 
 primitive_declaration: