binary-compat: started compatibility with 3.12.0

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/binary-compat@10821 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

7 files changed, 809 insertions, 59 deletions

diff --git a/binary-compat/.depend b/binary-compat/.depend
index 9c00f119bb..762b9bfb98 100644
--- a/binary-compat/.depend
+++ b/binary-compat/.depend
@@ -65,8 +65,8 @@ parsing/syntaxerr.cmo: parsing/location.cmi parsing/syntaxerr.cmi
 parsing/syntaxerr.cmx: parsing/location.cmx parsing/syntaxerr.cmi
 typing/annot.cmi: parsing/location.cmi
 typing/btype.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
-typing/ctype.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi \
-    typing/env.cmi parsing/asttypes.cmi
+typing/ctype.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \
+    typing/ident.cmi typing/env.cmi parsing/asttypes.cmi
 typing/datarepr.cmi: typing/types.cmi typing/path.cmi parsing/asttypes.cmi
 typing/env.cmi: typing/types.cmi typing/path.cmi parsing/longident.cmi \
     typing/ident.cmi utils/consistbl.cmi typing/annot.cmi
@@ -113,6 +113,8 @@ typing/btype.cmo: typing/types.cmi typing/path.cmi utils/misc.cmi \
     typing/btype.cmi
 typing/btype.cmx: typing/types.cmx typing/path.cmx utils/misc.cmx \
     typing/btype.cmi
+typing/cmi_format.cmo: typing/types.cmi utils/config.cmi
+typing/cmi_format.cmx: typing/types.cmx utils/config.cmx
 typing/ctype.cmo: typing/types.cmi typing/subst.cmi typing/path.cmi \
     utils/misc.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \
     utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/ctype.cmi
@@ -123,14 +125,16 @@ typing/datarepr.cmo: typing/types.cmi typing/predef.cmi utils/misc.cmi \
     parsing/asttypes.cmi typing/datarepr.cmi
 typing/datarepr.cmx: typing/types.cmx typing/predef.cmx utils/misc.cmx \
     parsing/asttypes.cmi typing/datarepr.cmi
-typing/env.cmo: typing/types.cmi utils/tbl.cmi typing/subst.cmi \
-    typing/predef.cmi typing/path.cmi utils/misc.cmi parsing/longident.cmi \
-    typing/ident.cmi typing/datarepr.cmi utils/consistbl.cmi utils/config.cmi \
+typing/env.cmo: compat/3.12.0/v3120_cmi.cmo typing/types.cmi utils/tbl.cmi \
+    typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \
+    parsing/longident.cmi typing/ident.cmi typing/datarepr.cmi \
+    utils/consistbl.cmi utils/config.cmi typing/cmi_format.cmo \
     utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
     typing/env.cmi
-typing/env.cmx: typing/types.cmx utils/tbl.cmx typing/subst.cmx \
-    typing/predef.cmx typing/path.cmx utils/misc.cmx parsing/longident.cmx \
-    typing/ident.cmx typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \
+typing/env.cmx: compat/3.12.0/v3120_cmi.cmx typing/types.cmx utils/tbl.cmx \
+    typing/subst.cmx typing/predef.cmx typing/path.cmx utils/misc.cmx \
+    parsing/longident.cmx typing/ident.cmx typing/datarepr.cmx \
+    utils/consistbl.cmx utils/config.cmx typing/cmi_format.cmx \
     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
     typing/env.cmi
 typing/ident.cmo: typing/ident.cmi
@@ -249,22 +253,22 @@ typing/typedtree.cmo: typing/types.cmi typing/primitive.cmi typing/path.cmi \
 typing/typedtree.cmx: typing/types.cmx typing/primitive.cmx typing/path.cmx \
     utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \
     parsing/asttypes.cmi typing/typedtree.cmi
