219 lines
7.4 KiB
OCaml
219 lines
7.4 KiB
OCaml
(***********************************************************************)
|
|
(* *)
|
|
(* OCaml *)
|
|
(* *)
|
|
(* 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$ *)
|
|
|
|
(* Representation of types and declarations *)
|
|
|
|
open Asttypes
|
|
|
|
(* Type expressions for the core language *)
|
|
|
|
type type_expr =
|
|
{ mutable desc: type_desc;
|
|
mutable level: int;
|
|
mutable id: int }
|
|
|
|
and type_desc =
|
|
Tvar of string option
|
|
| Tarrow of label * type_expr * type_expr * commutable
|
|
| Ttuple of type_expr list
|
|
| Tconstr of Path.t * type_expr list * abbrev_memo ref
|
|
| Tobject of type_expr * (Path.t * type_expr list) option ref
|
|
| Tfield of string * field_kind * type_expr * type_expr
|
|
| Tnil
|
|
| Tlink of type_expr
|
|
| Tsubst of type_expr (* for copying *)
|
|
| Tvariant of row_desc
|
|
| Tunivar of string option
|
|
| Tpoly of type_expr * type_expr list
|
|
| Tpackage of Path.t * Longident.t list * type_expr list
|
|
|
|
and row_desc =
|
|
{ row_fields: (label * row_field) list;
|
|
row_more: type_expr;
|
|
row_bound: unit;
|
|
row_closed: bool;
|
|
row_fixed: bool;
|
|
row_name: (Path.t * type_expr list) option }
|
|
|
|
and row_field =
|
|
Rpresent of type_expr option
|
|
| Reither of bool * type_expr list * bool * row_field option ref
|
|
(* 1st true denotes a constant constructor *)
|
|
(* 2nd true denotes a tag in a pattern matching, and
|
|
is erased later *)
|
|
| Rabsent
|
|
|
|
and abbrev_memo =
|
|
Mnil
|
|
| Mcons of private_flag * Path.t * type_expr * type_expr * abbrev_memo
|
|
| Mlink of abbrev_memo ref
|
|
|
|
and field_kind =
|
|
Fvar of field_kind option ref
|
|
| Fpresent
|
|
| Fabsent
|
|
|
|
and commutable =
|
|
Cok
|
|
| Cunknown
|
|
| Clink of commutable ref
|
|
|
|
module TypeOps = struct
|
|
type t = type_expr
|
|
let compare t1 t2 = t1.id - t2.id
|
|
let hash t = t.id
|
|
let equal t1 t2 = t1 == t2
|
|
end
|
|
|
|
(* Maps of methods and instance variables *)
|
|
|
|
module OrderedString = struct type t = string let compare = compare end
|
|
module Meths = Map.Make(OrderedString)
|
|
module Vars = Meths
|
|
|
|
(* Value descriptions *)
|
|
|
|
type value_description =
|
|
{ val_type: type_expr; (* Type of the value *)
|
|
val_kind: value_kind;
|
|
val_loc: Location.t;
|
|
}
|
|
|
|
and value_kind =
|
|
Val_reg (* Regular value *)
|
|
| Val_prim of Primitive.description (* Primitive *)
|
|
| Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *)
|
|
| Val_self of (Ident.t * type_expr) Meths.t ref *
|
|
(Ident.t * Asttypes.mutable_flag *
|
|
Asttypes.virtual_flag * type_expr) Vars.t ref *
|
|
string * type_expr
|
|
(* Self *)
|
|
| Val_anc of (string * Ident.t) list * string
|
|
(* Ancestor *)
|
|
| Val_unbound (* Unbound variable *)
|
|
|
|
(* Constructor descriptions *)
|
|
|
|
type constructor_description =
|
|
{ cstr_res: type_expr; (* Type of the result *)
|
|
cstr_existentials: type_expr list; (* list of existentials *)
|
|
cstr_args: type_expr list; (* Type of the arguments *)
|
|
cstr_arity: int; (* Number of arguments *)
|
|
cstr_tag: constructor_tag; (* Tag for heap blocks *)
|
|
cstr_consts: int; (* Number of constant constructors *)
|
|
cstr_nonconsts: int; (* Number of non-const constructors *)
|
|
cstr_normal: int; (* Number of non generalized constrs *)
|
|
cstr_generalized: bool; (* Constrained return type? *)
|
|
cstr_private: private_flag } (* Read-only constructor? *)
|
|
|
|
and constructor_tag =
|
|
Cstr_constant of int (* Constant constructor (an int) *)
|
|
| Cstr_block of int (* Regular constructor (a block) *)
|
|
| Cstr_exception of Path.t * Location.t (* Exception constructor *)
|
|
|
|
(* Record label descriptions *)
|
|
|
|
type label_description =
|
|
{ lbl_name: string; (* Short name *)
|
|
lbl_res: type_expr; (* Type of the result *)
|
|
lbl_arg: type_expr; (* Type of the argument *)
|
|
lbl_mut: mutable_flag; (* Is this a mutable field? *)
|
|
lbl_pos: int; (* Position in block *)
|
|
lbl_all: label_description array; (* All the labels in this type *)
|
|
lbl_repres: record_representation; (* Representation for this record *)
|
|
lbl_private: private_flag } (* Read-only field? *)
|
|
|
|
and record_representation =
|
|
Record_regular (* All fields are boxed / tagged *)
|
|
| Record_float (* All fields are floats *)
|
|
|
|
(* Type definitions *)
|
|
|
|
type type_declaration =
|
|
{ type_params: type_expr list;
|
|
type_arity: int;
|
|
type_kind: type_kind;
|
|
type_private: private_flag;
|
|
type_manifest: type_expr option;
|
|
type_variance: (bool * bool * bool) list;
|
|
(* covariant, contravariant, weakly contravariant *)
|
|
type_newtype_level: (int * int) option;
|
|
type_loc: Location.t }
|
|
|
|
and type_kind =
|
|
Type_abstract
|
|
| Type_record of
|
|
(Ident.t * mutable_flag * type_expr) list * record_representation
|
|
| Type_variant of (Ident.t * type_expr list * type_expr option) list
|
|
|
|
type exception_declaration =
|
|
{ exn_args: type_expr list;
|
|
exn_loc: Location.t }
|
|
|
|
(* Type expressions for the class language *)
|
|
|
|
module Concr = Set.Make(OrderedString)
|
|
|
|
type class_type =
|
|
Cty_constr of Path.t * type_expr list * class_type
|
|
| Cty_signature of class_signature
|
|
| Cty_fun of label * type_expr * class_type
|
|
|
|
and class_signature =
|
|
{ cty_self: type_expr;
|
|
cty_vars:
|
|
(Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
|
|
cty_concr: Concr.t;
|
|
cty_inher: (Path.t * type_expr list) list }
|
|
|
|
type class_declaration =
|
|
{ cty_params: type_expr list;
|
|
mutable cty_type: class_type;
|
|
cty_path: Path.t;
|
|
cty_new: type_expr option;
|
|
cty_variance: (bool * bool) list }
|
|
|
|
type class_type_declaration =
|
|
{ clty_params: type_expr list;
|
|
clty_type: class_type;
|
|
clty_path: Path.t;
|
|
clty_variance: (bool * bool) list }
|
|
|
|
(* Type expressions for the module language *)
|
|
|
|
type module_type =
|
|
Mty_ident of Path.t
|
|
| Mty_signature of signature
|
|
| Mty_functor of Ident.t * module_type * module_type
|
|
|
|
and signature = signature_item list
|
|
|
|
and signature_item =
|
|
Sig_value of Ident.t * value_description
|
|
| Sig_type of Ident.t * type_declaration * rec_status
|
|
| Sig_exception of Ident.t * exception_declaration
|
|
| Sig_module of Ident.t * module_type * rec_status
|
|
| Sig_modtype of Ident.t * modtype_declaration
|
|
| Sig_class of Ident.t * class_declaration * rec_status
|
|
| Sig_class_type of Ident.t * class_type_declaration * rec_status
|
|
|
|
and modtype_declaration =
|
|
Modtype_abstract
|
|
| Modtype_manifest of module_type
|
|
|
|
and rec_status =
|
|
Trec_not (* not recursive *)
|
|
| Trec_first (* first in a recursive group *)
|
|
| Trec_next (* not first in a recursive group *)
|