Revision 914397e7fc1e1e7c87947a490336eed2142e9cf2 authored by Damien Doligez on 08 March 2012, 15:19:58 UTC, committed by Damien Doligez on 08 March 2012, 15:19:58 UTC
git-svn-id: http://caml.inria.fr/svn/ocaml/version/3.12@12205 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
1 parent d991ff1
types.ml
(***********************************************************************)
(* *)
(* 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$ *)
(* Representation of types and declarations *)
open Misc
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
| 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
| Tpoly of type_expr * type_expr list
| Tpackage of Path.t * string 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 }
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_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_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 (* 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 *)
and type_kind =
Type_abstract
| Type_variant of (string * type_expr list) list
| Type_record of
(string * mutable_flag * type_expr) list * record_representation
type exception_declaration = type_expr list
(* Type expressions for the class language *)
module Concr = Set.Make(OrderedString)
type class_type =
Tcty_constr of Path.t * type_expr list * class_type
| Tcty_signature of class_signature
| Tcty_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 cltype_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 =
Tmty_ident of Path.t
| Tmty_signature of signature
| Tmty_functor of Ident.t * module_type * module_type
and signature = signature_item list
and signature_item =
Tsig_value of Ident.t * value_description
| Tsig_type of Ident.t * type_declaration * rec_status
| Tsig_exception of Ident.t * exception_declaration
| Tsig_module of Ident.t * module_type * rec_status
| Tsig_modtype of Ident.t * modtype_declaration
| Tsig_class of Ident.t * class_declaration * rec_status
| Tsig_cltype of Ident.t * cltype_declaration * rec_status
and modtype_declaration =
Tmodtype_abstract
| Tmodtype_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 *)
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...