private types, cont'd

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

4 files changed, 18 insertions, 44 deletions

diff --git a/camlp4/etc/pr_o.ml b/camlp4/etc/pr_o.ml
index e40af3b842..0081fbd824 100644
--- a/camlp4/etc/pr_o.ml
+++ b/camlp4/etc/pr_o.ml
@@ -120,7 +120,6 @@ value has_special_chars v =
 value var_escaped v =
   if v = "" then "$lid:\"\"$" else
   if v = "val" then "contents" else
-  if v = "contents" then "contents__" else
   if has_special_chars v || is_infix v then "( " ^ v ^ " )" else
   if is_keyword v then v ^ "__"
   else v
@@ -147,7 +146,6 @@ value id_var s =
   if has_special_chars s || is_infix s then
     HVbox [: `S LR "("; `S LR s; `S LR ")" :]
   else if s = "val" then HVbox [: `S LR "contents" :]
-  else if s = "contents" then HVbox [: `S LR "contents__" :]
   else if is_keyword s then HVbox [: `S LR (s ^ "__") :]
   else HVbox [: `S LR s :]
 ;
@@ -1649,27 +1647,17 @@ pr_ctyp.pr_levels :=
           fun curr next dg k -> [: `S LR (var_escaped s); k :]
       | <:ctyp< $uid:s$ >> -> fun curr next dg k -> [: `S LR s; k :]
       | <:ctyp< _ >> -> fun curr next dg k -> [: `S LR "_"; k :]
-      | <:ctyp< private { $list:ftl$ } >> as t ->
-          fun curr next dg k ->
-            let loc = MLast.loc_of_ctyp t in
-              [: `HVbox
-                 [: `HVbox [:`S LR "private" :];
-                    `HVbox [: labels loc [:`S LR "{" :]
-                                ftl "" [: `S LR "}"  :] :];
-                     k :] :]
       | <:ctyp< { $list:ftl$ } >> as t ->
           fun curr next dg k ->
             let loc = MLast.loc_of_ctyp t in
             [: `HVbox
                   [: labels loc [: `S LR "{" :] ftl "" [: `S LR "}" :];
                      k :] :]
-      | <:ctyp< private [ $list:ctl$ ] >> as t ->
+      | <:ctyp< private $ty$ >> ->
           fun curr next dg k ->
-            let loc = MLast.loc_of_ctyp t in
-            [: `Vbox
-                  [: `HVbox [: `S LR "private" :];
-                      variants loc [: `S LR " " :] ctl "" [: :];
-                     k :] :]
+            [: `HVbox
+               [: `HVbox [:`S LR "private" :];
+                  `ctyp ty "" k :] :]
       | <:ctyp< [ $list:ctl$ ] >> as t ->
           fun curr next dg k ->
             let loc = MLast.loc_of_ctyp t in
diff --git a/camlp4/etc/pr_r.ml b/camlp4/etc/pr_r.ml
index b00b8ce778..32bd317181 100644
--- a/camlp4/etc/pr_r.ml
+++ b/camlp4/etc/pr_r.ml
@@ -1532,14 +1532,11 @@ pr_ctyp.pr_levels :=
           fun curr next _ k -> [: `S LR (var_escaped s); k :]
       | <:ctyp< $uid:s$ >> -> fun curr next _ k -> [: `S LR s; k :]
       | <:ctyp< _ >> -> fun curr next _ k -> [: `S LR "_"; k :]
-      | <:ctyp< private { $list: ftl$ } >> as t ->
-          fun curr next _ k ->
-            let loc = MLast.loc_of_ctyp t in
-              [: `HVbox
-                 [: `HVbox [:`S LR "private" :];
-                    `HVbox [: labels loc [:`S LR "{" :]
-                                ftl [: `S LR "}" :] :];
-                     k :] :]
+      | <:ctyp< private $ty$ >> ->
+          fun curr next dg k ->
+            [: `HVbox
+               [: `HVbox [:`S LR "private" :];
+                  `ctyp ty k :] :]
       | <:ctyp< { $list: ftl$ } >> as t ->
           fun curr next _ k ->
             let loc = MLast.loc_of_ctyp t in
@@ -1551,12 +1548,6 @@ pr_ctyp.pr_levels :=
             [: `Vbox
                   [: `HVbox [: :];
                      variants loc [: `S LR "[" :] ctl [: `S LR "]" :]; k :] :]
-      | <:ctyp< private [ $list:ctl$ ] >> as t ->
-          fun curr next _ k ->
-            let loc = MLast.loc_of_ctyp t in
-            [: `Vbox
-                  [: `HVbox [: `S LR "private" :];
-                     variants loc [: `S LR "[" :] ctl [: `S LR "]" :]; k :] :]
       | <:ctyp< [ = $list:rfl$ ] >> ->
           fun curr next _ k ->
             [: `HVbox
diff --git a/camlp4/lib/extfun.ml b/camlp4/lib/extfun.ml
index 866ea221c1..7123271a6a 100644
--- a/camlp4/lib/extfun.ml
+++ b/camlp4/lib/extfun.ml
@@ -89,14 +89,12 @@ value insert_matching matchings (patt, has_when, expr) =
   let rec loop =
     fun
     [ [m :: ml] as gml ->
-        if m1.has_when && not m.has_when then [m1 :: gml]
-        else if not m1.has_when && m.has_when then [m :: loop ml]
-        else
-          let c = compare m1.patt m.patt in
-          if c < 0 then [m1 :: gml]
-          else if c > 0 then [m :: loop ml]
-          else if m.has_when then [m1 :: gml]
-          else [m1 :: ml]
+        if m1.has_when && not m.has_when then [m1 :: gml] else
+        if not m1.has_when && m.has_when then [m :: loop ml] else
+        (* either both or none have a when clause *)
+        if compare m1.patt m.patt = 0 then 
+          if not m1.has_when then [m1 :: ml] else [m1 :: gml]
+        else [m :: loop ml]
     | [] -> [m1] ]
   in
   loop matchings
diff --git a/camlp4/ocaml_src/lib/extfun.ml b/camlp4/ocaml_src/lib/extfun.ml
index f8a6b26ac5..249fadb876 100644
--- a/camlp4/ocaml_src/lib/extfun.ml
+++ b/camlp4/ocaml_src/lib/extfun.ml
@@ -87,12 +87,9 @@ let insert_matching matchings (patt, has_when, expr) =
       m :: ml as gml ->
         if m1.has_when && not m.has_when then m1 :: gml
         else if not m1.has_when && m.has_when then m :: loop ml
-        else
-          let c = compare m1.patt m.patt in
-          if c < 0 then m1 :: gml
-          else if c > 0 then m :: loop ml
-          else if m.has_when then m1 :: gml
-          else m1 :: ml
+        else if compare m1.patt m.patt = 0 then
+          if not m1.has_when then m1 :: ml else m1 :: gml
+        else m :: loop ml
     | [] -> [m1]
   in
   loop matchings