Fermetures representees en un seul bloc

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

1 files changed, 14 insertions, 5 deletions

diff --git a/toplevel/printval.ml b/toplevel/printval.ml
index 5bc5c78d81..b155ed5d87 100644
--- a/toplevel/printval.ml
+++ b/toplevel/printval.ml
@@ -39,11 +39,17 @@ let print_exception obj =
 
 exception Constr_not_found
 
-let rec find_constr tag = function
+let rec find_constr tag num_const num_nonconst = function
     [] ->
       raise Constr_not_found
-  | constr :: rest ->
-      if tag = 0 then constr else find_constr (tag - 1) rest
+  | (name, [] as cstr) :: rem ->
+      if tag = Cstr_constant num_const
+      then cstr
+      else find_constr tag (num_const + 1) num_nonconst rem
+  | (name, _ as cstr) :: rem ->
+      if tag = Cstr_block num_nonconst
+      then cstr
+      else find_constr tag num_const (num_nonconst + 1) rem
 
 (* The user-defined printers. Also used for some builtin types. *)
 
@@ -166,10 +172,13 @@ let print_value env obj ty =
               print_val prio depth obj
                         (Ctype.substitute decl.type_params ty_list body)
           | Type_variant constr_list ->
-              let tag = Obj.tag obj in
               begin try
+                let tag =
+                  if Obj.is_block obj
+                  then Cstr_block(Obj.tag obj)
+                  else Cstr_constant(Obj.magic obj) in
                 let (constr_name, constr_args) =
-                  find_constr tag constr_list in
+                  find_constr tag 0 0 constr_list in
                 let ty_args =
                   List.map (Ctype.substitute decl.type_params ty_list)
                       constr_args in