diff options
| author | Jacques Le Normand <rathereasy@gmail.com> | 2010-09-13 05:28:30 +0000 |
|---|---|---|
| committer | Jacques Le Normand <rathereasy@gmail.com> | 2010-09-13 05:28:30 +0000 |
| commit | 6de25fef2f6db569e0499e5eb492e31caf784a6c (patch) | |
| tree | 77d092980193ac6cd27f64c780b6a10881101797 /toplevel | |
| parent | 4fd6cd82750051e930451963b5f9a67831cac5dc (diff) | |
| download | ocaml-6de25fef2f6db569e0499e5eb492e31caf784a6c.tar.gz | |
first commit
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@10679 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'toplevel')
| -rw-r--r-- | toplevel/genprintval.ml | 23 |
1 files changed, 14 insertions, 9 deletions
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml index 3277004006..5ac0e03fd9 100644 --- a/toplevel/genprintval.ml +++ b/toplevel/genprintval.ml @@ -235,19 +235,12 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct | Tconstr(path, ty_list, _) -> begin try let decl = Env.find_type path env in - match decl with - | {type_kind = Type_abstract; type_manifest = None} -> - Oval_stuff "<abstr>" - | {type_kind = Type_abstract; type_manifest = Some body} -> - tree_of_val depth obj - (try Ctype.apply env decl.type_params body ty_list with - Ctype.Cannot_apply -> abstract_type) - | {type_kind = Type_variant constr_list} -> + let process_variants constr_list = let tag = if O.is_block obj then Cstr_block(O.tag obj) else Cstr_constant(O.obj obj) in - let (constr_name, constr_args) = + let (constr_name, constr_args,_) = (* GAH: this is definately wrong *) Datarepr.find_constr_by_tag tag constr_list in let ty_args = List.map @@ -257,6 +250,18 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct constr_args in tree_of_constr_with_args (tree_of_constr env path) constr_name 0 depth obj ty_args + in + match decl with + | {type_kind = Type_abstract; type_manifest = None} -> + Oval_stuff "<abstr>" + | {type_kind = Type_abstract; type_manifest = Some body} -> + tree_of_val depth obj + (try Ctype.apply env decl.type_params body ty_list with + Ctype.Cannot_apply -> abstract_type) + | {type_kind = Type_variant constr_list} -> + process_variants (List.map (fun (a,b) -> (a,b,None)) constr_list) + | {type_kind = Type_generalized_variant constr_list} -> + process_variants constr_list | {type_kind = Type_record(lbl_list, rep)} -> begin match check_depth depth obj ty with Some x -> x |