Ver Fonte

Reflect.fields ok, started Type.typeof

Nicolas Cannasse há 9 anos atrás
pai
commit
b552ed4add
4 ficheiros alterados com 64 adições e 29 exclusões
  1. 39 21
      genhl.ml
  2. 9 5
      std/hl/_std/Reflect.hx
  3. 15 2
      std/hl/_std/Type.hx
  4. 1 1
      std/hl/types/Type.hx

+ 39 - 21
genhl.ml

@@ -368,6 +368,7 @@ let is_array_type t =
 let rec safe_cast t1 t2 =
 	if t1 == t2 then true else
 	match t1, t2 with
+	| HVirtual _, HDyn -> false
 	| _, HDyn -> is_dynamic t1
 	| HVirtual v1, HVirtual v2 when Array.length v2.vfields < Array.length v1.vfields ->
 		let rec loop i =
@@ -565,7 +566,8 @@ let rec to_type ctx t =
 	| TFun (args, ret) ->
 		HFun (List.map (fun (_,o,t) -> to_type ctx (if o then ctx.com.basic.tnull t else t)) args, to_type ctx ret)
 	| TAnon a when (match !(a.a_status) with Statics c -> true | _ -> false) ->
-		class_type ctx (match !(a.a_status) with Statics c -> c | _ -> assert false) [] true
+		let c = (match !(a.a_status) with Statics c -> c | _ -> assert false) in
+		class_type ctx c (List.map snd c.cl_params) true
 	| TAnon a when (match !(a.a_status) with EnumStatics _ -> true | _ -> false) ->
 		HType
 	| TAnon a ->
@@ -643,13 +645,15 @@ let rec to_type ctx t =
 		else
 			to_type ctx (Abstract.get_underlying_type a pl)
 
-and resolve_class ctx c pl =
+and resolve_class ctx c pl statics =
 	let not_supported() =
 		failwith ("Extern type not supported : " ^ s_type (print_context()) (TInst (c,pl)))
 	in
 	match c.cl_path, pl with
 	| ([],"Array"), [t] ->
-		array_class ctx (to_type ctx t)
+		if statics then ctx.array_impl.abase else array_class ctx (to_type ctx t)
+	| ([],"Array"), [] ->
+		assert false
 	| _, _ when c.cl_extern ->
 		not_supported()
 	| _ ->
@@ -658,7 +662,7 @@ and resolve_class ctx c pl =
 and field_type ctx f p =
 	match f with
 	| FInstance (c,pl,f) ->
-		let creal = resolve_class ctx c pl in
+		let creal = resolve_class ctx c pl false in
 		let rec loop c =
 			try
 				PMap.find f.cf_name c.cl_fields
@@ -673,7 +677,7 @@ and field_type ctx f p =
 	| FEnum (_,f) -> f.ef_type
 
 and class_type ctx c pl statics =
-	let c = if c.cl_extern && not statics then resolve_class ctx c pl else c in
+	let c = if c.cl_extern then resolve_class ctx c pl statics else c in
 	let key_path = (if statics then fst c.cl_path, "$" ^ snd c.cl_path else c.cl_path) in
 	try
 		PMap.find key_path ctx.cached_types
@@ -704,6 +708,7 @@ and class_type ctx c pl statics =
 		} in
 		let t = HObj p in
 		ctx.cached_types <- PMap.add key_path t ctx.cached_types;
+		if c.cl_path = ([],"Array") then assert false;
 		if c == ctx.base_class then begin
 			if statics then assert false;
 			p.pnfields <- 1;
@@ -806,6 +811,7 @@ and alloc_global ctx name t =
 	lookup ctx.cglobals name (fun() -> t)
 
 and class_global ctx c =
+	let c = resolve_class ctx c (List.map snd c.cl_params) true in
 	let t = class_type ctx c [] true in
 	alloc_global ctx ("$" ^ s_type_path c.cl_path) t, t
 
@@ -918,6 +924,8 @@ let common_type ctx e1 e2 for_eq p =
 		| _, HDyn -> HDyn
 		| _ when for_eq && safe_cast t1 t2 -> t2
 		| _ when for_eq && safe_cast t2 t1 -> t1
+		| HBool, HNull HBool when for_eq -> t2
+		| HNull HBool, HBool when for_eq -> t1
 		| _ ->
 			error ("Don't know how to compare " ^ tstr t1 ^ " and " ^ tstr t2) p
 	in
@@ -1073,7 +1081,7 @@ and get_access ctx e =
 			AStaticFun (alloc_fid ctx c f)
 		| FClosure (Some (cdef,pl), ({ cf_kind = Method m } as f)), TInst (c,_)
 		| FInstance (cdef,pl,({ cf_kind = Method m } as f)), TInst (c,_) when m <> MethDynamic && not (c.cl_interface || is_overriden ctx c f) ->
-			AInstanceFun (ethis, alloc_fid ctx (resolve_class ctx cdef pl) f)
+			AInstanceFun (ethis, alloc_fid ctx (resolve_class ctx cdef pl false) f)
 		| FInstance (cdef,pl,f), _ | FClosure (Some (cdef,pl), f), _ ->
 			object_access ctx ethis (class_type ctx cdef pl false) f
 		| FClosure (None,_), _ ->
@@ -1605,7 +1613,7 @@ and eval_expr ctx e =
 		) o;
 		cast_to ctx r (to_type ctx e.etype) e.epos
 	| TNew (c,pl,el) ->
