Array<Float> basic support

genhl.ml

@@ -193,6 +193,7 @@ type method_context = {
 type array_impl = {
 	aobj : tclass;
 	ai32 : tclass;
+	af64 : tclass;
 }
 
 type context = {
@@ -445,6 +446,8 @@ and resolve_class ctx c pl =
 		(match to_type ctx t with
 		| HI32 ->
 			ctx.array_impl.ai32
+		| HF64 ->
+			ctx.array_impl.af64
 		| t ->
 			if safe_cast t (HDyn None) then
 				ctx.array_impl.aobj
@@ -1308,6 +1311,15 @@ and eval_expr ctx e =
 				op ctx (OSetI32 (b,reg_int ctx (i * 4),r));
 			) el;
 			op ctx (OCall2 (r, alloc_fun_path ctx (["hl";"types"],"ArrayI32") "alloc", b, reg_int ctx (List.length el)));
+		| HF64 ->
+			let b = alloc_tmp ctx HBytes in
+			let size = reg_int ctx ((List.length el) * 8) in
+			op ctx (OCall1 (b,alloc_std ctx "balloc" [HI32] HBytes,size));
+			List.iteri (fun i e ->
+				let r = eval_to ctx e HF64 in
+				op ctx (OSetF64 (b,reg_int ctx (i * 8),r));
+			) el;
+			op ctx (OCall2 (r, alloc_fun_path ctx (["hl";"types"],"ArrayF64") "alloc", b, reg_int ctx (List.length el)));
 		| _ ->
 			if safe_cast et (HDyn None) then begin
 				let a = alloc_tmp ctx (HArray (HDyn None)) in
@@ -1347,7 +1359,24 @@ and eval_expr ctx e =
 			op ctx (OGetI32 (r,hbytes,ri));
 			jend();
 			r
+		| HF64 ->
+			let hbytes = alloc_tmp ctx HBytes in
+			op ctx (OField (hbytes, ra, 0));
 
+			(* check bounds *)
+			let size = alloc_tmp ctx HI32 in
+			op ctx (OField (size, ra, 2));
+			let r = alloc_tmp ctx at in
+			let j = jump ctx (fun i -> OJULt (ri,size,i)) in
+			op ctx (OFloat (r,alloc_float ctx 0.));
+			let jend = jump ctx (fun i -> OJAlways i) in
+			j();
+			let r2 = alloc_tmp ctx HI32 in
+			op ctx (OInt (r2,alloc_i32 ctx 3l));
+			op ctx (OShl (ri,ri,r2));
+			op ctx (OGetF64 (r,hbytes,ri));
+			jend();
+			r
 		| _ ->
 			if safe_cast at (HDyn None) then begin
 				let harr = alloc_tmp ctx (HArray (HDyn None)) in
@@ -2330,57 +2359,64 @@ let interp code =
 			Return v -> v
 	in
 	let load_native lib name =
-		FNativeFun (lib ^ "@" ^ name,match lib, name with
-		| "std", "log" ->
-			(fun args -> print_endline (vstr (List.hd args)); VNull);
-		| "std", "balloc" ->
-			(function
-			| [VInt i] -> VBytes (String.create (Int32.to_int i))
-			| _ -> assert false)
-		| "std", "aalloc" ->
-			(function
-			| [VType t;VInt i] -> VArray (Array.create (Int32.to_int i) VNull,t)
-			| _ -> assert false)
-		| "std", "ablit" ->
-			(function
-			| [VArray (dst,_); VInt dp; VArray (src,_); VInt sp; VInt len] ->
-				Array.blit src (Int32.to_int sp) dst (Int32.to_int dp) (Int32.to_int len);
-				VNull
-			| _ -> assert false)
-		| "std", "bblit" ->
-			(function
-			| [VBytes dst; VInt dp; VBytes src; VInt sp; VInt len] ->
-				String.blit src (Int32.to_int sp) dst (Int32.to_int dp) (Int32.to_int len);
-				VNull
-			| _ -> assert false)
-		| "std", "itos" ->
-			(function
-			| [VInt v; VRef (regs,i)] ->
-				let str = Int32.to_string v in
-				regs.(i) <- VInt (Int32.of_int (String.length str));
-				VBytes (str ^ "\x00")
-			| _ -> assert false);
-		| "std", "ftos" ->
-			(function
-			| [VFloat v; VRef (regs,i)] ->
-				let str = string_of_float v in
-				regs.(i) <- VInt (Int32.of_int (String.length str));
-				VBytes (str ^ "\x00")
-			| _ -> assert false);
-		| "std", "value_to_string" ->
-			(function
-			| [v; VRef (regs,i)] ->
-				let str = vstr v in
-				regs.(i) <- VInt (Int32.of_int (String.length str));
-				VBytes (str ^ "\x00")
-			| _ -> assert false);
-		| "std", "utf8length" ->
-			(function
-			| [VBytes b; VInt start; VInt len] ->
-				VInt (Int32.of_int (UTF8.length (String.sub b (Int32.to_int start) (Int32.to_int len))))
-			| _ -> assert false)
-		| _ -> (fun args -> error ("Unresolved native " ^ name))
-		)
+		FNativeFun (lib ^ "@" ^ name, (match lib with
+		| "std" ->
+			(match name with
+			| "log" ->
+				(fun args -> print_endline (vstr (List.hd args)); VNull);
+			| "balloc" ->
+				(function
+				| [VInt i] -> VBytes (String.create (Int32.to_int i))
+				| _ -> assert false)
+			| "aalloc" ->
+				(function
+				| [VType t;VInt i] -> VArray (Array.create (Int32.to_int i) VNull,t)
+				| _ -> assert false)
+			| "ablit" ->
+				(function
+				| [VArray (dst,_); VInt dp; VArray (src,_); VInt sp; VInt len] ->
+					Array.blit src (Int32.to_int sp) dst (Int32.to_int dp) (Int32.to_int len);
+					VNull
+				| _ -> assert false)
+			| "bblit" ->
+				(function
+				| [VBytes dst; VInt dp; VBytes src; VInt sp; VInt len] ->
+					String.blit src (Int32.to_int sp) dst (Int32.to_int dp) (Int32.to_int len);
+					VNull
+				| _ -> assert false)
+			| "itos" ->
+				(function
+				| [VInt v; VRef (regs,i)] ->
+					let str = Int32.to_string v in
+					regs.(i) <- VInt (Int32.of_int (String.length str));
+					VBytes (str ^ "\x00")
+				| _ -> assert false);
+			| "ftos" ->
+				(function
+				| [VFloat v; VRef (regs,i)] ->
+					let str = string_of_float v in
+					regs.(i) <- VInt (Int32.of_int (String.length str));
+					VBytes (str ^ "\x00")
+				| _ -> assert false);
+			| "value_to_string" ->
+				(function
+				| [v; VRef (regs,i)] ->
+					let str = vstr v in
+					regs.(i) <- VInt (Int32.of_int (String.length str));
+					VBytes (str ^ "\x00")
+				| _ -> assert false);
+			| "utf8length" ->
+				(function
+				| [VBytes b; VInt start; VInt len] ->
+					VInt (Int32.of_int (UTF8.length (String.sub b (Int32.to_int start) (Int32.to_int len))))
+				| _ -> assert false)
+			| "math_sqrt" ->
+				(function
+				| [VFloat f] -> VFloat (sqrt f)
+				| _ -> assert false)
+			| _ -> (fun args -> error ("Unresolved native " ^ name)))
+		| _ ->
+			(fun args -> error ("Unresolved native " ^ name))))
 	in
 	Array.iter (fun (lib,name,_,idx) -> functions.(idx) <- load_native code.strings.(lib) code.strings.(name)) code.natives;
 	Array.iter (fun fd -> functions.(fd.findex) <- FFun fd) code.functions;
@@ -2792,6 +2828,7 @@ let generate com =
 		array_impl = {
 			aobj = get_class "ArrayObj";
 			ai32 = get_class "ArrayI32";
+			af64 = get_class "ArrayF64";
 		};
 		anons_cache = [];
 	} in
@@ -2827,7 +2864,7 @@ let generate com =
 		functions = DynArray.to_array ctx.cfunctions;
 	} in
 	Array.sort (fun (lib1,_,_,_) (lib2,_,_,_) -> lib1 - lib2) code.natives;
