Changement de la representation des constructeurs constants.

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

4 files changed, 29 insertions, 13 deletions

diff --git a/typing/env.ml b/typing/env.ml
index 1998a81cb..d59414af4 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -188,18 +188,29 @@ let constructors_of_type ty_path decl =
   match decl.type_kind with
     Type_variant cstrs ->
       let ty_res = Tconstr(ty_path, decl.type_params) in
-      let num_constrs = List.length cstrs in
-      let rec describe_constructors num = function
+      let num_consts = ref 0 and num_nonconsts = ref 0 in
+      List.iter
+        (function (name, []) -> incr num_consts
+                | (name, _)  -> incr num_nonconsts)
+        cstrs;
+      let rec describe_constructors idx_const idx_nonconst = function
           [] -> []
-        | (name, ty_args) :: rest ->
+        | (name, ty_args) :: rem ->
+            let (tag, descr_rem) =
+              match ty_args with
+                [] -> (Cstr_constant idx_const,
+                       describe_constructors (idx_const+1) idx_nonconst rem)
+              | _  -> (Cstr_block idx_nonconst,
+                       describe_constructors idx_const (idx_nonconst+1) rem) in
             let cstr =
               { cstr_res = ty_res;
                 cstr_args = ty_args;
                 cstr_arity = List.length ty_args;
-                cstr_tag = Cstr_tag num;
-                cstr_span = num_constrs } in
-            (name, cstr) :: describe_constructors (num+1) rest in
-      describe_constructors 0 cstrs
+                cstr_tag = tag;
+                cstr_consts = !num_consts;
+                cstr_nonconsts = !num_nonconsts } in
+            (name, cstr) :: descr_rem in
+      describe_constructors 0 0 cstrs
   | _ -> []
 
 (* Compute a constructor description for an exception *)
@@ -209,7 +220,8 @@ let constructor_exception path_exc decl =
     cstr_args = decl;
     cstr_arity = List.length decl;
     cstr_tag = Cstr_exception path_exc;
-    cstr_span = -1 }
+    cstr_consts = -1;
+    cstr_nonconsts = -1 }
 
 (* Compute label descriptions *)
 
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 8d3ee419b..c78058aae 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -155,7 +155,7 @@ let filter_all pat0 pss =
 let full_match env =
   match env with
     ({pat_desc = Tpat_construct(c,_)},_) :: _ ->
-      List.length env = c.cstr_span
+      List.length env = c.cstr_consts + c.cstr_nonconsts
   | ({pat_desc = Tpat_constant(Const_char _)},_) :: _ ->
       List.length env = 256
   | ({pat_desc = Tpat_constant(_)},_) :: _ -> false
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 2390d9fbb..2f170a1c6 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -31,10 +31,12 @@ type constructor_description =
     cstr_args: type_expr list;          (* Type of the arguments *)
     cstr_arity: int;                    (* Number of arguments *)
     cstr_tag: constructor_tag;          (* Tag for heap blocks *)
-    cstr_span: int }                    (* Number of constructors in type *)
+    cstr_consts: int;                   (* Number of constant constructors *)
+    cstr_nonconsts: int }               (* Number of non-const constructors *)
 
 and constructor_tag =
-    Cstr_tag of int                     (* Regular constructor *)
+    Cstr_constant of int                (* Constant constructor (an int) *)
+  | Cstr_block of int                   (* Regular constructor (a block) *)
   | Cstr_exception of Path.t            (* Exception constructor *)
 
 (* Record label descriptions *)
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index fc572cd24..d9a8b0fc7 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -30,10 +30,12 @@ type constructor_description =
     cstr_args: type_expr list;          (* Type of the arguments *)
     cstr_arity: int;                    (* Number of arguments *)
     cstr_tag: constructor_tag;          (* Tag for heap blocks *)
-    cstr_span: int }                    (* Number of constructors in type *)
+    cstr_consts: int;                   (* Number of constant constructors *)
+    cstr_nonconsts: int }               (* Number of non-const constructors *)
 
 and constructor_tag =
-    Cstr_tag of int                     (* Regular constructor *)
+    Cstr_constant of int                (* Constant constructor (an int) *)
+  | Cstr_block of int                   (* Regular constructor (a block) *)
   | Cstr_exception of Path.t            (* Exception constructor *)
 
 (* Record label descriptions *)