Ctype.substitute renomme en Ctype.apply

Prise en compte d'un echec possible de Ctype.apply


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1413 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Jérôme Vouillon 1997-03-18 21:06:49 +00:00
parent 58e8f3b8d0
commit 8214828fa3
1 changed files with 15 additions and 4 deletions

View File

@ -115,6 +115,11 @@ let print_constr =
and print_label =
print_qualified (fun lid env -> (Env.lookup_label lid env).lbl_res)
(* An abstract type *)
let abstract_type =
Ctype.newty (Tconstr (Pident (Ident.create "abstract"), [], ref Mnil))
(* The main printing function *)
let max_printer_depth = ref 100
@ -187,7 +192,8 @@ let print_value env obj ty =
print_string "<abstr>"
| {type_kind = Type_abstract; type_manifest = Some body} ->
print_val prio depth obj
(Ctype.substitute env decl.type_params ty_list body)
(try Ctype.apply env decl.type_params body ty_list with
Ctype.Cannot_apply -> abstract_type)
| {type_kind = Type_variant constr_list} ->
let tag =
if Obj.is_block obj
@ -196,8 +202,11 @@ let print_value env obj ty =
let (constr_name, constr_args) =
find_constr tag 0 0 constr_list in
let ty_args =
List.map (Ctype.substitute env decl.type_params ty_list)
constr_args in
List.map
(function ty ->
try Ctype.apply env decl.type_params ty ty_list with
Ctype.Cannot_apply -> abstract_type)
constr_args in
begin match ty_args with
[] ->
print_constr env path constr_name
@ -233,7 +242,9 @@ let print_value env obj ty =
print_label env path lbl_name;
print_string "="; print_cut();
let ty_arg =
Ctype.substitute env decl.type_params ty_list lbl_arg in
try Ctype.apply env decl.type_params lbl_arg ty_list with
Ctype.Cannot_apply -> abstract_type
in
cautious (print_val 0 (depth - 1) (Obj.field obj pos))
ty_arg;
close_box();