-	if Common.defined com Define.Dump then print_endline (dump code);
+	if Common.defined com Define.Dump then Std.output_file "dump/hlcode.txt" (dump code);
 	check code;
 	let ch = IO.output_string() in
 	write_code ch code;

std/hl/_std/Math.hx

@@ -0,0 +1,3 @@
+extern class Math {
+	@:hlNative("std","math_sqrt") static function sqrt( v : Float ) : Float;
+}

std/hl/_std/Std.hx

@@ -21,6 +21,7 @@
  */
 import hl.types.ArrayObj;
 import hl.types.ArrayI32;
+import hl.types.ArrayF64;
 
 class Std {
 

std/hl/types/ArrayF64.hx

@@ -0,0 +1,142 @@
+package hl.types;
+
+@:keep
+class ArrayF64 {
+
+	var bytes : hl.types.Bytes;
+	var size : Int;
+	public var length(default,null) : Int;
+
+	public function new() {
+		size = length = 0;
+		bytes = new Bytes(0);
+	}
+
+	public function concat( a : ArrayF64 ) : ArrayF64 {
+		throw "TODO";
+		return null;
+	}
+
+	public function join( sep : String ) : String {
+		throw "TODO";
+		return null;
+	}
+
+	public function pop() : Null<Float> {
+		if( length == 0 )
+			return null;
+		length--;
+		return bytes.getF64(length << 3);
+	}
+
+	public function push(x : Float) : Int {
+		var len = length;
+		if( size == len )
+			__expand(len);
+		else
+			length++;
+		bytes.setF64(len<<3,x);
+		return length;
+	}
+
+	public function reverse() : Void {
+		throw "TODO";
+	}
+
+	public function shift() : Null<Float> {
+		throw "TODO";
+		return null;
+	}
+
+	public function slice( pos : Int, ?end : Int ) : ArrayF64 {
+		throw "TODO";
+		return null;
+	}
+
+	public function sort( f : Float -> Float -> Int ) : Void {
+		throw "TODO";
+	}
+
+	public function splice( pos : Int, len : Int ) : ArrayF64 {
+		throw "TODO";
+		return null;
+	}
+
+	public function toString() : String {
+		var b = new StringBuf();
+		b.addChar("[".code);
+		for( i in 0...length ) {
+			if( i > 0 ) b.addChar(",".code);
+			b.add(bytes.getF64(i<<3));
+		}
+		b.addChar("]".code);
+		return b.toString();
+	}
+
+	public function unshift( x : Float ) : Void {
+		throw "TODO";
+	}
+
+	public function insert( pos : Int, x : Float ) : Void {
+		throw "TODO";
+	}
+
+	public function remove( x : Float ) : Bool {
+		throw "TODO";
+		return false;
+	}
+
+	public function indexOf( x : Float, ?fromIndex:Int ) : Int {
+		throw "TODO";
+		return -1;
+	}
+
+	public function lastIndexOf( x : Float, ?fromIndex:Int ) : Int {
+		throw "TODO";
+		return -1;
+	}
+
+	public function copy() : ArrayF64 {
+		throw "TODO";
+		return null;
+	}
+
+	public function iterator() : Iterator<Float> {
+		throw "TODO";
+		return null;
+	}
+
+	public function map<S>( f : Float -> S ) : ArrayObj<S> {
+		throw "TODO";
+		return null;
+	}
+
+	public function filter( f : Float -> Bool ) : ArrayF64 {
+		throw "TODO";
+		return null;
+	}
+	
+	// called by compiler when accessing the array outside of its bounds, might trigger resize
+	function __expand( index : Int ) {
+		if( index < 0 ) throw "Invalid array access";
+		var newlen = index + 1;
+		if( newlen > size ) {
+			var next = (size * 3) >> 1;
+			if( next < newlen ) next = newlen;
+			var bytes2 = new hl.types.Bytes(next<<3);
+			if( length > 0 ) bytes2.blit(0,bytes,0,length<<3);
+			bytes = bytes2;
+			size = next;
+		}
+		length = newlen;
+	}
+	
+	public static function alloc( a : hl.types.Bytes, length : Int ) {
+		var arr : ArrayF64 = untyped $new(ArrayF64);
+		arr.bytes = a;
+		arr.length = length;
+		arr.size = length;
+		return arr;
+	}
+
+}

std/hl/types/ArrayI32.hx

@@ -26,8 +26,7 @@ class ArrayI32 {
 		if( length == 0 )
 			return null;
 		length--;
-		var v : Int = untyped $bgeti32(bytes,length<<2);
-		return v;
+		return bytes.getI32(length<<2);
 	}
 
 	public function push(x : Int) : Int {
@@ -36,7 +35,7 @@ class ArrayI32 {
 			__expand(len);
 		else
 			length++;
-		untyped $bseti32(bytes,len<<2,x);
+		bytes.setI32(len<<2,x);
 		return length;
 	}
 
@@ -136,7 +135,7 @@ class ArrayI32 {
 		var arr : ArrayI32 = untyped $new(ArrayI32);
 		arr.bytes = a;
 		arr.length = length;
-		arr.size = length>>2;
+		arr.size = length;
 		return arr;
 	}
 

std/hl/types/Bytes.hx

@@ -28,19 +28,19 @@ package hl.types;
 	}
 
 	public inline function getF64( pos : Int ) : Float {
-		return untyped $bgeti32(this,pos);
+		return untyped $bgetf64(this,pos);
 	}
 
 	public inline function setI32( pos : Int, value : Int ) : Void {
-		untyped $bseti32(pos, value);
+		untyped $bseti32(this, pos, value);
 	}
 
 	public inline function setF32( pos : Int, value : F32 ) : Void {
-		untyped $bsetf32(pos, value);
+		untyped $bsetf32(this, pos, value);
 	}
 	
 	public inline function setF64( pos : Int, value : Float ) : Void {
-		untyped $bsetf64(pos, value);
+		untyped $bsetf64(this, pos, value);
 	}
 	
 	@:hlNative("std","utf8length")