Explorar el Código

Merge branch 'development' of https://github.com/HaxeFoundation/haxe into development

Hugh hace 12 años
padre
commit
7f37884f98
Se han modificado 6 ficheros con 112 adiciones y 92 borrados
  1. 2 2
      gencpp.ml
  2. 1 1
      matcher.ml
  3. 1 0
      std/haxe/macro/Build.hx
  4. 20 20
      std/sys/FileSystem.hx
  5. 73 69
      typeload.ml
  6. 15 0
      typer.ml

+ 2 - 2
gencpp.ml

@@ -1169,10 +1169,10 @@ let hx_stack_push ctx output clazz func_name pos =
 	ctx.ctx_file_info := PMap.add qfile qfile !(ctx.ctx_file_info);
 	if (ctx.ctx_dump_stack_line) then begin
       let hash_class_func = gen_hash 0 (clazz^"."^func_name) in
-      let hash_file_line = gen_hash (Lexer.get_error_line pos) stripped_file in
+      let hash_file = gen_hash 0 stripped_file in
 		output ("HX_STACK_FRAME(\"" ^ clazz ^ "\",\"" ^ func_name ^ "\"," ^ hash_class_func ^ ",\"" ^
                 clazz ^ "." ^ func_name ^ "\"," ^ qfile ^ "," ^
-			    (string_of_int (Lexer.get_error_line pos) ) ^  "," ^ hash_file_line ^ ")\n")
+			    (string_of_int (Lexer.get_error_line pos) ) ^  "," ^ hash_file ^ ")\n")
    end
 ;;
 

+ 1 - 1
matcher.ml

@@ -757,7 +757,7 @@ let rec all_ctors mctx t =
 	| TAbstract({a_impl = Some c} as a,pl) when Meta.has Meta.FakeEnum a.a_meta ->
 		List.iter (fun cf ->
 			ignore(follow cf.cf_type);
-			if not (Meta.has Meta.Impl cf.cf_meta) then match cf.cf_expr with
+			if Meta.has Meta.Impl cf.cf_meta then match cf.cf_expr with
 				| Some {eexpr = TConst c | TCast ({eexpr = TConst c},None)} -> h := PMap.add (CConst c) cf.cf_pos !h
 				| _ -> ()
 		) c.cl_ordered_statics;

+ 1 - 0
std/haxe/macro/Build.hx

@@ -46,6 +46,7 @@ class Build {
 					if (e == null) Context.error("Value required", field.pos);
 					var tE = Context.typeof(e);
 					if (!Context.unify(tE, tThis)) Context.error('${tE.toString()} should be ${tThis.toString()}', e.pos);
+					field.meta.push({name: ":impl", params: [], pos: field.pos});
 					field.kind = FVar(ctA, macro cast $e);
 				case _:
 			}

+ 20 - 20
std/sys/FileSystem.hx