-typing/typemod.cmo: typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \
-    typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
-    typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/path.cmi \
-    parsing/parsetree.cmi typing/mtype.cmi utils/misc.cmi \
-    parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \
-    typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \
-    utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi \
-    typing/typemod.cmi
-typing/typemod.cmx: typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \
-    typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
-    typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx typing/path.cmx \
-    parsing/parsetree.cmi typing/mtype.cmx utils/misc.cmx \
-    parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \
-    typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
-    utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi \
-    typing/typemod.cmi
+typing/typemod.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
+    typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
+    typing/typeclass.cmi typing/subst.cmi typing/stypes.cmi \
+    typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi \
+    typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \
+    parsing/location.cmi typing/includemod.cmi typing/ident.cmi \
+    typing/env.cmi typing/ctype.cmi utils/config.cmi utils/clflags.cmi \
+    typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi typing/typemod.cmi
+typing/typemod.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
+    typing/typedtree.cmx typing/typedecl.cmx typing/typecore.cmx \
+    typing/typeclass.cmx typing/subst.cmx typing/stypes.cmx \
+    typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi \
+    typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \
+    parsing/location.cmx typing/includemod.cmx typing/ident.cmx \
+    typing/env.cmx typing/ctype.cmx utils/config.cmx utils/clflags.cmx \
+    typing/btype.cmx parsing/asttypes.cmi typing/annot.cmi typing/typemod.cmi
 typing/types.cmo: typing/primitive.cmi typing/path.cmi utils/misc.cmi \
     typing/ident.cmi parsing/asttypes.cmi typing/types.cmi
 typing/types.cmx: typing/primitive.cmx typing/path.cmx utils/misc.cmx \
@@ -510,8 +514,8 @@ asmcomp/selectgen.cmi: utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
 asmcomp/selection.cmi: asmcomp/mach.cmi asmcomp/cmm.cmi
 asmcomp/spill.cmi: asmcomp/mach.cmi
 asmcomp/split.cmi: asmcomp/mach.cmi
-asmcomp/arch.cmo:
-asmcomp/arch.cmx:
+asmcomp/arch.cmo: utils/misc.cmi utils/config.cmi
+asmcomp/arch.cmx: utils/misc.cmx utils/config.cmx
 asmcomp/asmgen.cmo: bytecomp/translmod.cmi asmcomp/split.cmi \
     asmcomp/spill.cmi asmcomp/selection.cmi asmcomp/scheduling.cmi \
     asmcomp/reload.cmi asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \
@@ -615,13 +619,15 @@ asmcomp/debuginfo.cmo: parsing/location.cmi bytecomp/lambda.cmi \
 asmcomp/debuginfo.cmx: parsing/location.cmx bytecomp/lambda.cmx \
     asmcomp/debuginfo.cmi
 asmcomp/emit.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
-    asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/emitaux.cmi \
-    asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \
-    asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi
+    asmcomp/mach.cmi parsing/location.cmi asmcomp/linearize.cmi \
+    asmcomp/emitaux.cmi asmcomp/debuginfo.cmi utils/config.cmi \
+    asmcomp/compilenv.cmi asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo \
+    asmcomp/emit.cmi
 asmcomp/emit.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
-    asmcomp/mach.cmx asmcomp/linearize.cmx asmcomp/emitaux.cmx \
-    asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \
-    asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi
+    asmcomp/mach.cmx parsing/location.cmx asmcomp/linearize.cmx \
+    asmcomp/emitaux.cmx asmcomp/debuginfo.cmx utils/config.cmx \
+    asmcomp/compilenv.cmx asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx \
+    asmcomp/emit.cmi
 asmcomp/emitaux.cmo: asmcomp/reg.cmi asmcomp/linearize.cmi \
     asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \
     asmcomp/emitaux.cmi
@@ -661,17 +667,17 @@ asmcomp/printmach.cmx: asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printcmm.cmx \
     asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \
     asmcomp/printmach.cmi
 asmcomp/proc.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
-    utils/config.cmi asmcomp/cmm.cmi utils/ccomp.cmi asmcomp/arch.cmo \
-    asmcomp/proc.cmi
+    utils/config.cmi asmcomp/cmm.cmi utils/clflags.cmi utils/ccomp.cmi \
+    asmcomp/arch.cmo asmcomp/proc.cmi
 asmcomp/proc.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
