TestMatch, TestSpecification in progress

genhl.ml

@@ -1340,12 +1340,12 @@ and eval_expr ctx e =
 		);
 		alloc_tmp ctx HVoid
 	| TLocal v ->
-		(match captured_index ctx v with
+		cast_to ctx (match captured_index ctx v with
 		| None -> alloc_reg ctx v
 		| Some idx ->
 			let r = alloc_tmp ctx (to_type ctx v.v_type) in
 			op ctx (OEnumField (r, ctx.m.mcaptreg, 0, idx));
-			r)
+			r) (to_type ctx e.etype) e.epos
 	| TReturn None ->
 		before_return ctx;
 		let r = alloc_tmp ctx HVoid in
@@ -1650,15 +1650,16 @@ and eval_expr ctx e =
 			r
 		| _ ->
 			error ("Unknown native call " ^ v.v_name) e.epos)
-	| TCall (ec,el) ->
+	| TCall (ec,args) ->
 		let real_type = (match ec.eexpr with
 			| TField (_,f) -> field_type ctx f ec.epos
 			| TLocal v -> v.v_type
 			| _ -> ec.etype
 		) in
 		let tfun = to_type ctx real_type in
-		let el() = eval_args ctx el tfun e.epos in
+		let el() = eval_args ctx args tfun e.epos in
 		let ret = alloc_tmp ctx (match tfun with HFun (_,r) -> r | _ -> HDyn) in
