diff -Nu /home/frisch/tmp/ocaml-3.00/typing/btype.ml typing/btype.ml --- /home/frisch/tmp/ocaml-3.00/typing/btype.ml Tue Mar 21 15:43:23 2000 +++ typing/btype.ml Fri Jan 26 16:49:34 2001 @@ -115,7 +115,7 @@ List.iter f row.row_bound | _ -> assert false -let iter_type_expr f ty = +let rec iter_type_expr f ty = match ty.desc with Tvar -> () | Tarrow (_, ty1, ty2)-> f ty1; f ty2 @@ -129,6 +129,18 @@ | Tnil -> () | Tlink ty -> f ty | Tsubst ty -> assert false + | Tpackage mty -> iter_modtype_expr f mty + +and iter_modtype_expr f = function + | Tmty_ident _ -> () + | Tmty_functor (_,mty1,mty2) -> iter_modtype_expr f mty1; iter_modtype_expr f mty2 + | Tmty_signature s -> List.iter (iter_signature_item f) s + +and iter_signature_item f = function + | Tsig_value (_,vd) -> f vd.val_type + | Tsig_module (_,mty) -> iter_modtype_expr f mty + | _ -> () (* Should iter on the rest ?? *) + let saved_desc = ref [] (* Saved association of generic nodes with their description. *) diff -Nu /home/frisch/tmp/ocaml-3.00/typing/ctype.ml typing/ctype.ml --- /home/frisch/tmp/ocaml-3.00/typing/ctype.ml Wed Apr 19 05:14:02 2000 +++ typing/ctype.ml Fri Jan 26 16:55:17 2001 @@ -19,6 +19,10 @@ open Types open Btype +let check_modtype_equiv = ref + ((fun _ -> assert false) : (Env.t -> module_type -> module_type -> bool)) + + (* Type manipulation after type inference ====================================== @@ -536,7 +540,7 @@ let ty = repr ty in if ty.level > level then begin begin match ty.desc with - Tconstr(p, tl, abbrev) when level < Path.binding_time p -> + Tconstr(p, tl, abbrev) when ty.level <> generic_level && level < Path.binding_time p -> (* Try first to replace an abbreviation by its expansion. *) begin try ty.desc <- Tlink (!try_expand_head' env ty); @@ -738,9 +742,99 @@ Tlink (copy t) | Tsubst _ -> assert false + | Tpackage mty -> + Tpackage (copy_modtype mty) end; t +and copy_type_declaration decl = + { type_params = List.map copy decl.type_params; + type_arity = decl.type_arity; + type_kind = + begin match decl.type_kind with + Type_abstract -> Type_abstract + | Type_variant cstrs -> + Type_variant( + List.map (fun (n, args) -> (n, List.map copy args)) + cstrs) + | Type_record(lbls, rep) -> + Type_record( + List.map (fun (n, mut, arg) -> (n, mut, copy arg)) + lbls, + rep) + end; + type_manifest = + begin match decl.type_manifest with + None -> None + | Some ty -> Some(copy ty) + end + } + +and copy_class_signature sign = + { cty_self = copy sign.cty_self; + cty_vars = Vars.map (function (m, t) -> (m, copy t)) sign.cty_vars; + cty_concr = sign.cty_concr } + +and copy_class_type = + function + Tcty_constr (p, tyl, cty) -> + Tcty_constr (p, List.map copy tyl, copy_class_type cty) + | Tcty_signature sign -> + Tcty_signature (copy_class_signature sign) + | Tcty_fun (l, ty, cty) -> + Tcty_fun (l, copy ty, copy_class_type cty) + +and copy_class_declaration decl = + { cty_params = List.map copy decl.cty_params; + cty_type = copy_class_type decl.cty_type; + cty_path = decl.cty_path; + cty_new = + begin match decl.cty_new with + None -> None + | Some ty -> Some (copy ty) + end } + +and copy_cltype_declaration decl = + { clty_params = List.map copy decl.clty_params; + clty_type = copy_class_type decl.clty_type; + clty_path = decl.clty_path } + +and copy_value_description descr = + { val_type = copy descr.val_type; + val_kind = descr.val_kind } + +and copy_exception_declaration tyl = + List.map copy tyl + +and copy_modtype = function + Tmty_ident p as mty -> mty + | Tmty_signature sg -> + Tmty_signature(copy_signature sg) + | Tmty_functor(id, arg, res) -> + Tmty_functor(id, copy_modtype arg, copy_modtype res) + +and copy_signature = function + [] -> [] + | Tsig_value(id, d) :: sg -> + Tsig_value(id, copy_value_description d) :: copy_signature sg + | Tsig_type(id, d) :: sg -> + Tsig_type(id, copy_type_declaration d) :: copy_signature sg + | Tsig_exception(id, d) :: sg -> + Tsig_exception(id, copy_exception_declaration d) :: copy_signature sg + | Tsig_module(id, mty) :: sg -> + Tsig_module(id, copy_modtype mty) :: copy_signature sg + | Tsig_modtype(id, d) :: sg -> + Tsig_modtype(id, copy_modtype_declaration d) :: copy_signature sg + | Tsig_class(id, d) :: sg -> + Tsig_class(id, copy_class_declaration d) :: copy_signature sg + | Tsig_cltype(id, d) :: sg -> + Tsig_cltype(id, copy_cltype_declaration d) :: copy_signature sg + +and copy_modtype_declaration = function + Tmodtype_abstract -> Tmodtype_abstract + | Tmodtype_manifest mty -> Tmodtype_manifest(copy_modtype mty) + + (**** Variants of instantiations ****) let instance sch = @@ -1120,6 +1214,9 @@ | (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 -> update_level env t1.level t2; t1.desc <- Tlink t2 + | (Tpackage p1, Tpackage p2) when !check_modtype_equiv env p1 p2 -> + update_level env t1.level t2; + t1.desc <- Tlink t2 | _ -> unify2 env t1 t2 with Unify trace -> @@ -1514,6 +1611,8 @@ | (_, Tfield (_, kind, _, t2'')) when field_kind_repr kind = Fabsent -> moregen inst_nongen type_pairs env t1' t2'' + | (Tpackage p1, Tpackage p2) when !check_modtype_equiv env p1 p2 -> + () | (Tnil, Tnil) -> () | (_, _) -> @@ -2106,6 +2205,7 @@ (v, true) | Tsubst _ -> assert false + | Tpackage _ -> (t,false) (* Not sure !!! *) let enlarge_type env ty = subtypes := []; @@ -2426,6 +2526,8 @@ Tlink(nondep_type_rec env id ty) | Tsubst _ -> assert false + | Tpackage _ -> + fatal_error "Ctype.nondep_type_rec ... Tpackage" (* !!! *) end; ty' diff -Nu /home/frisch/tmp/ocaml-3.00/typing/ctype.mli typing/ctype.mli --- /home/frisch/tmp/ocaml-3.00/typing/ctype.mli Thu Feb 24 11:18:25 2000 +++ typing/ctype.mli Tue Jan 23 12:52:19 2001 @@ -17,6 +17,8 @@ open Asttypes open Types +val check_modtype_equiv : (Env.t -> module_type -> module_type -> bool) ref + exception Unify of (type_expr * type_expr) list exception Tags of label * label exception Subtype of diff -Nu /home/frisch/tmp/ocaml-3.00/typing/includemod.ml typing/includemod.ml --- /home/frisch/tmp/ocaml-3.00/typing/includemod.ml Mon Mar 6 23:11:58 2000 +++ typing/includemod.ml Tue Jan 23 13:14:03 2001 @@ -287,6 +287,12 @@ (Tcoerce_none, Tcoerce_none) -> () | (_, _) -> raise(Error [Modtype_permutation]) +let _ = Ctype.check_modtype_equiv := + (fun env mty1 mty2 -> + try check_modtype_equiv env mty1 mty2; true + with _ -> false + ) + (* Simplified inclusion check between module types *) let check_modtype_inclusion env mty1 mty2 = diff -Nu /home/frisch/tmp/ocaml-3.00/typing/printtyp.ml typing/printtyp.ml --- /home/frisch/tmp/ocaml-3.00/typing/printtyp.ml Sat Apr 1 15:00:35 2000 +++ typing/printtyp.ml Fri Jan 26 16:56:54 2001 @@ -53,7 +53,7 @@ let names = ref ([] : (type_expr * string) list) let name_counter = ref 0 -let reset_names () = names := []; name_counter := 0 +let reset_names () = (* names := []; name_counter := 0 *) () let new_name () = let name = @@ -156,6 +156,7 @@ | Tnil -> () | Tsubst ty -> mark_loops_rec visited ty | Tlink _ -> fatal_error "Printtyp.mark_loops_rec (2)" + | Tpackage mty -> iter_type_expr (mark_loops_rec visited) ty (* !!! *) let mark_loops ty = normalize_type Env.empty ty; @@ -192,6 +193,8 @@ | [a] -> pr ppf a | a :: l -> pr ppf a; sep (); print_list pr sep ppf l;; +let del_modtype = ref (fun _ _ -> ()) + let rec typexp sch prio0 ppf ty = let ty = repr ty in let px = proxy ty in @@ -281,6 +284,8 @@ typobject sch ty fi ppf nm | Tsubst ty -> typexp sch prio ppf ty + | Tpackage mty -> + fprintf ppf "@[[| %a |]@]" !del_modtype mty | _ -> fatal_error "Printtyp.typexp" ) in @@ -649,6 +654,8 @@ | Tmodtype_abstract -> () | Tmodtype_manifest mty -> fprintf ppf " =@ %a" modtype mty in fprintf ppf "@[<2>module type %a%a@]" ident id pr_decl decl + +let _ = del_modtype := modtype (* Print a signature body (used by -i when compiling a .ml) *) diff -Nu /home/frisch/tmp/ocaml-3.00/typing/subst.ml typing/subst.ml --- /home/frisch/tmp/ocaml-3.00/typing/subst.ml Tue Mar 21 15:43:24 2000 +++ typing/subst.ml Sat Jan 6 22:38:02 2001 @@ -73,6 +73,8 @@ | Papply(p1, p2) -> fatal_error "Subst.type_path" +let del_modtype = ref (fun _ x -> x) + (* Similar to [Ctype.nondep_type_rec]. *) let rec typexp s ty = let ty = repr ty in @@ -150,6 +152,8 @@ Tnil | Tsubst _ -> assert false + | Tpackage mty -> + Tpackage (!del_modtype s mty) end; ty' @@ -274,3 +278,5 @@ and modtype_declaration s = function Tmodtype_abstract -> Tmodtype_abstract | Tmodtype_manifest mty -> Tmodtype_manifest(modtype s mty) + +let _ = del_modtype := modtype diff -Nu /home/frisch/tmp/ocaml-3.00/typing/typecore.ml typing/typecore.ml --- /home/frisch/tmp/ocaml-3.00/typing/typecore.ml Fri Apr 14 05:41:18 2000 +++ typing/typecore.ml Fri Jan 26 10:15:07 2001 @@ -63,6 +63,10 @@ ref ((fun env md -> assert false) : Env.t -> Parsetree.module_expr -> Typedtree.module_expr) +let transl_modtype = + ref ((fun env md -> assert false) : + Env.t -> Parsetree.module_type -> Types.module_type) + (* Typing of constants *) let type_constant = function @@ -891,6 +895,34 @@ exp_loc = sexp.pexp_loc; exp_type = ty; exp_env = env } + + | Pexp_pack m -> + let modl = !type_module env m in + let ty = newty (Tpackage modl.mod_type) in + { exp_desc = Texp_pack(modl); + exp_loc = sexp.pexp_loc; + exp_type = ty; + exp_env = env } + + | Pexp_unpack (e1, name, mty, sbody) -> + let ty = newvar() in + Ident.set_current_time ty.level; + let mty = !transl_modtype env mty in + let arg = type_expect env e1 (newty (Tpackage mty)) in + let (id, new_env) = Env.enter_module name mty env in + Ctype.init_def(Ident.current_time()); + let body = type_exp new_env sbody in + begin try + Ctype.unify new_env body.exp_type ty + with Unify _ -> + raise(Error(sexp.pexp_loc, Scoping_let_module(name, body.exp_type))) + end; + { exp_desc = Texp_unpack(arg, id, mty, body); + exp_loc = sexp.pexp_loc; + exp_type = ty; + exp_env = env } + + and type_argument env sarg ty_expected = let rec no_labels ty = diff -Nu /home/frisch/tmp/ocaml-3.00/typing/typecore.mli typing/typecore.mli --- /home/frisch/tmp/ocaml-3.00/typing/typecore.mli Mon Mar 6 23:12:06 2000 +++ typing/typecore.mli Sat Jan 6 23:02:30 2001 @@ -91,3 +91,4 @@ (* Forward declaration, to be filled in by Typemod.type_module *) val type_module: (Env.t -> Parsetree.module_expr -> Typedtree.module_expr) ref +val transl_modtype: (Env.t -> Parsetree.module_type -> Types.module_type) ref diff -Nu /home/frisch/tmp/ocaml-3.00/typing/typedtree.ml typing/typedtree.ml --- /home/frisch/tmp/ocaml-3.00/typing/typedtree.ml Sun Mar 12 14:09:06 2000 +++ typing/typedtree.ml Sat Jan 6 22:06:39 2001 @@ -73,6 +73,8 @@ | Texp_setinstvar of Path.t * Path.t * expression | Texp_override of Path.t * (Path.t * expression) list | Texp_letmodule of Ident.t * module_expr * expression + | Texp_pack of module_expr + | Texp_unpack of expression * Ident.t * module_type * expression and meth = Tmeth_name of string diff -Nu /home/frisch/tmp/ocaml-3.00/typing/typedtree.mli typing/typedtree.mli --- /home/frisch/tmp/ocaml-3.00/typing/typedtree.mli Sun Mar 12 14:09:06 2000 +++ typing/typedtree.mli Sat Jan 6 22:07:35 2001 @@ -72,6 +72,8 @@ | Texp_setinstvar of Path.t * Path.t * expression | Texp_override of Path.t * (Path.t * expression) list | Texp_letmodule of Ident.t * module_expr * expression + | Texp_pack of module_expr + | Texp_unpack of expression * Ident.t * module_type * expression and meth = Tmeth_name of string diff -Nu /home/frisch/tmp/ocaml-3.00/typing/typemod.ml typing/typemod.ml --- /home/frisch/tmp/ocaml-3.00/typing/typemod.ml Tue Apr 25 13:47:14 2000 +++ typing/typemod.ml Sun Jan 21 18:17:35 2001 @@ -221,6 +221,8 @@ | Pmodtype_manifest smty -> Tmodtype_manifest(transl_modtype env smty) +let _ = Typetexp.transl_modtype := transl_modtype + (* Try to convert a module expression to a module path. *) exception Not_a_path @@ -468,7 +470,8 @@ (* Fill in the forward declaration *) let _ = - Typecore.type_module := type_module + Typecore.type_module := type_module; + Typecore.transl_modtype := transl_modtype (* Normalize types in a signature *) diff -Nu /home/frisch/tmp/ocaml-3.00/typing/types.ml typing/types.ml --- /home/frisch/tmp/ocaml-3.00/typing/types.ml Tue Mar 21 15:43:24 2000 +++ typing/types.ml Sat Jan 6 22:16:59 2001 @@ -17,6 +17,13 @@ open Misc open Asttypes +(* Maps of methods and instance variables *) + +module OrderedString = struct type t = string let compare = compare end +module Meths = Map.Make(OrderedString) +module Vars = Meths +module Concr = Set.Make(OrderedString) + (* Type expressions for the core language *) type type_expr = @@ -35,6 +42,7 @@ | Tlink of type_expr | Tsubst of type_expr | Tvariant of row_desc + | Tpackage of module_type and row_desc = { row_fields: (label * row_field) list; @@ -58,15 +66,32 @@ | Fpresent | Fabsent -(* Maps of methods and instance variables *) +(* Type expressions for the module language *) + +and 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 + | Tsig_exception of Ident.t * exception_declaration + | Tsig_module of Ident.t * module_type + | Tsig_modtype of Ident.t * modtype_declaration + | Tsig_class of Ident.t * class_declaration + | Tsig_cltype of Ident.t * cltype_declaration + +and modtype_declaration = + Tmodtype_abstract + | Tmodtype_manifest of module_type -module OrderedString = struct type t = string let compare = compare end -module Meths = Map.Make(OrderedString) -module Vars = Meths (* Value descriptions *) -type value_description = +and value_description = { val_type: type_expr; (* Type of the value *) val_kind: value_kind } @@ -84,7 +109,7 @@ (* Constructor descriptions *) -type constructor_description = +and 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 *) @@ -99,7 +124,7 @@ (* Record label descriptions *) -type label_description = +and label_description = { 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? *) @@ -113,7 +138,7 @@ (* Type definitions *) -type type_declaration = +and type_declaration = { type_params: type_expr list; type_arity: int; type_kind: type_kind; @@ -125,13 +150,12 @@ | Type_record of (string * mutable_flag * type_expr) list * record_representation -type exception_declaration = type_expr list +and exception_declaration = type_expr list (* Type expressions for the class language *) -module Concr = Set.Make(OrderedString) -type class_type = +and 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 @@ -141,35 +165,14 @@ cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t; cty_concr: Concr.t } -type class_declaration = +and class_declaration = { cty_params: type_expr list; mutable cty_type: class_type; cty_path: Path.t; cty_new: type_expr option } -type cltype_declaration = +and cltype_declaration = { clty_params: type_expr list; clty_type: class_type; clty_path: Path.t } -(* 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 - | Tsig_exception of Ident.t * exception_declaration - | Tsig_module of Ident.t * module_type - | Tsig_modtype of Ident.t * modtype_declaration - | Tsig_class of Ident.t * class_declaration - | Tsig_cltype of Ident.t * cltype_declaration - -and modtype_declaration = - Tmodtype_abstract - | Tmodtype_manifest of module_type diff -Nu /home/frisch/tmp/ocaml-3.00/typing/types.mli typing/types.mli --- /home/frisch/tmp/ocaml-3.00/typing/types.mli Tue Mar 21 15:43:24 2000 +++ typing/types.mli Sat Jan 6 22:17:06 2001 @@ -12,6 +12,13 @@ (* $Id: types.mli,v 1.13 2000/03/21 14:43:24 xleroy Exp $ *) +(* Maps of methods and instance variables *) + +module Meths : Map.S with type key = string +module Vars : Map.S with type key = string +module Concr : Set.S with type elt = string + + (* Representation of types and declarations *) open Asttypes @@ -34,6 +41,7 @@ | Tlink of type_expr | Tsubst of type_expr (* for copying *) | Tvariant of row_desc + | Tpackage of module_type and row_desc = { row_fields: (label * row_field) list; @@ -58,14 +66,34 @@ | Fpresent | Fabsent -(* Maps of methods and instance variables *) -module Meths : Map.S with type key = string -module Vars : Map.S with type key = string +(* Type expressions for the module language *) + +and 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 + | Tsig_exception of Ident.t * exception_declaration + | Tsig_module of Ident.t * module_type + | Tsig_modtype of Ident.t * modtype_declaration + | Tsig_class of Ident.t * class_declaration + | Tsig_cltype of Ident.t * cltype_declaration + +and modtype_declaration = + Tmodtype_abstract + | Tmodtype_manifest of module_type + + (* Value descriptions *) -type value_description = +and value_description = { val_type: type_expr; (* Type of the value *) val_kind: value_kind } @@ -83,7 +111,7 @@ (* Constructor descriptions *) -type constructor_description = +and 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 *) @@ -98,7 +126,7 @@ (* Record label descriptions *) -type label_description = +and label_description = { 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? *) @@ -112,7 +140,7 @@ (* Type definitions *) -type type_declaration = +and type_declaration = { type_params: type_expr list; type_arity: int; type_kind: type_kind; @@ -124,13 +152,12 @@ | Type_record of (string * mutable_flag * type_expr) list * record_representation -type exception_declaration = type_expr list +and exception_declaration = type_expr list (* Type expressions for the class language *) -module Concr : Set.S with type elt = string -type class_type = +and 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 @@ -140,35 +167,14 @@ cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t; cty_concr: Concr.t } -type class_declaration = +and class_declaration = { cty_params: type_expr list; mutable cty_type: class_type; cty_path: Path.t; cty_new: type_expr option } -type cltype_declaration = +and cltype_declaration = { clty_params: type_expr list; clty_type: class_type; clty_path: Path.t } -(* 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 - | Tsig_exception of Ident.t * exception_declaration - | Tsig_module of Ident.t * module_type - | Tsig_modtype of Ident.t * modtype_declaration - | Tsig_class of Ident.t * class_declaration - | Tsig_cltype of Ident.t * cltype_declaration - -and modtype_declaration = - Tmodtype_abstract - | Tmodtype_manifest of module_type diff -Nu /home/frisch/tmp/ocaml-3.00/typing/typetexp.ml typing/typetexp.ml --- /home/frisch/tmp/ocaml-3.00/typing/typetexp.ml Mon Mar 6 23:12:08 2000 +++ typing/typetexp.ml Fri Jan 26 10:10:35 2001 @@ -21,6 +21,8 @@ exception Already_bound +let transl_modtype = ref (fun _ -> assert false) + type error = Unbound_type_variable of string | Unbound_type_constructor of Longident.t @@ -262,6 +264,7 @@ if policy = Fixed && not (Btype.static_row row) then raise(Error(styp.ptyp_loc, Unbound_type_variable "[..]")); newty (Tvariant row) + | Ptyp_package mty -> newty (Tpackage (!transl_modtype env mty)) and transl_fields env policy = function diff -Nu /home/frisch/tmp/ocaml-3.00/typing/typetexp.mli typing/typetexp.mli --- /home/frisch/tmp/ocaml-3.00/typing/typetexp.mli Mon Mar 6 23:12:09 2000 +++ typing/typetexp.mli Sun Jan 21 18:15:24 2001 @@ -16,6 +16,8 @@ open Format;; +val transl_modtype: (Env.t -> Parsetree.module_type -> Types.module_type) ref + val transl_simple_type: Env.t -> bool -> Parsetree.core_type -> Types.type_expr val transl_simple_type_delayed: diff -Nu /home/frisch/tmp/ocaml-3.00/parsing/lexer.mll parsing/lexer.mll --- /home/frisch/tmp/ocaml-3.00/parsing/lexer.mll Wed Apr 12 05:43:24 2000 +++ parsing/lexer.mll Sat Jan 6 21:51:30 2001 @@ -66,6 +66,7 @@ "of", OF; "open", OPEN; "or", OR; + "pack", PACK; "parser", PARSER; "private", PRIVATE; "rec", REC; diff -Nu /home/frisch/tmp/ocaml-3.00/parsing/parser.mly parsing/parser.mly --- /home/frisch/tmp/ocaml-3.00/parsing/parser.mly Wed Apr 12 05:43:24 2000 +++ parsing/parser.mly Sun Jan 21 18:11:15 2001 @@ -266,6 +266,7 @@ %token OPEN %token OPTLABEL %token OR +%token PACK %token PARSER %token PREFIXOP %token PRIVATE @@ -752,6 +753,10 @@ expr: simple_expr { $1 } + | PACK module_expr + { mkexp (Pexp_pack ($2)) } + | OPEN expr AS UIDENT COLON module_type IN seq_expr %prec prec_let + { mkexp (Pexp_unpack ($2,$4,$6,$8)) } | simple_expr simple_labeled_expr_list %prec prec_appl { mkexp(Pexp_apply($1, List.rev $2)) } | LET rec_flag let_bindings IN seq_expr %prec prec_let @@ -1287,6 +1292,8 @@ { mktyp(Ptyp_variant([],true,[])) } | LBRACKETLESS opt_bar DOTDOT RBRACKET { mktyp(Ptyp_variant([],false,[])) } + | LBRACKETBAR module_type BARRBRACKET + { mktyp(Ptyp_package $2) } ; opt_opened: BAR DOTDOT { true } diff -Nu /home/frisch/tmp/ocaml-3.00/parsing/parsetree.mli parsing/parsetree.mli --- /home/frisch/tmp/ocaml-3.00/parsing/parsetree.mli Sun Mar 12 14:09:06 2000 +++ parsing/parsetree.mli Sun Jan 21 18:05:55 2001 @@ -18,6 +18,13 @@ (* Type expressions for the core language *) +type 'a class_infos = + { pci_virt: virtual_flag; + pci_params: string list * Location.t; + pci_name: string; + pci_expr: 'a; + pci_loc: Location.t } + type core_type = { ptyp_desc: core_type_desc; ptyp_loc: Location.t } @@ -32,6 +39,7 @@ | Ptyp_class of Longident.t * core_type list * label list | Ptyp_alias of core_type * string | Ptyp_variant of (label * bool * core_type list) list * bool * label list + | Ptyp_package of module_type and core_field_type = { pfield_desc: core_field_desc; @@ -43,16 +51,10 @@ (* XXX 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_loc: Location.t } (* Value expressions for the core language *) -type pattern = +and pattern = { ppat_desc: pattern_desc; ppat_loc: Location.t } @@ -70,7 +72,7 @@ | Ppat_constraint of pattern * core_type | Ppat_type of Longident.t -type expression = +and expression = { pexp_desc: expression_desc; pexp_loc: Location.t } @@ -100,6 +102,8 @@ | Pexp_setinstvar of string * expression | Pexp_override of (string * expression) list | Pexp_letmodule of string * module_expr * expression + | Pexp_pack of module_expr + | Pexp_unpack of expression * string * module_type * expression (* Value descriptions *) diff -Nu /home/frisch/tmp/ocaml-3.00/parsing/printast.ml parsing/printast.ml --- /home/frisch/tmp/ocaml-3.00/parsing/printast.ml Fri Apr 21 10:13:05 2000 +++ parsing/printast.ml Sun Jan 21 18:33:43 2001 @@ -125,6 +125,9 @@ | Ptyp_alias (ct, s) -> line i ppf "Ptyp_alias \"%s\"\n" s; core_type i ppf ct; + | Ptyp_package mty -> + line i ppf "Ptyp_package\n"; + module_type i ppf mty and core_field_type i ppf x = line i ppf "core_field_type %a\n" fmt_location x.pfield_loc; diff -Nu /home/frisch/tmp/ocaml-3.00/bytecomp/translcore.ml bytecomp/translcore.ml --- /home/frisch/tmp/ocaml-3.00/bytecomp/translcore.ml Mon Mar 6 23:11:13 2000 +++ bytecomp/translcore.ml Sat Jan 6 23:06:47 2001 @@ -583,6 +583,10 @@ (Lvar cpy)) | Texp_letmodule(id, modl, body) -> Llet(Strict, id, !transl_module Tcoerce_none None modl, transl_exp body) + | Texp_pack modl -> + !transl_module Tcoerce_none None modl + | Texp_unpack (arg,id,mty,body) -> + Llet(Strict, id, transl_exp arg, transl_exp body) | _ -> fatal_error "Translcore.transl"