Browse Source

added haxe.macro.Compiler.addClassPath

Nicolas Cannasse 13 years ago
parent
commit
28ed03d574
3 changed files with 39 additions and 29 deletions
  1. 29 16
      interp.ml
  2. 5 1
      std/haxe/macro/Compiler.hx
  3. 5 12
      typer.ml

+ 29 - 16
interp.ml

@@ -16,6 +16,7 @@
  *  along with this program; if not, write to the Free Software
  *  along with this program; if not, write to the Free Software
  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  *)
  *)
+open Common
 open Nast
 open Nast
 open Unix
 open Unix
 open Type
 open Type
@@ -87,13 +88,10 @@ type cmp =
 
 
 type extern_api = {
 type extern_api = {
 	pos : Ast.pos;
 	pos : Ast.pos;
-	on_error : string -> Ast.pos -> bool -> unit;
-	define : string -> unit;
-	defined : string -> bool;
+	get_com : unit -> Common.context;
 	get_type : string -> Type.t option;
 	get_type : string -> Type.t option;
 	get_module : string -> Type.t list;
 	get_module : string -> Type.t list;
 	on_generate : (Type.t list -> unit) -> unit;
 	on_generate : (Type.t list -> unit) -> unit;
-	print : string -> unit;
 	parse_string : string -> Ast.pos -> Ast.expr;
 	parse_string : string -> Ast.pos -> Ast.expr;
 	typeof : Ast.expr -> Type.t;
 	typeof : Ast.expr -> Type.t;
 	type_patch : string -> string -> bool -> string option -> unit;
 	type_patch : string -> string -> bool -> string option -> unit;
@@ -660,7 +658,9 @@ let builtins =
 	(* misc *)
 	(* misc *)
 		"print", FunVar (fun vl -> List.iter (fun v ->
 		"print", FunVar (fun vl -> List.iter (fun v ->
 			let ctx = get_ctx() in
 			let ctx = get_ctx() in
-			ctx.curapi.print (ctx.do_string v)
+			let com = ctx.curapi.get_com() in
+			let str = ctx.do_string v in
+			if not com.display then print_string str
 		) vl; VNull);
 		) vl; VNull);
 		"throw", Fun1 (fun v -> exc v);
 		"throw", Fun1 (fun v -> exc v);
 		"rethrow", Fun1 (fun v ->
 		"rethrow", Fun1 (fun v ->
@@ -1690,35 +1690,41 @@ let macro_lib =
 	let error() =
 	let error() =
 		raise Builtin_error
 		raise Builtin_error
 	in
 	in
+	let ccom() =
+		(get_ctx()).curapi.get_com()
+	in
 	make_library [
 	make_library [
 		"curpos", Fun0 (fun() -> VAbstract (APos (get_ctx()).curapi.pos));
 		"curpos", Fun0 (fun() -> VAbstract (APos (get_ctx()).curapi.pos));
 		"error", Fun2 (fun msg p ->
 		"error", Fun2 (fun msg p ->
 			match msg, p with
 			match msg, p with
-			| VString s, VAbstract (APos p) -> (get_ctx()).curapi.on_error s p false; raise Abort
+			| VString s, VAbstract (APos p) ->
+				(ccom()).Common.error s p;
+				raise Abort
 			| _ -> error()
 			| _ -> error()
 		);
 		);
 		"warning", Fun2 (fun msg p ->
 		"warning", Fun2 (fun msg p ->
 			match msg, p with
 			match msg, p with
-			| VString s, VAbstract (APos p) -> (get_ctx()).curapi.on_error s p true; VNull;
+			| VString s, VAbstract (APos p) ->
+				(ccom()).warning s p;
+				VNull;
 			| _ -> error()
 			| _ -> error()
 		);
 		);
 		"class_path", Fun0 (fun() ->
 		"class_path", Fun0 (fun() ->
-			let cp = (get_ctx()).com.Common.class_path in
-			VArray (Array.of_list (List.map (fun s -> VString s) cp));
+			VArray (Array.of_list (List.map (fun s -> VString s) (ccom()).class_path));
 		);
 		);
 		"resolve", Fun1 (fun file ->
 		"resolve", Fun1 (fun file ->
 			match file with
 			match file with
-			| VString s -> VString (try Common.find_file (get_ctx()).com s with Not_found -> failwith ("File not found '" ^ s ^ "'"))
+			| VString s -> VString (try Common.find_file (ccom()) s with Not_found -> failwith ("File not found '" ^ s ^ "'"))
 			| _ -> error();
 			| _ -> error();
 		);
 		);
 		"define", Fun1 (fun s ->
 		"define", Fun1 (fun s ->
 			match s with
 			match s with
-			| VString s -> (get_ctx()).curapi.define s; VNull
+			| VString s -> Common.define (ccom()) s; VNull
 			| _ -> error();
 			| _ -> error();
 		);
 		);
 		"defined", Fun1 (fun s ->
 		"defined", Fun1 (fun s ->
 			match s with
 			match s with
-			| VString s -> VBool ((get_ctx()).curapi.defined s)
+			| VString s -> VBool (Common.defined (ccom()) s)
 			| _ -> error();
 			| _ -> error();
 		);
 		);
 		"get_type", Fun1 (fun s ->
 		"get_type", Fun1 (fun s ->
@@ -1910,9 +1916,7 @@ let macro_lib =
 		);
 		);
 		"add_resource", Fun2 (fun name data ->
 		"add_resource", Fun2 (fun name data ->
 			match name, data with
 			match name, data with
-			| VString name, VString data ->
-				(* ressources are shared between the commons *)
-				Hashtbl.replace (get_ctx()).com.Common.resources name data; VNull
+			| VString name, VString data -> Hashtbl.replace (ccom()).resources name data; VNull
 			| _ -> error()
 			| _ -> error()
 		);
 		);
 		"local_type", Fun0 (fun() ->
 		"local_type", Fun0 (fun() ->
@@ -1944,6 +1948,15 @@ let macro_lib =
 			(get_ctx()).curapi.define_type v;
 			(get_ctx()).curapi.define_type v;
 			VNull
 			VNull
 		);
 		);
+		"add_class_path", Fun1 (fun v ->
+			match v with
+			| VString cp ->
+				let com = ccom() in
+				com.class_path <- cp :: com.class_path;
+				VNull
+			| _ ->
+				error()
+		);
 	]
 	]
 
 
 (* ---------------------------------------------------------------------- *)
 (* ---------------------------------------------------------------------- *)
@@ -2672,7 +2685,7 @@ let rec to_string ctx n v =
 	| VBool true -> "true"
 	| VBool true -> "true"
 	| VBool false -> "false"
 	| VBool false -> "false"
 	| VInt i -> string_of_int i
 	| VInt i -> string_of_int i
-	| VFloat f -> 
+	| VFloat f ->
 		let s = string_of_float f in
 		let s = string_of_float f in
 		let len = String.length s in
 		let len = String.length s in
 		if String.unsafe_get s (len - 1) = '.' then String.sub s 0 (len - 1) else s
 		if String.unsafe_get s (len - 1) = '.' then String.sub s 0 (len - 1) else s

+ 5 - 1
std/haxe/macro/Compiler.hx

@@ -38,7 +38,7 @@ class Compiler {
 	public static function define( flag : String ) {
 	public static function define( flag : String ) {
 		untyped load("define", 1)(flag.__s);
 		untyped load("define", 1)(flag.__s);
 	}
 	}
-	
+
 	public static function removeField( className : String, field : String, ?isStatic : Bool ) {
 	public static function removeField( className : String, field : String, ?isStatic : Bool ) {
 		if( !path.match(className) ) throw "Invalid "+className;
 		if( !path.match(className) ) throw "Invalid "+className;
 		if( !ident.match(field) ) throw "Invalid "+field;
 		if( !ident.match(field) ) throw "Invalid "+field;
@@ -57,6 +57,10 @@ class Compiler {
 		untyped load("meta_patch",4)(meta.__s,className.__s,(field == null)?null:field.__s,isStatic == true);
 		untyped load("meta_patch",4)(meta.__s,className.__s,(field == null)?null:field.__s,isStatic == true);
 	}
 	}
 
 
+	public static function addClassPath( path : String ) {
+		untyped load("add_class_path",1)(path.__s);
+	}
+
 	/**
 	/**
 		Include for compilation all classes defined in the given package excluding the ones referenced in the ignore list.
 		Include for compilation all classes defined in the given package excluding the ones referenced in the ignore list.
 	**/
 	**/

+ 5 - 12
typer.ml

@@ -295,7 +295,7 @@ let make_call ctx e params t p =
 			| _ -> raise Exit
 			| _ -> raise Exit
 		) in
 		) in
 		if ctx.com.display || f.cf_kind <> Method MethInline then raise Exit;
 		if ctx.com.display || f.cf_kind <> Method MethInline then raise Exit;
-		let is_extern = (match cl with 
+		let is_extern = (match cl with
 			| Some { cl_extern = true } -> true
 			| Some { cl_extern = true } -> true
 			| _ when has_meta ":extern" f.cf_meta -> true
 			| _ when has_meta ":extern" f.cf_meta -> true
 			| _ -> false
 			| _ -> false
@@ -1686,7 +1686,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				if follow pt != t_dynamic then error "Cast type parameters must be Dynamic" p;
 				if follow pt != t_dynamic then error "Cast type parameters must be Dynamic" p;
 			) params;
 			) params;
 			(match follow t with
 			(match follow t with
-			| TInst (c,_) -> 
+			| TInst (c,_) ->
 				if c.cl_kind = KTypeParameter then error "Can't cast to a type parameter" p;
 				if c.cl_kind = KTypeParameter then error "Can't cast to a type parameter" p;
 				TClassDecl c
 				TClassDecl c
 			| TEnum (e,_) -> TEnumDecl e
 			| TEnum (e,_) -> TEnumDecl e
@@ -1760,13 +1760,13 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		else match fields with
 		else match fields with
 			| [] -> e.etype
 			| [] -> e.etype
 			| _ ->
 			| _ ->
-				let get_field acc f = 
+				let get_field acc f =
 					if not f.cf_public then acc else (f.cf_name,f.cf_type,f.cf_doc) :: List.map (fun t -> f.cf_name,t,f.cf_doc) (get_overloads ctx p f.cf_meta) @ acc
 					if not f.cf_public then acc else (f.cf_name,f.cf_type,f.cf_doc) :: List.map (fun t -> f.cf_name,t,f.cf_doc) (get_overloads ctx p f.cf_meta) @ acc
 				in
 				in
 				raise (DisplayFields (List.fold_left get_field [] fields))
 				raise (DisplayFields (List.fold_left get_field [] fields))
 		) in
 		) in
 		(match follow t with
 		(match follow t with
-		| TMono _ | TDynamic _ when ctx.in_macro -> mk (TConst TNull) t p		
+		| TMono _ | TDynamic _ when ctx.in_macro -> mk (TConst TNull) t p
 		| _ -> raise (DisplayTypes [t]))
 		| _ -> raise (DisplayTypes [t]))
 	| EDisplayNew t ->
 	| EDisplayNew t ->
 		let t = Typeload.load_instance ctx t p true in
 		let t = Typeload.load_instance ctx t p true in
@@ -2161,11 +2161,7 @@ let make_macro_api ctx p =
 	in
 	in
 	{
 	{
 		Interp.pos = p;
 		Interp.pos = p;
-		Interp.on_error = (fun msg p warn ->
-			(if warn then ctx.com.warning else ctx.com.error) msg p
-		);
-		Interp.defined = Common.defined ctx.com;
-		Interp.define = Common.define ctx.com;
+		Interp.get_com = (fun() -> ctx.com);
 		Interp.get_type = (fun s ->
 		Interp.get_type = (fun s ->
 			typing_timer ctx (fun() ->
 			typing_timer ctx (fun() ->
 				let path = parse_path s in
 				let path = parse_path s in
@@ -2221,9 +2217,6 @@ let make_macro_api ctx p =
 			let tp = get_type_patch ctx t (match f with None -> None | Some f -> Some (f,s)) in
 			let tp = get_type_patch ctx t (match f with None -> None | Some f -> Some (f,s)) in
 			tp.tp_meta <- tp.tp_meta @ m;
 			tp.tp_meta <- tp.tp_meta @ m;
 		);
 		);
-		Interp.print = (fun s ->
-			if not ctx.com.display then print_string s
-		);
 		Interp.set_js_generator = (fun gen ->
 		Interp.set_js_generator = (fun gen ->
 			let js_ctx = Genjs.alloc_ctx ctx.com in
 			let js_ctx = Genjs.alloc_ctx ctx.com in
 			ctx.com.js_gen <- Some (fun() ->
 			ctx.com.js_gen <- Some (fun() ->