-    utils/config.cmx asmcomp/cmm.cmx utils/ccomp.cmx asmcomp/arch.cmx \
-    asmcomp/proc.cmi
+    utils/config.cmx asmcomp/cmm.cmx utils/clflags.cmx utils/ccomp.cmx \
+    asmcomp/arch.cmx asmcomp/proc.cmi
 asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi
 asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi
 asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
-    asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/reload.cmi
+    asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/reload.cmi
 asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \
-    asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/reload.cmi
+    asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/reload.cmi
 asmcomp/reloadgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
     asmcomp/reloadgen.cmi
 asmcomp/reloadgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
@@ -692,10 +698,10 @@ asmcomp/selectgen.cmx: utils/tbl.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
     asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/selectgen.cmi
 asmcomp/selection.cmo: asmcomp/selectgen.cmi asmcomp/reg.cmi asmcomp/proc.cmi \
     utils/misc.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \
-    utils/clflags.cmi asmcomp/arch.cmo asmcomp/selection.cmi
+    asmcomp/arch.cmo asmcomp/selection.cmi
 asmcomp/selection.cmx: asmcomp/selectgen.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
     utils/misc.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \
-    utils/clflags.cmx asmcomp/arch.cmx asmcomp/selection.cmi
+    asmcomp/arch.cmx asmcomp/selection.cmi
 asmcomp/spill.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
     asmcomp/mach.cmi asmcomp/spill.cmi
 asmcomp/spill.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
diff --git a/binary-compat/Makefile b/binary-compat/Makefile
index e83e881fc6..25d8c7d74e 100644
--- a/binary-compat/Makefile
+++ b/binary-compat/Makefile
@@ -32,7 +32,8 @@ SHELL=/bin/sh
 MKDIR=mkdir -p
 
 INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver \
-	 -I toplevel
+	 -I toplevel \
+	 -I compat/3.12.0
 
 UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
   utils/clflags.cmo utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
@@ -40,6 +41,11 @@ UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
 
 OPTUTILS=$(UTILS)
 
+COMPAT_CMI=\
+  compat/3.12.0/v3120_types.cmo \
+  compat/3.12.0/v3120_cmi.cmo
+
+
 PARSING=parsing/linenum.cmo parsing/location.cmo parsing/longident.cmo \
   parsing/syntaxerr.cmo parsing/parser.cmo \
   parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo
@@ -48,7 +54,9 @@ TYPING=typing/unused_var.cmo typing/ident.cmo typing/path.cmo \
   typing/primitive.cmo typing/types.cmo \
   typing/btype.cmo typing/oprint.cmo \
   typing/subst.cmo typing/predef.cmo \
-  typing/datarepr.cmo typing/env.cmo \
+  typing/datarepr.cmo \
+  typing/cmi_format.cmo $(COMPAT_CMI) \
+  typing/env.cmo \
   typing/typedtree.cmo typing/ctype.cmo \
   typing/printtyp.cmo typing/includeclass.cmo \
   typing/mtype.cmo typing/includecore.cmo \
