diff options
Diffstat (limited to 'typing/datarepr.ml')
| -rw-r--r-- | typing/datarepr.ml | 96 |
1 files changed, 0 insertions, 96 deletions
diff --git a/typing/datarepr.ml b/typing/datarepr.ml deleted file mode 100644 index ddbd9fb276..0000000000 --- a/typing/datarepr.ml +++ /dev/null @@ -1,96 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(* Compute constructor and label descriptions from type declarations, - determining their representation. *) - -open Misc -open Asttypes -open Types - -let constructor_descrs ty_res cstrs priv = - 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) :: 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 = tag; - cstr_consts = !num_consts; - cstr_nonconsts = !num_nonconsts; - cstr_private = priv } in - (name, cstr) :: descr_rem in - describe_constructors 0 0 cstrs - -let exception_descr path_exc decl = - { cstr_res = Predef.type_exn; - cstr_args = decl; - cstr_arity = List.length decl; - cstr_tag = Cstr_exception path_exc; - cstr_consts = -1; - cstr_nonconsts = -1; - cstr_private = Public } - -let none = {desc = Ttuple []; level = -1; id = -1} - (* Clearly ill-formed type *) -let dummy_label = - { lbl_res = none; lbl_arg = none; lbl_mut = Immutable; - lbl_pos = (-1); lbl_all = [||]; lbl_repres = Record_regular; - lbl_private = Public } - -let label_descrs ty_res lbls repres priv = - let all_labels = Array.create (List.length lbls) dummy_label in - let rec describe_labels num = function - [] -> [] - | (name, mut_flag, ty_arg) :: rest -> - let lbl = - { lbl_res = ty_res; - lbl_arg = ty_arg; - lbl_mut = mut_flag; - lbl_pos = num; - lbl_all = all_labels; - lbl_repres = repres; - lbl_private = priv } in - all_labels.(num) <- lbl; - (name, lbl) :: describe_labels (num+1) rest in - describe_labels 0 lbls - -exception Constr_not_found - -let rec find_constr tag num_const num_nonconst = function - [] -> - raise Constr_not_found - | (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 - -let find_constr_by_tag tag cstrlist = - find_constr tag 0 0 cstrlist |