@@ -23,24 +23,24 @@ package sys;
 
 /**
 	This class allows you to get information about the files and directories.
-	
+
 	See `sys.io.File` for the complementary file API.
 **/
 extern class FileSystem {
 
 	/**
 		Tells if the file or directory specified by `path` exists.
-		
+
 		If `path` is null, the result is unspecified.
 	**/
 	static function exists( path : String ) : Bool;
 
 	/**
 		Renames/moves the file or directory specified by `path` to `newPath`.
-		
+
 		If `path` is not a valid file system entry, or if it is not accessible,
 		or if `newPath` is not accessible, an exception is thrown.
-		
+
 		If `path` or `newPath` are null, the result is unspecified.
 	**/
 	static function rename( path : String, newPath : String ) : Void;
@@ -48,7 +48,7 @@ extern class FileSystem {
 	/**
 		Returns `FileStat` information on the file or directory specified by
 		`path`.
-		
+
 		If `path` is null, the result is unspecified.
 	**/
 	static function stat( path : String ) : FileStat;
@@ -56,48 +56,48 @@ extern class FileSystem {
 	/**
 		Returns the full path of the file or directory specified by `relPath`,
 		which is relative to the current working directory.
-		
+
 		If `relPath` is null, the result is unspecified.
 	**/
 	static function fullPath( relPath : String ) : String;
 
 	/**
 		Tells if the file or directory specified by `path` is a directory.
-		
+
 		If `path` is not a valid file system entry or if its destination is no
 		accessible, an exception is thrown.
-		
+
 		If `path` is null, the result is unspecified.
 	**/
 	static function isDirectory( path : String ) : Bool;
 
-	/**	
+	/**
 		Creates a directory specified by `path`.
-		
-		This method is not recursive: All parent directories must exist.
-		
+
+		This method is recursive: The parent directories don't have to exist.
+
 		If the directory cannot be created, an exception is thrown.
-		
+
 		If `path` is null, the result is unspecified.
 	**/
 	static function createDirectory( path : String ) : Void;
 
 	/**
 		Deletes the file specified by `path`.
-		
+
 		If `path` does not denote a valid file, or if that file cannot be
 		deleted, an exception is thrown.
-		
+
 		If `path` is null, the result is unspecified.
 	**/
 	static function deleteFile( path : String ) : Void;
-	
+
 	/**
 		Deletes the directory specified by `path`.
-		
+
 		If `path` does not denote a valid directory, or if that directory cannot
 		be deleted, an exception is thrown.
-		
+
 		If `path` is null, the result is unspecified.
 	**/
 	static function deleteDirectory( path : String ) : Void;
@@ -105,9 +105,9 @@ extern class FileSystem {
 	/**
 		Returns the names of all files and directory in the directory specified
 		by `path`.
-		
+
 		If `path` does not denote a valid directory, an exception is thrown.
-		
+
 		If `path` is null, the result is unspecified.
 	**/
 	static function readDirectory( path : String ) : Array<String>;

+ 73 - 69
typeload.ml

@@ -1199,7 +1199,7 @@ let type_function ctx args ret fmode f do_display p =
 	ctx.opened <- old_opened;
 	e , fargs
 
-let init_core_api ctx c =
+let load_core_class ctx c =
 	let ctx2 = (match ctx.g.core_api with
 		| None ->
 			let com2 = Common.clone ctx.com in
@@ -1222,75 +1222,79 @@ let init_core_api ctx c =
 	flush_pass ctx2 PFinal "core_final";
 	match t with
 	| TInst (ccore,_) | TAbstract({a_impl = Some ccore}, _) ->
-		begin try
-			List.iter2 (fun (n1,t1) (n2,t2) -> match follow t1, follow t2 with
-				| TInst({cl_kind = KTypeParameter l1},_),TInst({cl_kind = KTypeParameter l2},_) ->
-					begin try
-						List.iter2 (fun t1 t2 -> type_eq EqCoreType t2 t1) l1 l2
-					with
-						| Invalid_argument _ ->
-							error "Type parameters must have the same number of constraints as core type" c.cl_pos
-						| Unify_error l ->
-							display_error ctx ("Type parameter " ^ n2 ^ " has different constraint than in core type") c.cl_pos;
-							display_error ctx (error_msg (Unify l)) c.cl_pos
-					end
-				| t1,t2 ->
-					Printf.printf "%s %s" (s_type (print_context()) t1) (s_type (print_context()) t2);
-					assert false
-			) ccore.cl_types c.cl_types;
-		with Invalid_argument _ ->
-			error "Class must have the same number of type parameters as core type" c.cl_pos
-		end;
-		(match c.cl_doc with
-		| None -> c.cl_doc <- ccore.cl_doc
+		ccore
+	| _ ->
+		assert false
+
+let init_core_api ctx c =
+	let ccore = load_core_class ctx c in
+	begin try
+		List.iter2 (fun (n1,t1) (n2,t2) -> match follow t1, follow t2 with
+			| TInst({cl_kind = KTypeParameter l1},_),TInst({cl_kind = KTypeParameter l2},_) ->
+				begin try
+					List.iter2 (fun t1 t2 -> type_eq EqCoreType t2 t1) l1 l2
+				with
+					| Invalid_argument _ ->
+						error "Type parameters must have the same number of constraints as core type" c.cl_pos
+					| Unify_error l ->
+						display_error ctx ("Type parameter " ^ n2 ^ " has different constraint than in core type") c.cl_pos;
+						display_error ctx (error_msg (Unify l)) c.cl_pos
+				end
+			| t1,t2 ->
+				Printf.printf "%s %s" (s_type (print_context()) t1) (s_type (print_context()) t2);
+				assert false
+		) ccore.cl_types c.cl_types;
+	with Invalid_argument _ ->
+		error "Class must have the same number of type parameters as core type" c.cl_pos
+	end;
+	(match c.cl_doc with
+	| None -> c.cl_doc <- ccore.cl_doc
+	| Some _ -> ());
+	let compare_fields f f2 =
+		let p = (match f2.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
+		(try
+			type_eq EqCoreType (apply_params ccore.cl_types (List.map snd c.cl_types) f.cf_type) f2.cf_type
+		with Unify_error l ->
+			display_error ctx ("Field " ^ f.cf_name ^ " has different type than in core type") p;
+			display_error ctx (error_msg (Unify l)) p);
+		if f2.cf_public <> f.cf_public then error ("Field " ^ f.cf_name ^ " has different visibility than core type") p;
+		(match f2.cf_doc with
+		| None -> f2.cf_doc <- f.cf_doc
 		| Some _ -> ());
-		let compare_fields f f2 =
-			let p = (match f2.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
-			(try
-				type_eq EqCoreType (apply_params ccore.cl_types (List.map snd c.cl_types) f.cf_type) f2.cf_type
-			with Unify_error l ->
-				display_error ctx ("Field " ^ f.cf_name ^ " has different type than in core type") p;
-				display_error ctx (error_msg (Unify l)) p);
-			if f2.cf_public <> f.cf_public then error ("Field " ^ f.cf_name ^ " has different visibility than core type") p;
-			(match f2.cf_doc with
-			| None -> f2.cf_doc <- f.cf_doc
-			| Some _ -> ());
-			if f2.cf_kind <> f.cf_kind then begin
-				match f2.cf_kind, f.cf_kind with
-				| Method MethInline, Method MethNormal -> () (* allow to add 'inline' *)
-				| Method MethNormal, Method MethInline -> () (* allow to disable 'inline' *)
-				| _ ->
-					error ("Field " ^ f.cf_name ^ " has different property access than core type") p;
-			end;
-			(match follow f.cf_type, follow f2.cf_type with
-			| TFun (pl1,_), TFun (pl2,_) ->
-				if List.length pl1 != List.length pl2 then error "Argument count mismatch" p;
-				List.iter2 (fun (n1,_,_) (n2,_,_) ->
-					if n1 <> n2 then error ("Method parameter name '" ^ n2 ^ "' should be '" ^ n1 ^ "'") p;
-				) pl1 pl2;
-			| _ -> ());
-		in
-		let check_fields fcore fl =
-			PMap.iter (fun i f ->
-				if not f.cf_public then () else
-				let f2 = try PMap.find f.cf_name fl with Not_found -> error ("Missing field " ^ i ^ " required by core type") c.cl_pos in
-				compare_fields f f2;
-			) fcore;
-			PMap.iter (fun i f ->
-				let p = (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
-				if f.cf_public && not (Meta.has Meta.Hack f.cf_meta) && not (PMap.mem f.cf_name fcore) && not (List.memq f c.cl_overrides) then error ("Public field " ^ i ^ " is not part of core type") p;
-			) fl;
-		in
-		check_fields ccore.cl_fields c.cl_fields;
-		check_fields ccore.cl_statics c.cl_statics;
-		(match ccore.cl_constructor, c.cl_constructor with
-		| None, None -> ()
-		| Some { cf_public = false }, _ -> ()
-		| Some f, Some f2 -> compare_fields f f2
-		| None, Some { cf_public = false } -> ()
-		| _ -> error "Constructor differs from core type" c.cl_pos)
-
-	| _ -> assert false
+		if f2.cf_kind <> f.cf_kind then begin
+			match f2.cf_kind, f.cf_kind with
+			| Method MethInline, Method MethNormal -> () (* allow to add 'inline' *)
+			| Method MethNormal, Method MethInline -> () (* allow to disable 'inline' *)
+			| _ ->
+				error ("Field " ^ f.cf_name ^ " has different property access than core type") p;
+		end;
+		(match follow f.cf_type, follow f2.cf_type with
+		| TFun (pl1,_), TFun (pl2,_) ->
+			if List.length pl1 != List.length pl2 then error "Argument count mismatch" p;
+			List.iter2 (fun (n1,_,_) (n2,_,_) ->
+				if n1 <> n2 then error ("Method parameter name '" ^ n2 ^ "' should be '" ^ n1 ^ "'") p;
+			) pl1 pl2;
+		| _ -> ());
+	in
+	let check_fields fcore fl =
+		PMap.iter (fun i f ->
+			if not f.cf_public then () else
+			let f2 = try PMap.find f.cf_name fl with Not_found -> error ("Missing field " ^ i ^ " required by core type") c.cl_pos in
+			compare_fields f f2;
+		) fcore;
+		PMap.iter (fun i f ->
+			let p = (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
+			if f.cf_public && not (Meta.has Meta.Hack f.cf_meta) && not (PMap.mem f.cf_name fcore) && not (List.memq f c.cl_overrides) then error ("Public field " ^ i ^ " is not part of core type") p;
+		) fl;
+	in
+	check_fields ccore.cl_fields c.cl_fields;
+	check_fields ccore.cl_statics c.cl_statics;
+	(match ccore.cl_constructor, c.cl_constructor with
+	| None, None -> ()
+	| Some { cf_public = false }, _ -> ()
+	| Some f, Some f2 -> compare_fields f f2
+	| None, Some { cf_public = false } -> ()
+	| _ -> error "Constructor differs from core type" c.cl_pos)
 
 let patch_class ctx c fields =
 	let h = (try Some (Hashtbl.find ctx.g.type_patches c.cl_path) with Not_found -> None) in

+ 15 - 0
typer.ml

@@ -2989,9 +2989,22 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			| _ ->
 				t
 		in
+		let merge_core_doc c =
+			let c_core = Typeload.load_core_class ctx c in
+			if c.cl_doc = None then c.cl_doc <- c_core.cl_doc;
+			let maybe_merge cf_map cf =
+				if cf.cf_doc = None then try cf.cf_doc <- (PMap.find cf.cf_name cf_map).cf_doc with Not_found -> ()
+			in
+			List.iter (maybe_merge c_core.cl_fields) c.cl_ordered_fields;
+			List.iter (maybe_merge c_core.cl_statics) c.cl_ordered_statics;
+			match c.cl_constructor,c_core.cl_constructor with
+				| Some ({cf_doc = None} as cf),Some cf2 -> cf.cf_doc <- cf2.cf_doc
+				| _ -> ()
+		in
 		let rec get_fields t =
 			match follow t with
 			| TInst (c,params) ->
+				if Meta.has Meta.CoreApi c.cl_meta then merge_core_doc c;
 				let priv = is_parent c ctx.curclass in
 				let merge ?(cond=(fun _ -> true)) a b =
 					PMap.foldi (fun k f m -> if cond f then PMap.add k f m else m) a b
@@ -3013,6 +3026,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 				in
 				loop c params
 			| TAbstract({a_impl = Some c} as a,pl) ->
+				if Meta.has Meta.CoreApi c.cl_meta then merge_core_doc c;
 				ctx.m.module_using <- c :: ctx.m.module_using;
 				PMap.fold (fun f acc ->
 					if f.cf_name <> "_new" && can_access ctx c f true && Meta.has Meta.Impl f.cf_meta then begin
@@ -3025,6 +3039,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 			| TAnon a ->
 				(match !(a.a_status) with
 				| Statics c ->
+					if Meta.has Meta.CoreApi c.cl_meta then merge_core_doc c;
 					let pm = match c.cl_constructor with None -> PMap.empty | Some cf -> PMap.add "new" cf PMap.empty in
 					PMap.fold (fun f acc -> if can_access ctx c f true then PMap.add f.cf_name { f with cf_public = true; cf_type = opt_type f.cf_type } acc else acc) a.a_fields pm
 				| _ ->