diff --git a/binary-compat/compat/3.12.0/v3120_cmi.ml b/binary-compat/compat/3.12.0/v3120_cmi.ml
new file mode 100644
index 0000000000..38a3feec53
--- /dev/null
+++ b/binary-compat/compat/3.12.0/v3120_cmi.ml
@@ -0,0 +1,142 @@
+module Current_cmi_format = Cmi_format
+
+exception TODO
+
+module Ident : sig 
+  
+  val reset : unit -> unit
+  val ident : V3120_types.Ident.t -> Ident.t
+
+end = struct
+
+  module T = V3120_types.Ident
+  let tbl = Hashtbl.create 13
+    
+  let reset () = Hashtbl.clear tbl
+
+  let ident id = 
+    let key =  (id.T.name, id.T.stamp) in
+    try
+      Hashtbl.find tbl key
+  with Not_found ->
+    let t = Ident.magic id.T.stamp id.T.name id.T.flags in
+      Hashtbl.add tbl key t;
+      t
+
+end
+
+module Primitive : sig
+
+  val description : V3120_types.Primitive.description -> Primitive.description
+
+end = struct
+
+  let description prim = raise TODO
+
+end
+
+module Types : sig
+
+  val reset : unit -> unit
+
+  val signature_item : 
+    V3120_types.Types.signature_item -> Types.signature_item 
+
+end = struct
+
+  module T = V3120_types.Types
+  open Types
+
+  let reset () = raise TODO
+
+  let rec type_expr ty = raise TODO
+
+  let ident = Ident.ident
+
+
+
+  let rec signature list = List.map signature_item list
+
+  and signature_item item =
+    match item with
+	T.Tsig_value (id, v) ->
+	  Tsig_value (ident id, value_description v)
+      | T.Tsig_type (id, t, r) ->
+	  Tsig_type (ident id, type_declaration t, rec_status r)
+      | T.Tsig_exception (id, decl) ->
+	  Tsig_exception (ident id, exception_declaration decl)
+      | T.Tsig_module (id, m, r) ->
+	  Tsig_module (ident id,  module_type m, rec_status r)
+      | T.Tsig_modtype (id, m) ->
+	  Tsig_modtype (ident id, modtype_declaration m)
+      | T.Tsig_class (id, cl, r) ->
+	  Tsig_class (ident id, class_declaration cl, rec_status r)
+      | T.Tsig_cltype (id, cl, r) ->
+	  Tsig_cltype (ident id, cltype_declaration cl, rec_status r)
+
+  and value_description v =
+    { val_type = type_expr v.T.val_type;
+      val_kind = value_kind v.T.val_kind; }
+
+  and value_kind v =
+    match v with
+	T.Val_reg -> Val_reg
+      | T.Val_prim prim -> Val_prim (Primitive.description prim)
+      | T.Val_ivar (m,s) ->
+	  Val_ivar (mutable_flag m, s)
+      | T.Val_self (meths, vars, s, t) ->
+	  (*
+	    of (Ident.t * type_expr) Meths.t ref *
+                (Ident.t * Asttypes.mutable_flag *
+                 Asttypes.virtual_flag * type_expr) Vars.t ref *
+                string * type_expr
+	  *)
+	  raise TODO
+                                        (* Self *)
+      | T.Val_anc _ -> raise TODO
+(* of (string * Ident.t) list * string *)
+      | T.Val_unbound -> Val_unbound
+
+  and type_declaration decl = raise TODO
+  and rec_status r = raise TODO
+  and exception_declaration decl = raise TODO
+  and module_type decl = raise TODO
+  and modtype_declaration decl = raise TODO
+  and class_declaration decl = raise TODO
+  and cltype_declaration decl = raise TODO
+  and mutable_flag v = raise TODO
+
+
+end
+;;
+
+module Cmi_format : sig
+
+  val pers_flags : 
+    V3120_types.Cmi_format.pers_flags -> Cmi_format.pers_flags
+  ;;
+
+  end = struct
+  
+  module T = V3120_types.Cmi_format
+  open Cmi_format
+
+  let pers_flags flag =
+    match flag with
+	T.Rectypes -> Rectypes
+end
+
+let input_cmi_file ic magic =
+    if magic <> V3120_types.cmi_magic_number then
+      raise Current_cmi_format.No_such_magic;
+
+  Ident.reset ();
+  Types.reset ();
+
+    let (cmi_name, cmi_sign) = (input_value ic : string *  V3120_types.Types.signature_item list) in
+    let cmi_crcs = (input_value ic : (string * Digest.t) list) in
+    let cmi_flags = (input_value ic : V3120_types.Cmi_format.pers_flags list) in
+
+    let cmi_sign = List.map Types.signature_item cmi_sign in
+    let cmi_flags = List.map Cmi_format.pers_flags cmi_flags in
+      { Current_cmi_format.cmi_name ; cmi_sign; cmi_crcs; cmi_flags }
diff --git a/binary-compat/compat/3.12.0/v3120_types.ml b/binary-compat/compat/3.12.0/v3120_types.ml
new file mode 100644
index 0000000000..95f76752b4
--- /dev/null
+++ b/binary-compat/compat/3.12.0/v3120_types.ml
@@ -0,0 +1,580 @@
+
+let exec_magic_number = "Caml1999X008"
+and cmi_magic_number = "Caml1999I012"
+and cmo_magic_number = "Caml1999O007"
+and cma_magic_number = "Caml1999A008"
+and cmx_magic_number = "Caml1999Y011"
+and cmxa_magic_number = "Caml1999Z010"
+and ast_impl_magic_number = "Caml1999M013"
+and ast_intf_magic_number = "Caml1999N012"
+and cmxs_magic_number = "Caml2007D001"
+
+module Asttypes = struct
+
+(* Auxiliary a.s.t. types used by parsetree and typedtree. *)
+
+type constant =
+    Const_int of int
+  | Const_char of char
+  | Const_string of string
+  | Const_float of string
+  | Const_int32 of int32
+  | Const_int64 of int64
+  | Const_nativeint of nativeint
+
+type rec_flag = Nonrecursive | Recursive | Default
+
+type direction_flag = Upto | Downto
+
+type private_flag = Private | Public
+
+type mutable_flag = Immutable | Mutable
+
+type virtual_flag = Virtual | Concrete
+
+type override_flag = Override | Fresh
+
+type closed_flag = Closed | Open
+
+type label = string
+
+end
+
+module Lexing = struct
+
+type position = {
+  pos_fname : string;
+  pos_lnum : int;
+  pos_bol : int;
+  pos_cnum : int;
+}
+
+end
+
+module Location = struct
+
+type t = { loc_start: Lexing.position; loc_end: Lexing.position; loc_ghost: bool };;
+
+end
+
+module Longident = struct
+
+
+type t =
+    Lident of string
+  | Ldot of t * string
+  | Lapply of t * t
+
+
+end
+
+module Parsetree = struct
+
+(* Abstract syntax tree produced by parsing *)
+
+open Asttypes
+
+(* Type expressions for the core language *)
+
+type core_type =
+  { ptyp_desc: core_type_desc;
+    ptyp_loc: Location.t }
+
+and core_type_desc =
+    Ptyp_any
+  | Ptyp_var of string
+  | Ptyp_arrow of label * core_type * core_type
+  | Ptyp_tuple of core_type list
+  | Ptyp_constr of Longident.t * core_type list
+  | Ptyp_object of core_field_type list
+  | Ptyp_class of Longident.t * core_type list * label list
+  | Ptyp_alias of core_type * string
+  | Ptyp_variant of row_field list * bool * label list option
+  | Ptyp_poly of string list * core_type
+  | Ptyp_package of package_type
+
+and package_type = Longident.t * (string * core_type) list
+
+and core_field_type =
+  { pfield_desc: core_field_desc;
+    pfield_loc: Location.t }
+
+and core_field_desc =
+    Pfield of string * core_type
+  | Pfield_var
+
+and row_field =
+    Rtag of label * bool * core_type list
+  | Rinherit of core_type
+
+(* Type expressions for the class language *)
+
+type 'a class_infos =
+  { pci_virt: virtual_flag;
+    pci_params: string list * Location.t;
+    pci_name: string;
+    pci_expr: 'a;
+    pci_variance: (bool * bool) list;
+    pci_loc: Location.t }
+
+(* Value expressions for the core language *)
+
+type pattern =
+  { ppat_desc: pattern_desc;
+    ppat_loc: Location.t }
+
+and pattern_desc =
+    Ppat_any
+  | Ppat_var of string
+  | Ppat_alias of pattern * string
+  | Ppat_constant of constant
+  | Ppat_tuple of pattern list
+  | Ppat_construct of Longident.t * pattern option * bool
+  | Ppat_variant of label * pattern option
+  | Ppat_record of (Longident.t * pattern) list * closed_flag
+  | Ppat_array of pattern list
+  | Ppat_or of pattern * pattern
+  | Ppat_constraint of pattern * core_type
+  | Ppat_type of Longident.t
+  | Ppat_lazy of pattern
+
+type expression =
+  { pexp_desc: expression_desc;
+    pexp_loc: Location.t }
+
+and expression_desc =
+    Pexp_ident of Longident.t
+  | Pexp_constant of constant
+  | Pexp_let of rec_flag * (pattern * expression) list * expression
+  | Pexp_function of label * expression option * (pattern * expression) list
+  | Pexp_apply of expression * (label * expression) list
+  | Pexp_match of expression * (pattern * expression) list
+  | Pexp_try of expression * (pattern * expression) list
+  | Pexp_tuple of expression list
+  | Pexp_construct of Longident.t * expression option * bool
+  | Pexp_variant of label * expression option
+  | Pexp_record of (Longident.t * expression) list * expression option
+  | Pexp_field of expression * Longident.t
+  | Pexp_setfield of expression * Longident.t * expression
+  | Pexp_array of expression list
+  | Pexp_ifthenelse of expression * expression * expression option
+  | Pexp_sequence of expression * expression
+  | Pexp_while of expression * expression
+  | Pexp_for of string * expression * expression * direction_flag * expression
+  | Pexp_constraint of expression * core_type option * core_type option
+  | Pexp_when of expression * expression
+  | Pexp_send of expression * string
+  | Pexp_new of Longident.t
+  | Pexp_setinstvar of string * expression
+  | Pexp_override of (string * expression) list
+  | Pexp_letmodule of string * module_expr * expression
+  | Pexp_assert of expression
+  | Pexp_assertfalse
+  | Pexp_lazy of expression
+  | Pexp_poly of expression * core_type option
+  | Pexp_object of class_structure
+  | Pexp_newtype of string * expression
+  | Pexp_pack of module_expr * package_type
+  | Pexp_open of Longident.t * expression
+
+(* Value descriptions *)
+
+and value_description =
+  { pval_type: core_type;
+    pval_prim: string list }
+
+(* Type declarations *)
+
+and type_declaration =
+  { ptype_params: string list;
+    ptype_cstrs: (core_type * core_type * Location.t) list;
+    ptype_kind: type_kind;
+    ptype_private: private_flag;
+    ptype_manifest: core_type option;
+    ptype_variance: (bool * bool) list;
+    ptype_loc: Location.t }
+
+and type_kind =
+    Ptype_abstract
+  | Ptype_variant of (string * core_type list * Location.t) list
+  | Ptype_record of
+      (string * mutable_flag * core_type * Location.t) list
+
+and exception_declaration = core_type list
+
+(* Type expressions for the class language *)
+
+and class_type =
+  { pcty_desc: class_type_desc;
+    pcty_loc: Location.t }
+
+and class_type_desc =
+    Pcty_constr of Longident.t * core_type list
+  | Pcty_signature of class_signature
+  | Pcty_fun of label * core_type * class_type
+
+and class_signature = core_type * class_type_field list
+
+and class_type_field =
+    Pctf_inher of class_type
+  | Pctf_val of (string * mutable_flag * virtual_flag * core_type * Location.t)
+  | Pctf_virt  of (string * private_flag * core_type * Location.t)
+  | Pctf_meth  of (string * private_flag * core_type * Location.t)
+  | Pctf_cstr  of (core_type * core_type * Location.t)
+
+and class_description = class_type class_infos
+
+and class_type_declaration = class_type class_infos
+
+(* Value expressions for the class language *)
+
+and class_expr =
+  { pcl_desc: class_expr_desc;
+    pcl_loc: Location.t }
+
+and class_expr_desc =
+    Pcl_constr of Longident.t * core_type list
+  | Pcl_structure of class_structure
+  | Pcl_fun of label * expression option * pattern * class_expr
+  | Pcl_apply of class_expr * (label * expression) list
+  | Pcl_let of rec_flag * (pattern * expression) list * class_expr
+  | Pcl_constraint of class_expr * class_type
+
+and class_structure = pattern * class_field list
+
+and class_field =
+    Pcf_inher of override_flag * class_expr * string option
+  | Pcf_valvirt of (string * mutable_flag * core_type * Location.t)
+  | Pcf_val of (string * mutable_flag * override_flag * expression * Location.t)
+  | Pcf_virt  of (string * private_flag * core_type * Location.t)
+  | Pcf_meth of (string * private_flag *override_flag * expression * Location.t)
+  | Pcf_cstr  of (core_type * core_type * Location.t)
+  | Pcf_let   of rec_flag * (pattern * expression) list * Location.t
+  | Pcf_init  of expression
+
+and class_declaration = class_expr class_infos
+
+(* Type expressions for the module language *)
+
+and module_type =
+  { pmty_desc: module_type_desc;
+    pmty_loc: Location.t }
+
+and module_type_desc =
+    Pmty_ident of Longident.t
+  | Pmty_signature of signature
+  | Pmty_functor of string * module_type * module_type
+  | Pmty_with of module_type * (Longident.t * with_constraint) list
+  | Pmty_typeof of module_expr
+
+and signature = signature_item list
+
+and signature_item =
+  { psig_desc: signature_item_desc;
+    psig_loc: Location.t }
+
+and signature_item_desc =
+    Psig_value of string * value_description
+  | Psig_type of (string * type_declaration) list
+  | Psig_exception of string * exception_declaration
+  | Psig_module of string * module_type
+  | Psig_recmodule of (string * module_type) list
+  | Psig_modtype of string * modtype_declaration
+  | Psig_open of Longident.t
+  | Psig_include of module_type
+  | Psig_class of class_description list
+  | Psig_class_type of class_type_declaration list
+
+and modtype_declaration =
+    Pmodtype_abstract
+  | Pmodtype_manifest of module_type
+
+and with_constraint =
+    Pwith_type of type_declaration
+  | Pwith_module of Longident.t
+  | Pwith_typesubst of type_declaration
+  | Pwith_modsubst of Longident.t
+
+(* value expressions for the module language *)
+
+and module_expr =
+  { pmod_desc: module_expr_desc;
+    pmod_loc: Location.t }
+
+and module_expr_desc =
+    Pmod_ident of Longident.t
+  | Pmod_structure of structure
+  | Pmod_functor of string * module_type * module_expr
+  | Pmod_apply of module_expr * module_expr
+  | Pmod_constraint of module_expr * module_type
+  | Pmod_unpack of expression * package_type
+
+and structure = structure_item list
+
+and structure_item =
+  { pstr_desc: structure_item_desc;
+    pstr_loc: Location.t }
+
+and structure_item_desc =
+    Pstr_eval of expression
+  | Pstr_value of rec_flag * (pattern * expression) list
+  | Pstr_primitive of string * value_description
+  | Pstr_type of (string * type_declaration) list
+  | Pstr_exception of string * exception_declaration
+  | Pstr_exn_rebind of string * Longident.t
+  | Pstr_module of string * module_expr
+  | Pstr_recmodule of (string * module_type * module_expr) list
+  | Pstr_modtype of string * module_type
+  | Pstr_open of Longident.t
+  | Pstr_class of class_declaration list
+  | Pstr_class_type of class_type_declaration list
+  | Pstr_include of module_expr
+
+(* Toplevel phrases *)
+
+type toplevel_phrase =
+    Ptop_def of structure
+  | Ptop_dir of string * directive_argument
+
+and directive_argument =
+    Pdir_none
+  | Pdir_string of string
+  | Pdir_int of int
+  | Pdir_ident of Longident.t
+  | Pdir_bool of bool
+
+
+end
+
+module Primitive = struct
+
+type description =
+  { prim_name: string;         (* Name of primitive  or C function *)
+    prim_arity: int;           (* Number of arguments *)
+    prim_alloc: bool;          (* Does it allocates or raise? *)
+    prim_native_name: string;  (* Name of C function for the nat. code gen. *)
+    prim_native_float: bool }  (* Does the above operate on unboxed floats? *)
+
+end
+
+module Ident = struct
+
+  type t = { stamp: int; name: string; mutable flags: int }
+
+end
+
+module Path = struct
+
+type t =
+    Pident of Ident.t
+  | Pdot of t * string * int
+  | Papply of t * t
+
+end
+
+
+module Types = struct
+
+(* 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
+  | 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; (* kept for compatibility *)
+      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 * mutable_flag * 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: (mutable_flag * 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 *)
+
+
+end
+
+module Cmi_format = struct
+
+  type pers_flags = Rectypes
+
+end
diff --git a/binary-compat/typing/env.ml b/binary-compat/typing/env.ml
index 0442479906..88f60b269a 100644
--- a/binary-compat/typing/env.ml
+++ b/binary-compat/typing/env.ml
@@ -136,7 +136,7 @@ let current_unit = ref ""
 
 (* Persistent structure descriptions *)
 
-type pers_flags = Rectypes
+open Cmi_format
 
 type pers_struct =
   { ps_name: string;
@@ -163,29 +163,42 @@ let check_consistency filename crcs =
 
 (* Reading persistent structures from .cmi files *)
 
-let read_pers_struct modname filename =
+let input_cmi_file ic magic =
+    if magic = cmi_magic_number then 
+      Cmi_format.input_cmi_file ic magic
+    else
+      V3120_cmi.input_cmi_file ic magic
+
+let read_cmi_file filename = 
   let ic = open_in_bin filename in
   try
     let buffer = String.create (String.length cmi_magic_number) in
     really_input ic buffer 0 (String.length cmi_magic_number);
-    if buffer <> cmi_magic_number then begin
+    let cmi = input_cmi_file ic buffer in
       close_in ic;
-      raise(Error(Not_an_interface filename))
-    end;
-    let (name, sign) = input_value ic in
-    let crcs = input_value ic in
-    let flags = input_value ic in
+      cmi
+  with End_of_file | Failure _ ->
     close_in ic;
+    raise(Error(Corrupted_interface(filename)))
+    | No_such_magic -> 
+	raise (Error(Not_an_interface(filename)))
+    | e -> 
+	close_in ic;
+	raise e
+      
+
+let read_pers_struct modname filename =
+  let cmi = read_cmi_file filename in
     let comps =
       !components_of_module' empty Subst.identity
-                             (Pident(Ident.create_persistent name))
-                             (Tmty_signature sign) in
-    let ps = { ps_name = name;
-               ps_sig = sign;
+                             (Pident(Ident.create_persistent cmi.cmi_name))
+                             (Tmty_signature cmi.cmi_sign) in
+    let ps = { ps_name = cmi.cmi_name;
+               ps_sig = cmi.cmi_sign;
                ps_comps = comps;
-               ps_crcs = crcs;
+               ps_crcs = cmi.cmi_crcs;
                ps_filename = filename;
-               ps_flags = flags } in
+               ps_flags = cmi.cmi_flags } in
     if ps.ps_name <> modname then
       raise(Error(Illegal_renaming(ps.ps_name, filename)));
     check_consistency filename ps.ps_crcs;
@@ -196,9 +209,6 @@ let read_pers_struct modname filename =
       ps.ps_flags;
     Hashtbl.add persistent_structures modname ps;
     ps
-  with End_of_file | Failure _ ->
-    close_in ic;
-    raise(Error(Corrupted_interface(filename)))
 
 let find_pers_struct name =
   try
diff --git a/binary-compat/typing/ident.ml b/binary-compat/typing/ident.ml
index c5bc09f418..7c2c9edf2e 100644
--- a/binary-compat/typing/ident.ml
+++ b/binary-compat/typing/ident.ml
@@ -182,3 +182,5 @@ let rec keys_aux stack accu = function
       keys_aux (l :: stack) (k.ident :: accu) r
 
 let keys tbl = keys_aux [] [] tbl
+
+let magic stamp name flags = { stamp; name; flags }
diff --git a/binary-compat/typing/ident.mli b/binary-compat/typing/ident.mli
index 03e2eee48d..5c22008612 100644
--- a/binary-compat/typing/ident.mli
+++ b/binary-compat/typing/ident.mli
@@ -57,3 +57,5 @@ val add: t -> 'a -> 'a tbl -> 'a tbl
 val find_same: t -> 'a tbl -> 'a
 val find_name: string -> 'a tbl -> 'a
 val keys: 'a tbl -> t list
+
+val magic : int -> string -> int -> t