Commits

Anonymous committed 640f0d1

Changement de la representation des constructeurs constants.

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

Comments (0)

Files changed (4)

   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 *)
     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 *)
 

typing/parmatch.ml

 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

typing/typedtree.ml

     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 *)

typing/typedtree.mli

     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 *)