Просмотр исходного кода

import improvements (fixed issue #365)

Nicolas Cannasse 13 лет назад
Родитель
Сommit
d99a795b32
5 измененных файлов с 196 добавлено и 23 удалено
  1. 6 1
      ast.ml
  2. 36 6
      parser.ml
  3. 2 0
      typecore.ml
  4. 135 12
      typeload.ml
  5. 17 4
      typer.ml

+ 6 - 1
ast.ml

@@ -256,12 +256,17 @@ type ('a,'b) definition = {
 	d_data : 'b;
 }
 
+type import_mode =
+	| INormal
+	| IAsName of string
+	| IAll
+
 type type_def =
 	| EClass of (class_flag, class_field list) definition
 	| EEnum of (enum_flag, enum_constructor list) definition
 	| ETypedef of (enum_flag, complex_type) definition
 	| EAbstract of (abstract_flag, unit) definition
-	| EImport of type_path
+	| EImport of (string * pos) list * import_mode
 	| EUsing of type_path
 
 type type_decl = type_def * pos

+ 36 - 6
parser.ml

@@ -148,7 +148,7 @@ let lower_ident = parser
 
 let any_enum_ident = parser
 	| [< i = ident >] -> i
-	| [< '(Kwd k,p) when Filename.basename p.pfile = "StdTypes.hx" >] -> s_keyword k, p 
+	| [< '(Kwd k,p) when Filename.basename p.pfile = "StdTypes.hx" >] -> s_keyword k, p
 
 let property_ident = parser
 	| [< i, _ = ident >] -> i
@@ -191,14 +191,17 @@ and parse_type_decls pack acc s =
 		(* resolve imports *)
 		List.iter (fun d ->
 			match fst d with
-			| EImport t when (t.tsub = None && t.tname = name) -> raise (TypePath (t.tpackage,Some (name,false)))
+			| EImport (t,_) ->
+				(match List.rev t with
+				| (n,_) :: path when n = name && List.for_all (fun (i,_) -> is_lower_ident i) path -> raise (TypePath (List.map fst (List.rev path),Some (name,false)))
+				| _ -> ())
 			| _ -> ()
 		) acc;
 		raise (TypePath (pack,Some(name,true)))
 
 and parse_type_decl s =
 	match s with parser
-	| [< '(Kwd Import,p1); t = parse_type_path; p2 = semicolon >] -> EImport t, punion p1 p2
+	| [< '(Kwd Import,p1) >] -> parse_import s p1
 	| [< '(Kwd Using,p1); t = parse_type_path; p2 = semicolon >] -> EUsing t, punion p1 p2
 	| [< meta = parse_meta; c = parse_common_flags; s >] ->
 		match s with parser
@@ -243,6 +246,33 @@ and parse_type_decl s =
 				d_data = ();
 			},punion p1 p2)
 
+and parse_import s p1 =
+	let rec loop acc =
+		match s with parser
+		| [< '(Dot,p) >] ->
+			if is_resuming p then raise (TypePath (List.rev (List.map fst acc),None));
+			(match s with parser
+			| [< '(Const (Ident k),p) >] ->
+				loop ((k,p) :: acc)
+			| [< '(Binop OpMult,_); '(Semicolon,p2) >] ->
+				p2, List.rev acc, IAll
+			| [< '(Binop OpOr,_) when do_resume() >] ->
+				raise (TypePath (List.rev (List.map fst acc),None))
+			| [< >] ->
+				serror());
+		| [< '(Semicolon,p2) >] ->
+			p2, List.rev acc, INormal
+		| [< '(Binop OpAssign,_); '(Const (Ident name),_); '(Semicolon,p2) >] ->
+			p2, List.rev acc, IAsName name
+		| [< >] ->
+			serror()
+	in
+	let p2, path, mode = (match s with parser
+		| [< '(Const (Ident name),p) >] -> loop [name,p]
+		| [< >] -> serror()
+	) in
+	(EImport (path,mode),punion p1 p2)
+
 and parse_abstract_relations s =
 	match s with parser
 	| [< '(Binop OpLte,_); t = parse_complex_type >] -> ASuperType t
@@ -649,7 +679,7 @@ and expr = parser
 		(match Stream.npeek 1 s with
 		| [(DblDot,_)] ->
 			(match s with parser
-			| [< '(DblDot,_); t = parse_complex_type >] -> 
+			| [< '(DblDot,_); t = parse_complex_type >] ->
 				let t = snd (reify !in_macro) t p in
 				(ECheckType (t,(CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = Some "ComplexType"; tparams = [] })),p)
 			| [< >] -> serror())
@@ -851,7 +881,7 @@ and parse_macro_cond allow_op s =
 	| [< '(Kwd k,p) >] ->
 		parse_macro_ident allow_op (s_keyword k) p s
 	| [< '(POpen, p1); _,e = parse_macro_cond true; '(PClose, p2) >] ->
-		let e = (EParenthesis e,punion p1 p2) in 
+		let e = (EParenthesis e,punion p1 p2) in
 		if allow_op then parse_macro_op e s else None, e
 	| [< '(Unop op,p); tk, e = parse_macro_cond allow_op >] ->
 		tk, make_unop op e p
@@ -860,7 +890,7 @@ and parse_macro_ident allow_op t p s =
 	let e = (EConst (Ident t),p) in
 	if not allow_op then
 		None, e
-	else 
+	else
 		parse_macro_op e s
 
 and parse_macro_op e s =

+ 2 - 0
typecore.ml

@@ -70,6 +70,8 @@ and typer_module = {
 	curmod : module_def;
 	mutable module_types : module_type list;
 	mutable module_using : tclass list;
+	mutable module_globals : (string, (module_type * string)) PMap.t;
+	mutable wildcard_packages : string list list;
 }
 
 and typer = {

+ 135 - 12
typeload.ml

@@ -169,6 +169,21 @@ let rec load_type_def ctx p t =
 				with
 					Not_found -> raise (Error (Type_not_found (m.m_path,tname),p))
 			in
+			(* lookup in wildcard imported packages *)
+			try
+				if not no_pack then raise Exit;
+				let rec loop = function
+					| [] -> raise Exit
+					| wp :: l ->
+						try
+							load_type_def ctx p { t with tpackage = wp }
+						with
+							| Error (Module_not_found _,p2)
+							| Error (Type_not_found _,p2) when p == p2 -> loop l
+				in
+				loop ctx.m.wildcard_packages
+			with Exit ->
+			(* lookup in our own package - and its upper packages *)
 			let rec loop = function
 				| [] -> raise Exit
 				| (_ :: lnext) as l ->
@@ -414,7 +429,13 @@ and init_meta_overloads ctx cf =
 let hide_types ctx =
 	let old_m = ctx.m in
 	let old_type_params = ctx.type_params in
-	ctx.m <- { curmod = ctx.g.std; module_types = ctx.g.std.m_types; module_using = [] };
+	ctx.m <- {
+		curmod = ctx.g.std;
+		module_types = ctx.g.std.m_types;
+		module_using = [];
+		module_globals = PMap.empty;
+		wildcard_packages = [];
+	};
 	ctx.type_params <- [];
 	(fun() ->
 		ctx.m <- old_m;
@@ -1452,15 +1473,115 @@ let init_module_type ctx context_init do_init (decl,p) =
 		try List.find (fun t -> snd (t_infos t).mt_path = name) ctx.m.curmod.m_types with Not_found -> assert false
 	in
 	match decl with
-	| EImport t ->
-		(match t.tsub with
-		| None ->
-			let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
-			let types = List.filter (fun t -> not (t_infos t).mt_private) md.m_types in
-			ctx.m.module_types <- ctx.m.module_types @ types
-		| Some _ ->
-			let t = load_type_def ctx p t in
-			ctx.m.module_types <- ctx.m.module_types @ [t])
+	| EImport (path,mode) ->
+		let rec loop acc = function
+			| x :: l when is_lower_ident (fst x) -> loop (x::acc) l
+			| rest -> List.rev acc, rest
+		in
+		let pack, rest = loop [] path in
+		(match rest with
+		| [] ->
+			(match mode with
+			| IAll ->
+				ctx.m.wildcard_packages <- List.map fst pack :: ctx.m.wildcard_packages
+			| _ ->
+				(match List.rev path with
+				| [] -> assert false
+				| (_,p) :: _ -> error "Module name must start with an uppercase letter" p))
+		| (tname,p2) :: rest ->
+			let p1 = (match pack with [] -> p2 | (_,p1) :: _ -> p1) in
+			let p = punion p1 p2 in
+			let md = ctx.g.do_load_module ctx (List.map fst pack,tname) p in
+			let types = md.m_types in
+			let no_private t = not (t_infos t).mt_private in
+			let chk_private t p = if (t_infos t).mt_private then error "You can't import a private type" p in
+			let has_name name t = snd (t_infos t).mt_path = name in
+			let get_type tname =
+				let t = (try List.find (has_name tname) types with Not_found -> error ("Module " ^ s_type_path md.m_path ^ " does not define type " ^ tname) p) in
+				chk_private t p;
+				t
+			in
+			let rebind t name =
+				let _, _, f = ctx.g.do_build_instance ctx t p in
+				(* create a temp private typedef, does not register it in module *)
+				TTypeDecl {
+					t_path = (fst md.m_path @ ["_" ^ snd md.m_path],name);
+					t_module = md;
+					t_pos = p;
+					t_private = true;
+					t_doc = None;
+					t_meta = [];
+					t_types = (t_infos t).mt_types;
+					t_type = f (List.map snd (t_infos t).mt_types);
+				}
+			in
+			let add_static_init t name s =
+				let name = (match name with None -> s | Some n -> n) in
+				match resolve_typedef t with
+				| TClassDecl c ->
+					c.cl_build();
+					ignore(PMap.find s c.cl_statics);
+					ctx.m.module_globals <- PMap.add name (TClassDecl c,s) ctx.m.module_globals
+				| TEnumDecl e ->
+					ignore(PMap.find s e.e_constrs);
+					ctx.m.module_globals <- PMap.add name (TEnumDecl e,s) ctx.m.module_globals
+				| _ ->
+					raise Not_found
+			in
+			(match mode with
+			| INormal | IAsName _ ->
+				let name = (match mode with IAsName n -> Some n | _ -> None) in
+				(match rest with
+				| [] ->
+					(match name with
+					| None ->
+						ctx.m.module_types <- List.filter no_private types @ ctx.m.module_types
+					| Some newname ->
+						ctx.m.module_types <- rebind (get_type tname) newname :: ctx.m.module_types);
+				| [tsub,p2] ->
+					let p = punion p1 p2 in
+					(try
+						let tsub = List.find (has_name tsub) types in
+						chk_private tsub p;
+						ctx.m.module_types <- (match name with None -> tsub | Some n -> rebind tsub n) :: ctx.m.module_types
+					with Not_found ->
+						(* this might be a static property, wait later to check *)
+						let tmain = get_type tname in
+						context_init := (fun() ->
+							try
+								add_static_init tmain name tsub
+							with Not_found ->
+								error (s_type_path (t_infos tmain).mt_path ^ " has no field or subtype " ^ tsub) p
+						) :: !context_init)
+				| (tsub,p2) :: (fname,p3) :: rest ->
+					(match rest with
+					| [] -> ()
+					| (n,p) :: _ -> error ("Unexpected " ^ n) p);
+					let tsub = get_type tsub in
+					context_init := (fun() ->
+						try
+							add_static_init tsub name fname
+						with Not_found ->
+							error (s_type_path (t_infos tsub).mt_path ^ " has no field " ^ fname) (punion p p3)
+					) :: !context_init;
+				)
+			| IAll ->
+				let t = (match rest with
+					| [] -> get_type tname
+					| [tsub,_] -> get_type tsub
+					| _ :: (n,p) :: _ -> error ("Unexpected " ^ n) p
+				) in
+				context_init := (fun() ->
+					match resolve_typedef t with
+					| TClassDecl c ->
+						c.cl_build();
+						PMap.iter (fun _ cf -> ctx.m.module_globals <- PMap.add cf.cf_name (TClassDecl c,cf.cf_name) ctx.m.module_globals) c.cl_statics
+					| TEnumDecl e ->
+						PMap.iter (fun _ c -> ctx.m.module_globals <- PMap.add c.ef_name (TEnumDecl e,c.ef_name) ctx.m.module_globals) e.e_constrs
+					| _ ->
+						error "No statics to import from this type" p
+				) :: !context_init
+			))
 	| EUsing t ->
 		(* do the import first *)
 		let types = (match t.tsub with
@@ -1617,8 +1738,10 @@ let type_module ctx m file tdecls p =
 		t = ctx.t;
 		m = {
 			curmod = m;
-			module_types = ctx.g.std.m_types @ m.m_types;
+			module_types = m.m_types @ ctx.g.std.m_types;
 			module_using = [];
+			module_globals = PMap.empty;
+			wildcard_packages = [];
 		};
 		pass = PBuildModule;
 		on_error = (fun ctx msg p -> ctx.com.error msg p);
@@ -1724,7 +1847,7 @@ let parse_module ctx m p =
 			| ETypedef d -> build EPrivate d
 			| EAbstract d -> build APrivAbstract d
 			| EImport _ | EUsing _ -> acc
-		) [(EImport { tpackage = !remap; tname = snd m; tparams = []; tsub = None; },null_pos)] decls)
+		) [(EImport (List.map (fun s -> s,null_pos) (!remap @ [snd m]),INormal),null_pos)] decls)
 	else
 		decls
 

+ 17 - 4
typer.ml

@@ -651,7 +651,7 @@ let get_this ctx p =
 	| FConstructor | FMember ->
 		mk (TConst TThis) ctx.tthis p
 
-let type_ident_raise ?(imported_enums=true) ctx i p mode =
+let rec type_ident_raise ?(imported_enums=true) ctx i p mode =
 	match i with
 	| "true" ->
 		if mode = MGet then
@@ -726,7 +726,7 @@ let type_ident_raise ?(imported_enums=true) ctx i p mode =
 		let e = type_type ctx ctx.curclass.cl_path p in
 		(* check_locals_masking already done in type_type *)
 		field_access ctx mode f (field_type ctx ctx.curclass [] f p) e p
-	with Not_found ->
+	with Not_found -> try
 		if not imported_enums then raise Not_found;
 		(* lookup imported enums *)
 		let rec loop l =
@@ -752,8 +752,13 @@ let type_ident_raise ?(imported_enums=true) ctx i p mode =
 			AKNo i
 		else
 			AKExpr e
+	with Not_found ->
+		(* lookup imported globals *)
+		let t, name = PMap.find i ctx.m.module_globals in
+		let e = type_module_type ctx t None p in
+		type_field ctx e name p mode
 
-let rec type_field ctx e i p mode =
+and type_field ctx e i p mode =
 	let no_field() =
 		if not ctx.untyped then display_error ctx (s_type (print_context()) e.etype ^ " has no field " ^ i) p;
 		AKExpr (mk (TField (e,i)) (mk_mono()) p)
@@ -2938,7 +2943,13 @@ let load_macro ctx cpath f p =
 	let mctx = Interp.get_ctx() in
 	let m = (try Hashtbl.find ctx.g.types_module cpath with Not_found -> cpath) in
 	let mloaded = Typeload.load_module ctx2 m p in
-	ctx2.m <- { curmod = mloaded; module_types = mloaded.m_types; module_using = [] };
+	ctx2.m <- {
+		curmod = mloaded;
+		module_types = mloaded.m_types;
+		module_using = [];
+		module_globals = PMap.empty;
+		wildcard_packages = [];
+	};
 	add_dependency ctx.m.curmod mloaded;
 	let cl, meth = (match Typeload.load_instance ctx2 { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = None } p true with
 		| TInst (c,_) ->
@@ -3151,6 +3162,8 @@ let rec create com =
 			curmod = null_module;
 			module_types = [];
 			module_using = [];
+			module_globals = PMap.empty;
+			wildcard_packages = [];
 		};
 		pass = PBuildModule;
 		macro_depth = 0;