typing/types.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 (* Representation of types and declarations *)
  16
  17 open Misc
  18 open Asttypes
  19
  20 (* Type expressions for the core language *)
  21
  22 type type_expr =
  23   { mutable desc: type_desc;
  24     mutable level: int;
  25     mutable id: int }
  26
  27 and type_desc =
  28     Tvar
  29   | Tarrow of label * type_expr * type_expr * commutable
  30   | Ttuple of type_expr list
  31   | Tconstr of Path.t * type_expr list * abbrev_memo ref
  32   | Tobject of type_expr * (Path.t * type_expr list) option ref
  33   | Tfield of string * field_kind * type_expr * type_expr
  34   | Tnil
  35   | Tlink of type_expr
  36   | Tsubst of type_expr
  37   | Tvariant of row_desc
  38   | Tunivar
  39   | Tpoly of type_expr * type_expr list
  40
  41 and row_desc =
  42     { row_fields: (label * row_field) list;
  43       row_more: type_expr;
  44       row_bound: unit;
  45       row_closed: bool;
  46       row_fixed: bool;
  47       row_name: (Path.t * type_expr list) option }
  48
  49 and row_field =
  50     Rpresent of type_expr option
  51   | Reither of bool * type_expr list * bool * row_field option ref
  52   | Rabsent
  53
  54 and abbrev_memo =
  55     Mnil
  56   | Mcons of Path.t * type_expr * type_expr * abbrev_memo
  57   | Mlink of abbrev_memo ref
  58
  59 and field_kind =
  60     Fvar of field_kind option ref
  61   | Fpresent
  62   | Fabsent
  63
  64 and commutable =
  65     Cok
  66   | Cunknown
  67   | Clink of commutable ref
  68
  69 module TypeOps = struct
  70   type t = type_expr
  71   let compare t1 t2 = t1.id - t2.id
  72   let hash t = t.id
  73   let equal t1 t2 = t1 == t2
  74 end
  75
  76 (* Maps of methods and instance variables *)
  77
  78 module OrderedString = struct type t = string let compare = compare end
  79 module Meths = Map.Make(OrderedString)
  80 module Vars = Meths
  81
  82 (* Value descriptions *)
  83
  84 type value_description =
  85   { val_type: type_expr;                (* Type of the value *)
  86     val_kind: value_kind }
  87
  88 and value_kind =
  89     Val_reg                             (* Regular value *)
  90   | Val_prim of Primitive.description   (* Primitive *)
  91   | Val_ivar of mutable_flag * string   (* Instance variable (mutable ?) *)
  92   | Val_self of (Ident.t * type_expr) Meths.t ref *
  93                 (Ident.t * Asttypes.mutable_flag *
  94                  Asttypes.virtual_flag * type_expr) Vars.t ref *
  95                 string * type_expr
  96                                         (* Self *)
  97   | Val_anc of (string * Ident.t) list * string
  98                                         (* Ancestor *)
  99   | Val_unbound                         (* Unbound variable *)
 100
 101 (* Constructor descriptions *)
 102
 103 type constructor_description =
 104   { cstr_res: type_expr;                (* Type of the result *)
 105     cstr_args: type_expr list;          (* Type of the arguments *)
 106     cstr_arity: int;                    (* Number of arguments *)
 107     cstr_tag: constructor_tag;          (* Tag for heap blocks *)
 108     cstr_consts: int;                   (* Number of constant constructors *)
 109     cstr_nonconsts: int;                (* Number of non-const constructors *)
 110     cstr_private: private_flag }        (* Read-only constructor? *)
 111
 112 and constructor_tag =
 113     Cstr_constant of int                (* Constant constructor (an int) *)
 114   | Cstr_block of int                   (* Regular constructor (a block) *)
 115   | Cstr_exception of Path.t            (* Exception constructor *)
 116
 117 (* Record label descriptions *)
 118
 119 type label_description =
 120   { lbl_res: type_expr;                 (* Type of the result *)
 121     lbl_arg: type_expr;                 (* Type of the argument *)
 122     lbl_mut: mutable_flag;              (* Is this a mutable field? *)
 123     lbl_pos: int;                       (* Position in block *)
 124     lbl_all: label_description array;   (* All the labels in this type *)
 125     lbl_repres: record_representation;  (* Representation for this record *)
 126     lbl_private: private_flag }         (* Read-only field? *)
 127
 128 and record_representation =
 129     Record_regular                      (* All fields are boxed / tagged *)
 130   | Record_float                        (* All fields are floats *)
 131
 132 (* Type definitions *)
 133
 134 type type_declaration =
 135   { type_params: type_expr list;
 136     type_arity: int;
 137     type_kind: type_kind;
 138     type_manifest: type_expr option;
 139     type_variance: (bool * bool * bool) list }
 140
 141 and type_kind =
 142     Type_abstract
 143   | Type_variant of (string * type_expr list) list * private_flag
 144   | Type_record of (string * mutable_flag * type_expr) list
 145                  * record_representation * private_flag
 146
 147 type exception_declaration = type_expr list
 148
 149 (* Type expressions for the class language *)
 150
 151 module Concr = Set.Make(OrderedString)
 152
 153 type class_type =
 154     Tcty_constr of Path.t * type_expr list * class_type
 155   | Tcty_signature of class_signature
 156   | Tcty_fun of label * type_expr * class_type
 157
 158 and class_signature =
 159   { cty_self: type_expr;
 160     cty_vars:
 161       (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
 162     cty_concr: Concr.t;
 163     cty_inher: (Path.t * type_expr list) list }
 164
 165 type class_declaration =
 166   { cty_params: type_expr list;
 167     mutable cty_type: class_type;
 168     cty_path: Path.t;
 169     cty_new: type_expr option;
 170     cty_variance: (bool * bool) list }
 171
 172 type cltype_declaration =
 173   { clty_params: type_expr list;
 174     clty_type: class_type;
 175     clty_path: Path.t;
 176     clty_variance: (bool * bool) list }
 177
 178 (* Type expressions for the module language *)
 179
 180 type module_type =
 181     Tmty_ident of Path.t
 182   | Tmty_signature of signature
 183   | Tmty_functor of Ident.t * module_type * module_type
 184
 185 and signature = signature_item list
 186
 187 and signature_item =
 188     Tsig_value of Ident.t * value_description
 189   | Tsig_type of Ident.t * type_declaration * rec_status
 190   | Tsig_exception of Ident.t * exception_declaration
 191   | Tsig_module of Ident.t * module_type * rec_status
 192   | Tsig_modtype of Ident.t * modtype_declaration
 193   | Tsig_class of Ident.t * class_declaration * rec_status
 194   | Tsig_cltype of Ident.t * cltype_declaration * rec_status
 195
 196 and modtype_declaration =
 197     Tmodtype_abstract
 198   | Tmodtype_manifest of module_type
 199
 200 and rec_status =
 201     Trec_not
 202   | Trec_first
 203   | Trec_next