partial support for private types (need generation-specific code).

ast.ml

@@ -181,9 +181,13 @@ type class_field =
 	| FVar of string * documentation * access list * type_path option * expr option
 	| FFun of string * documentation * access list * func
 
+type enum_param =
+	| EPrivate
+
 type type_param_flag =
 	| HInterface
 	| HExtern
+	| HPrivate
 	| HExtends of type_path_normal
 	| HImplements of type_path_normal
 
@@ -191,7 +195,7 @@ type type_param = string * type_path_normal list
 
 type type_def =
 	| EClass of string * documentation * type_param list * type_param_flag list * (class_field * pos) list
-	| EEnum of string * documentation * type_param list * (string * documentation * (string * type_path) list * pos) list
+	| EEnum of string * documentation * type_param list * enum_param list * (string * documentation * (string * type_path) list * pos) list
 	| EImport of (string list * string)
 
 type type_decl = type_def * pos

parser.ml

@@ -140,15 +140,26 @@ let rec	parse_file s =
 and parse_type_decl s =	
 	match s with parser
 	| [< '(Kwd Import,p1); t = parse_type_path_normal; _ = semicolon >] -> (EImport (t.tpackage,t.tname), p1)
-	| [< '(Kwd Enum,p1); doc = get_doc; '(Const (Type name),_); tl = parse_type_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] -> (EEnum (name,doc,tl,l), punion p1 p2)
-	| [< n , p1 = parse_class_native; doc = get_doc; '(Const (Type name),_); tl = parse_type_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl = plist parse_class_field; '(BrClose,p2) >] -> (EClass (name,doc,tl,n @ hl,fl), punion p1 p2)
+	| [< c = parse_common_params; s >] ->
+		match s with parser 
+		| [< n , p1 = parse_enum_params; doc = get_doc; '(Const (Type name),_); tl = parse_type_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] -> (EEnum (name,doc,tl,List.map snd c @ n,l), punion p1 p2)
+		| [< n , p1 = parse_class_params; doc = get_doc; '(Const (Type name),_); tl = parse_type_params; hl = psep Comma parse_class_herit; '(BrOpen,_); fl = plist parse_class_field; '(BrClose,p2) >] -> (EClass (name,doc,tl,List.map fst c @ n @ hl,fl), punion p1 p2)
 
 and parse_package s = psep Dot ident s
 
-and parse_class_native = parser
-	| [< '(Kwd Extern,_); '(Kwd Class,p1) >] -> [HExtern] , p1
-	| [< '(Kwd Class,p1) >] -> [] , p1
-	| [< '(Kwd Interface,p1) >] -> [HInterface] , p1
+and parse_common_params = parser
+	| [< '(Kwd Private,_); l = parse_common_params >] -> (HPrivate, EPrivate) :: l
+	| [< >] -> []
+
+and parse_enum_params = parser
+	| [< '(Kwd Private,_); l, p = parse_enum_params >] -> EPrivate :: l , p
+	| [< '(Kwd Enum,p) >] -> [] , p
+
+and parse_class_params = parser
+	| [< '(Kwd Extern,_); l, p = parse_class_params >] -> HExtern :: l , p
+	| [< '(Kwd Private,_); l, p = parse_class_params >] -> HPrivate :: l , p
+	| [< '(Kwd Class,p) >] -> [] , p
+	| [< '(Kwd Interface,p) >] -> [HInterface] , p
 
 and parse_type_opt = parser
 	| [< '(DblDot,_); t = parse_type_path >] -> Some t

type.ml

@@ -90,6 +90,7 @@ and tclass = {
 	cl_path : module_path;
 	cl_pos : Ast.pos;
 	cl_doc : Ast.documentation;
+	cl_private : bool;
 	mutable cl_extern : bool;
 	mutable cl_interface : bool;
 	mutable cl_types : (string * t) list;
@@ -113,6 +114,7 @@ and tenum = {
 	e_path : module_path;
 	e_pos : Ast.pos;
 	e_doc : Ast.documentation;
+	e_private : bool;
 	mutable e_types : (string * t) list;
 	mutable e_constrs : (string , tenum_field) PMap.t;
 }
@@ -132,11 +134,12 @@ let mk_mono() = TMono (ref None)
 
 let rec t_dynamic = TDynamic t_dynamic
 
-let mk_class path pos doc =
+let mk_class path pos doc priv =
 	{
 		cl_path = path;
 		cl_pos = pos;
 		cl_doc = doc;
+		cl_private = priv;
 		cl_extern = false;
 		cl_interface = false;
 		cl_types = [];
@@ -149,6 +152,14 @@ let mk_class path pos doc =
 		cl_constructor = None;
 	}
 
+let t_private = function
+	| TClassDecl c -> c.cl_private
+	| TEnumDecl  e -> e.e_private
+
+let t_path = function
+	| TClassDecl c -> c.cl_path
+	| TEnumDecl  e -> e.e_path
+
 let print_context() = ref []
 
 let rec s_type ctx t = 

typer.ml

@@ -91,7 +91,7 @@ let load_type_def ctx p tpath =
 				| Exit -> tpath, load ctx tpath p
 			) in
 			try
-				List.find (fun t -> type_path t = tpath) m.mtypes
+				List.find (fun t -> not (t_private t) && type_path t = tpath) m.mtypes
 			with
 				Not_found -> error ("Module " ^ s_type_path tpath ^ " does not define type " ^ snd tpath) p
 
@@ -163,7 +163,7 @@ let load_type_opt ctx p t =
 
 let set_heritance ctx c herits p =
 	let rec loop = function
-		| HExtern | HInterface ->
+		| HPrivate | HExtern | HInterface ->
 			()
 		| HExtends t ->
 			if c.cl_super <> None then error "Cannot extend several classes" p;
@@ -194,6 +194,7 @@ let type_type_params ctx path p (n,flags) =
 		let e = {
 			e_path = (fst path @ [snd path],n);
 			e_pos = p;
+			e_private = true;
 			e_types = [];
 			e_constrs = PMap.empty;
 			e_doc = None;
@@ -201,7 +202,7 @@ let type_type_params ctx path p (n,flags) =
 		TEnum (e,[])
 	| l ->
 		(* build a phantom class *)
-		let c = mk_class (fst path @ [snd path],n) p None in
+		let c = mk_class (fst path @ [snd path],n) p None true in
 		set_heritance ctx c (List.map (fun t -> HImplements t) l) p;
 		let add_field ctypes params _ f =
 			let f = { f with cf_type = apply_params ctypes params f.cf_type } in
@@ -1141,9 +1142,12 @@ let init_class ctx c p types herits fields =
 let type_module ctx m tdecls =
 	(* PASS 1 : build module structure - does not load any module or type - should be atomic ! *)
 	let decls = ref [] in
-	let decl_with_name name p =
+	let decl_with_name name p priv =
 		let tpath = (fst m,name) in
-		try
+		if priv then begin
+			if List.exists (fun t -> tpath = t_path t) (!decls) then error ("Type name " ^ name ^ " is alreday defined in this module") p;
+			tpath
+		end else try
 			let m2 = Hashtbl.find ctx.types tpath in
 			error ("Type name " ^ s_type_path tpath ^ " is redefined from module " ^ s_type_path m2) p
 		with
@@ -1154,17 +1158,20 @@ let type_module ctx m tdecls =
 	List.iter (fun (d,p) ->
 		match d with
 		| EImport _ -> ()
-		| EClass (name,doc,_,_,_) ->
-			let path = decl_with_name name p in
-			let c = mk_class path p doc in
+		| EClass (name,doc,_,flags,_) ->
+			let priv = List.mem HPrivate flags in
+			let path = decl_with_name name p priv in
+			let c = mk_class path p doc priv in
 			decls := TClassDecl c :: !decls
-		| EEnum (name,doc,_,_) ->
-			let path = decl_with_name name p in
+		| EEnum (name,doc,_,flags,_) ->
+			let priv = List.mem EPrivate flags in
+			let path = decl_with_name name p priv in
 			let e = {
 				e_path = path;
 				e_pos = p;
 				e_doc = doc;
 				e_types = [];
+				e_private = priv;
 				e_constrs = PMap.empty;
 			} in
 			decls := TEnumDecl e :: !decls
@@ -1198,12 +1205,12 @@ let type_module ctx m tdecls =
 		match d with
 		| EImport t ->
 			let m = load ctx t p in
-			ctx.local_types <- ctx.local_types @ m.mtypes
+			ctx.local_types <- ctx.local_types @ (List.filter (fun t -> not (t_private t)) m.mtypes)
 		| EClass (name,_,types,herits,fields) ->
 			let c = List.find (fun d -> match d with TClassDecl { cl_path = _ , n } -> n = name | _ -> false) m.mtypes in
 			let c = (match c with TClassDecl c -> c | _ -> assert false) in
 			delays := !delays @ check_overloading c p :: check_interfaces c p :: init_class ctx c p types herits fields
-		| EEnum (name,_,types,constrs) ->
+		| EEnum (name,_,types,_,constrs) ->
 			let e = List.find (fun d -> match d with TEnumDecl { e_path = _ , n } -> n = name | _ -> false) m.mtypes in
 			let e = (match e with TEnumDecl e -> e | _ -> assert false) in
 			ctx.type_params <- [];
@@ -1266,7 +1273,7 @@ let context warn =
 		local_types = [];
 		type_params = [];
 		curmethod = "";
-		curclass = mk_class ([],"") null_pos None;
+		curclass = mk_class ([],"") null_pos None true;
 		current = empty;
 		std = empty;
 	} in
@@ -1391,7 +1398,7 @@ let types ctx main =
 				Not_found -> error ("Invalid -main : " ^ s_type_path cl ^ " does not have static function main") null_pos
 		);
 		let path = ([],"@Main") in
-		let c = mk_class path null_pos None in
+		let c = mk_class path null_pos None true in
 		let f = {
 			cf_name = "init";
 			cf_type = mk_mono();