-		let c = resolve_class ctx c pl in
+		let c = resolve_class ctx c pl false in
 		let r = alloc_tmp ctx (class_type ctx c pl false) in
 		op ctx (ONew r);
 		(match c.cl_constructor with
@@ -2489,7 +2497,22 @@ let generate_static_init ctx =
 				op ctx (OType (rt, class_type ctx c (List.map snd c.cl_params) false));
 				op ctx (OSetField (rc,0,rt));
 				op ctx (OSetField (rc,1,eval_expr ctx { eexpr = TConst (TString (s_type_path c.cl_path)); epos = c.cl_pos; etype = ctx.com.basic.tstring }));
-			| _ -> ()
+
+			| TEnumDecl e when not e.e_extern ->
+				List.iter (fun n ->
+					let f = PMap.find n e.e_constrs in
+					match follow f.ef_type with
+					| TFun _ -> ()
+					| _ ->
+						let t = to_type ctx f.ef_type in
+						let g = alloc_global ctx (efield_name e f) t in
+						let r = alloc_tmp ctx t in
+						op ctx (OMakeEnum (r,f.ef_index,[]));
+						op ctx (OSetGlobal (g,r));
+				) e.e_names
+
+			| _ ->
+				()
 
 		) ctx.com.types;
 	in
@@ -2506,18 +2529,6 @@ let generate_static_init ctx =
 				| _ ->
 					()
 			) c.cl_ordered_statics;
-		| TEnumDecl e when not e.e_extern ->
-			List.iter (fun n ->
-				let f = PMap.find n e.e_constrs in
-				match follow f.ef_type with
-				| TFun _ -> ()
-				| _ ->
-					let t = to_type ctx f.ef_type in
-					let g = alloc_global ctx (efield_name e f) t in
-					let r = alloc_tmp ctx t in
-					op ctx (OMakeEnum (r,f.ef_index,[]));
-					op ctx (OSetGlobal (g,r));
-			) e.e_names
 		| _ -> ()
 	) ctx.com.types;
 	(* call main() *)
@@ -3771,6 +3782,7 @@ let interp code =
 				set r (VType t)
 			| OGetType (r,v) ->
 				let v = get v in
+				let v = (match v with VVirtual v -> v.vvalue | _ -> v) in
 				set r (VType (if v = VNull then HVoid else match get_type v with None -> assert false | Some t -> t));
 			| OGetTID (r,v) ->
 				set r (match get v with
@@ -4085,6 +4097,12 @@ let interp code =
 				(function
 				| [VObj o] -> (match o.oproto.pclass.pclassglobal with None -> VNull | Some g -> globals.(g))
 				| _ -> VNull)
+			| "obj_fields" ->
+				(function
+				| [VDynObj o] ->
+					VArray (Array.of_list (Hashtbl.fold (fun n _ acc -> VBytes (caml_to_hl n) :: acc) o.dfields []), HBytes)
+				| _ ->
+					VNull)
 			| "type_instance_fields" ->
 				(function
 				| [VType t] ->
@@ -4957,7 +4975,7 @@ let generate com =
 	Array.sort (fun (lib1,_,_,_) (lib2,_,_,_) -> lib1 - lib2) code.natives;
 	if Common.defined com Define.Dump then Std.output_file "dump/hlcode.txt" (dump code);
 	PMap.iter (fun (s,p) fid ->
-		if not (Hashtbl.mem ctx.defined_funs fid) then failwith ("Unresolved method " ^ s_type_path p ^ ":" ^ s)
+		if not (Hashtbl.mem ctx.defined_funs fid) then failwith (Printf.sprintf "Unresolved method %s:%s(@%d)" (s_type_path p) s fid)
 	) ctx.cfids.map;
 	check code;
 	let ch = IO.output_string() in

+ 9 - 5
std/hl/_std/Reflect.hx

@@ -65,14 +65,18 @@ class Reflect {
 		return hl.types.Api.callMethod(func,a);
 	}
 
-	public static function fields( o : Dynamic ) : Array<String> {
-		throw "TODO";
+	@:hlNative("std","obj_fields") static function getObjectFields( v : Dynamic ) : hl.types.NativeArray<hl.types.Bytes> {
 		return null;
 	}
 
-	public static function isFunction( f : Dynamic ) : Bool {
-		throw "TODO";
-		return false;
+	public static function fields( o : Dynamic ) : Array<String> {
+		var fields = getObjectFields(o);
+		if( fields == null ) return [];
+		return [for( f in fields ) @:privateAccess String.__alloc__(f,f.ucs2Length(0))];
+	}
+
+	public static inline function isFunction( f : Dynamic ) : Bool {
+		return hl.types.Type.getDynamic(f).kind == HFun;
 	}
 
 	@:hlNative("std","dyn_compare")

+ 15 - 2
std/hl/_std/Type.hx

@@ -85,8 +85,21 @@ class Type {
 	}
 
 	public static function typeof( v : Dynamic ) : ValueType {
-		throw "TODO";
-		return null;
+		var t = hl.types.Type.getDynamic(v);
+		switch( t.kind ) {
+		case HVoid:
+			return TNull;
+		case HI8, HI16, HI32:
+			return TInt;
+		case HF32, HF64:
+			return TFloat;
+		case HBool:
+			return TBool;
+		case HDynObj:
+			return TObject;
+		default:
+			return TUnknown;
+		}
 	}
 
 	@:hlNative("std","type_enum_eq")

+ 1 - 1
std/hl/types/Type.hx

@@ -27,7 +27,7 @@ abstract TypeKind(Int) {
 
 	public var kind(get,never) : TypeKind;
 
-	@:extern inline function get_kind() {
+	@:extern inline function get_kind() : TypeKind {
 		return untyped $tkind(this);
 	}