+		let def_ret = ref None in
 		(match get_access ctx ec with
 		| AStaticFun f ->
 			(match el() with
@@ -1689,9 +1690,14 @@ and eval_expr ctx e =
 			op ctx (OCallClosure (ret, r, el())); (* if it's a value, it's a closure *)
 		| _ ->
 			let r = eval_null_check ctx ec in
+			(* don't use real_type here *)
+			let tfun = to_type ctx ec.etype in
+			let el() = eval_args ctx args tfun e.epos in
+			let ret = alloc_tmp ctx (match tfun with HFun (_,r) -> r | _ -> HDyn) in
 			op ctx (OCallClosure (ret, r, el())); (* if it's a value, it's a closure *)
+			def_ret := Some (unsafe_cast_to ctx ret (to_type ctx e.etype) e.epos);
 		);
-		unsafe_cast_to ctx ret (to_type ctx e.etype) e.epos
+		(match !def_ret with None -> unsafe_cast_to ctx ret (to_type ctx e.etype) e.epos | Some r -> r)
 	| TField (ec,FInstance({ cl_path = [],"Array" },[t],{ cf_name = "length" })) when to_type ctx t = HDyn ->
 		let r = alloc_tmp ctx HI32 in
 		op ctx (OCall1 (r,alloc_fun_path ctx (["hl";"types"],"ArrayDyn") "get_length", eval_null_check ctx ec));
@@ -4443,6 +4449,10 @@ let interp code =
 				(function
 				| [VBytes str] -> print_string (hl_to_caml str); VUndef
 				| _ -> assert false)
+			| "sys_time" ->
+				(function
+				| [] -> VFloat (Unix.time())
+				| _ -> assert false)
 			| "sys_exit" ->
 				(function
 				| [VInt code] -> VUndef
@@ -4467,14 +4477,18 @@ let interp code =
 				(function
 				| [VType t;v] -> if v = VNull then v else (match get_type v with None -> assert false | Some vt -> if safe_cast vt t then v else VNull)
 				| _ -> assert false)
-			| "type_get_class" ->
+			| "type_super" ->
 				(function
-				| [VObj o] -> (match o.oproto.pclass.pclassglobal with None -> VNull | Some g -> globals.(g))
-				| _ -> VNull)
-			| "type_get_enum" ->
+				| [VType t] -> VType (match t with HObj { psuper = Some o } -> HObj o | _ -> HVoid)
+				| _ -> assert false)
+			| "type_get_global" ->
 				(function
-				| [VDyn (_,HEnum e)] -> globals.(e.eglobal)
-				| _ -> VNull)
+				| [VType t] ->
+					(match t with
+					| HObj c -> (match c.pclassglobal with None -> VNull | Some g -> globals.(g))
+					| HEnum e -> globals.(e.eglobal)
+					| _ -> VNull)
+				| _ -> assert false)
 			| "type_name" ->
 				(function
 				| [VType t] ->
@@ -4485,16 +4499,22 @@ let interp code =
 				| _ -> assert false)
 			| "obj_fields" ->
 				(function
-				| [VDynObj o] ->
+				| [VDynObj o; VBool _] ->
 					VArray (Array.of_list (Hashtbl.fold (fun n _ acc -> VBytes (caml_to_hl n) :: acc) o.dfields []), HBytes)
-				| [VObj o] ->
+				| [VObj o; VBool isRec] ->
 					let rec loop p =
 						let fields = Array.map (fun (n,_,_) -> VBytes (caml_to_hl n)) p.pfields in
-						match p.psuper with None -> [fields] | Some p -> fields :: loop p
+						match p.psuper with Some p when isRec -> fields :: loop p | _ -> [fields]
 					in
 					VArray (Array.concat (loop o.oproto.pclass), HBytes)
 				| _ ->
 					VNull)
+			| "obj_copy" ->
+				(function
+				| [VDynObj d] ->
+					VDynObj { dfields = Hashtbl.copy d.dfields; dvalues = Array.copy d.dvalues; dtypes = Array.copy d.dtypes; dvirtuals = [] }
+				| [_] -> VNull
+				| _ -> assert false)
 			| "enum_parameters" ->
 				(function
 				| [VDyn (VEnum (idx,pl),HEnum e)] ->
@@ -4554,7 +4574,9 @@ let interp code =
 				(function
 				| [o;VInt hash] ->
 					let f = (try Hashtbl.find hash_cache hash with Not_found -> assert false) in
-					dyn_get_field o f HDyn
+					(match o with
+					| VObj _ | VDynObj _ | VVirtual _ -> dyn_get_field o f HDyn
+					| _ -> VNull)
 				| _ -> assert false)
 			| "set_field" ->
 				(function
@@ -4580,6 +4602,35 @@ let interp code =
 					in
 					VBool (loop o)
 				| _ -> assert false)
+			| "delete_field" ->
+				(function
+				| [o;VInt hash] ->
+					let f = (try Hashtbl.find hash_cache hash with Not_found -> assert false) in
+					let rec loop o =
+						match o with
+						| VDynObj d when Hashtbl.mem d.dfields f ->
+							let idx = Hashtbl.find d.dfields f in
+							let count = Array.length d.dvalues in
+							Hashtbl.remove d.dfields f;
+							let fields = Hashtbl.fold (fun name i acc -> (name,if i < idx then i else i - 1) :: acc) d.dfields [] in
+							Hashtbl.clear d.dfields;
+							List.iter (fun (n,i) -> Hashtbl.add d.dfields n i) fields;
+							let vals2 = Array.make (count - 1) VNull in
+							let types2 = Array.make (count - 1) HVoid in
+							let len = count - idx - 1 in
+							Array.blit d.dvalues 0 vals2 0 idx;
+							Array.blit d.dvalues (idx + 1) vals2 idx len;
+							Array.blit d.dtypes 0 types2 0 idx;
+							Array.blit d.dtypes (idx + 1) types2 idx len;
+							d.dvalues <- vals2;
+							d.dtypes <- types2;
+							rebuild_virtuals d;
+							true
+						| VVirtual v -> loop v.vvalue
+						| _ -> false
+					in
+					VBool (loop o)
+				| _ -> assert false)
 			| "ucs2length" ->
 				(function
 				| [VBytes s; VInt pos] ->
@@ -4775,6 +4826,10 @@ let interp code =
 					regs.(pos) <- to_int (String.length str);
 					VBytes (caml_to_hl str)
 				| _ -> assert false)
+			| "random" ->
+				(function
+				| [VInt max] -> VInt (if max <= 0l then 0l else Random.int32 max)
+				| _ -> assert false)
 			| _ ->
 				unresolved())
 		| "regexp" ->

std/hl/_std/Reflect.hx

@@ -72,12 +72,12 @@ class Reflect {
 		return hl.types.Api.callMethod(func,a);
 	}
 
-	@:hlNative("std","obj_fields") static function getObjectFields( v : Dynamic ) : hl.types.NativeArray<hl.types.Bytes> {
+	@:hlNative("std","obj_fields") static function getObjectFields( v : Dynamic, rec : Bool ) : hl.types.NativeArray<hl.types.Bytes> {
 		return null;
 	}
 
 	public static function fields( o : Dynamic ) : Array<String> {
-		var fields = getObjectFields(o);
+		var fields = getObjectFields(o, true);
 		if( fields == null ) return [];
 		return [for( f in fields ) @:privateAccess String.__alloc__(f,f.ucs2Length(0))];
 	}
@@ -97,21 +97,21 @@ class Reflect {
 	}
 
 	public static function isObject( v : Dynamic ) : Bool {
-		throw "TODO";
-		return false;
+		var t = hl.types.Type.getDynamic(v);
+		return switch( t.kind ) { case HObj, HDynObj, HVirtual: true; default: false; }
 	}
 
 	public static function isEnumValue( v : Dynamic ) : Bool {
-		throw "TODO";
-		return false;
+		var t = hl.types.Type.getDynamic(v);
+		return t.kind == HEnum;
 	}
 
 	public static function deleteField( o : Dynamic, field : String ) : Bool {
 		return hl.types.Api.deleteField(o,@:privateAccess field.bytes.hash());
 	}
 
+	@:hlNative("std","obj_copy")
 	public static function copy<T>( o : T ) : T {
-		throw "TODO";
 		return null;
 	}
 

std/hl/_std/Std.hx

@@ -24,8 +24,8 @@ import hl.Boot;
 @:coreApi
 class Std {
 
+	@:hlNative("std","random")
 	public static function random( x : Int ) : Int {
-		throw "TODO:Std.random";
 		return 0;
 	}
 
@@ -48,10 +48,12 @@ class Std {
 	}
 
 	public static function parseInt( x : String ) : Null<Int> {
+		if( x == null ) return null;
 		return @:privateAccess x.bytes.parseInt(0, x.length<<1);
 	}
 
 	public static function parseFloat( x : String ) : Float {
+		if( x == null ) return Math.NaN;
 		return @:privateAccess x.bytes.parseFloat(0, x.length<<1);
 	}
 

std/hl/_std/String.hx

@@ -46,22 +46,18 @@ class String {
 	}
 
 	public function lastIndexOf( str : String, ?startIndex : Int ) : Int {
-		var size = length << 1;
-		var lastByte = size;
-		if( startIndex != null && startIndex < length ) {
-			if( startIndex <= 0 )
-				return -1;
-			lastByte = startIndex << 1;
-		}
-		var last = -1;
-		var pos = 0;
+		var last = 0;
+		var start = this.length;
+		if( startIndex != null )
+			start = startIndex;
+		start <<= 1;
 		while( true ) {
-			var p = bytes.find(pos, size - pos, str.bytes, 0, str.length << 1);
-			if( p < 0 || p >= lastByte ) break;
-			last = p >> 1;
-			pos = p + 1;
+			var p = bytes.find(last, (length << 1) - last, str.bytes, 0, str.length << 1);
+			if( p < 0 || p > start )
+				return (last >> 1) - 1;
+			last = p + 2;
 		}
-		return last;
+		return -1;
 	}
 
 	public function split( delimiter : String ) : Array<String> {
@@ -94,21 +90,15 @@ class String {
 		var sl = length;
 		var len : Int = if( len == null ) sl else len;
 		if( len == 0 ) return "";
-
 		if( pos != 0 && len < 0 )
 			return "";
-
-		if( pos < 0 ){
+		if( pos < 0 ) {
 			pos = sl + pos;
 			if( pos < 0 ) pos = 0;
-		}else if( len < 0 ){
+		} else if( len < 0 )
 			len = sl + len - pos;
-		}
-
-		if( pos + len > sl ){
+		if( pos + len > sl )
 			len = sl - pos;
-		}
-
 		if( pos < 0 || len <= 0 ) return "";
 
 		var b = new hl.types.Bytes((len + 1) << 1);
@@ -123,16 +113,21 @@ class String {
 			end = length;
 		else {
 			end = endIndex;
-			if( end < 0 ) end = 0;
-			else if( end > length ) end = length;
+			if( end < 0 )
+				end = 0;
+			else if ( end > length )
+				end = length;
 		}
-		if( startIndex < 0 ) startIndex = 0 else if ( startIndex > length ) startIndex = length;
+		if( startIndex < 0 )
+			startIndex = 0;
+		else if ( startIndex > length )
+			startIndex = length;
 		if( startIndex > end ) {
 			var tmp = startIndex;
 			startIndex = end;
 			end = tmp;
 		}
-		return substr( startIndex, endIndex - startIndex );
+		return substr( startIndex, end - startIndex );
 	}
 
 	public function toString() : String {

std/hl/_std/Type.hx

@@ -24,19 +24,24 @@ class Type {
 		allTypes.set(b, t);
 	}
 
-	@:hlNative("std","type_get_class")
 	public static function getClass<T>( o : T ) : Class<T> {
+		var t = hl.types.Type.getDynamic(o);
+		if( t.kind == HObj )
+			return t.getGlobal();
 		return null;
 	}
 
-	@:hlNative("std","type_get_enum")
 	public static function getEnum( o : EnumValue ) : Enum<Dynamic> {
+		var t = hl.types.Type.getDynamic(o);
+		if( t.kind == HEnum )
+			return t.getGlobal();
 		return null;
 	}
 
-	public static function getSuperClass( c : Class<Dynamic> ) : Class<Dynamic> {
-		throw "TODO";
-		return null;
+	public static function getSuperClass( c : Class<Dynamic> ) : Class<Dynamic> @:privateAccess {
+		var c : hl.types.BaseType.Class = cast c;
+		var t = c.__type__.getSuper();
+		return t == hl.types.Type.get((null : Void)) ? null : t.getGlobal();
 	}
 
 	public static function getClassName( c : Class<Dynamic> ) : String {
@@ -85,7 +90,7 @@ class Type {
 	public static function createEnumIndex<T>( e : Enum<T>, index : Int, ?params : Array<Dynamic> ) : T {
 		var e : hl.types.BaseType.Enum = cast e;
 		if( index < 0 || index >= e.__constructs__.length ) throw "Invalid enum index " + e.__ename__ +"." + index;
-		if( params == null ) {
+		if( params == null || params.length == 0 ) {
 			var v = index >= e.__evalues__.length ? null : e.__evalues__[index];
 			if( v == null ) throw "Constructor " + e.__ename__ +"." + e.__constructs__[index] + " takes parameters";
 			return v;
@@ -113,7 +118,8 @@ class Type {
 
 	public static function getClassFields( c : Class<Dynamic> ) : Array<String> {
 		var c : hl.types.BaseType.Class = cast c;
-		var fields = Reflect.fields(c);
+		var fields = @:privateAccess Reflect.getObjectFields(c, false);
+		var fields = [for( f in fields ) @:privateAccess String.__alloc__(f, f.ucs2Length(0))];
 		fields.remove("__constructor__");
 		fields.remove("__meta__");
 		fields.remove("__name__");

std/hl/types/ArrayBase.hx

@@ -94,6 +94,21 @@ class ArrayBase extends ArrayAccess {
 
 }
 
+@:generic
+class BasicIterator<T> {
+	var pos : Int;
+	var a : ArrayBasic<T>;
+	public function new(a) {
+		this.a = a;
+	}
+	public function hasNext() {
+		return pos < a.length;
+	}
+	public function next() : T {
+		return @:privateAccess a.bytes.get(pos++);
+	}
+}
+
 @:generic class ArrayBasic<T> extends ArrayBase {
 
 	var bytes : hl.types.BytesAccess<T>;
@@ -178,12 +193,18 @@ class ArrayBase extends ArrayAccess {
 	}
 
 	public function remove( x : T ) : Bool {
-		throw "TODO";
-		return false;
+		var idx = indexOf(x);
+		if( idx < 0 )
+			return false;
+		length--;
+		(bytes : hl.types.Bytes).blit(idx<<bytes.sizeBits,bytes,(idx + 1)<<bytes.sizeBits,(length - idx)<<bytes.sizeBits);
+		return true;
 	}
 
 	public function indexOf( x : T, ?fromIndex:Int ) : Int {
-		throw "TODO";
+		for( i in (fromIndex == null ? 0 : fromIndex)...length )
+			if( bytes[i] == x )
+				return i;
 		return -1;
 	}
 
@@ -198,8 +219,7 @@ class ArrayBase extends ArrayAccess {
 	}
 
 	public function iterator() : Iterator<T> {
-		throw "TODO";
-		return null;
+		return new BasicIterator(this);
 	}
 
 	public function map<S>( f : T -> S ) : ArrayDyn {

std/hl/types/Type.hx

@@ -56,6 +56,14 @@ abstract TypeKind(Int) {
 		return null;
 	}
 
+	@:hlNative("std","type_get_global") public function getGlobal() : Dynamic {
+		return null;
+	}
+
+	@:hlNative("std","type_super") public function getSuper() : Type {
+		return null;
+	}
+
 	@:hlNative("std","type_enum_fields") public function getEnumFields() : NativeArray<Bytes> {
 		return null;
 	}