Переглянути джерело

string compare ok (uses __compare)

Nicolas Cannasse 9 роки тому
батько
коміт
dbb85ea21c
6 змінених файлів з 196 додано та 29 видалено
  1. 44 16
      genhl.ml
  2. 4 0
      std/hl/_std/Std.hx
  3. 5 0
      std/hl/_std/String.hx
  4. 116 0
      std/hl/_std/Type.hx
  5. 5 0
      std/hl/types/Bytes.hx
  6. 22 13
      std/hl/types/NativeBytesMap.hx

+ 44 - 16
genhl.ml

@@ -305,6 +305,7 @@ let rec tsame t1 t2 =
 	| HFun (args1,ret1), HFun (args2,ret2) when List.length args1 = List.length args2 -> List.for_all2 tsame args1 args2 && tsame ret2 ret1
 	| HObj p1, HObj p2 -> p1 == p2
 	| HEnum e1, HEnum e2 -> e1 == e2
+	| HAbstract (_,a1), HAbstract (_,a2) -> a1 == a2
 	| HVirtual v1, HVirtual v2 ->
 		if v1 == v2 then true else
 		if Array.length v1.vfields <> Array.length v2.vfields then false else
@@ -707,6 +708,8 @@ let common_type ctx e1 e2 for_eq p =
 		| (HDyn (Some t1)), (HI8|HI16|HI32|HF32|HF64) -> loop t1 t2
 		| (HDyn None), (HI8|HI16|HI32|HF32|HF64) -> HF64
 		| (HI8|HI16|HI32|HF32|HF64), (HDyn None) -> HF64
+		| HDyn None, _ -> HDyn None
+		| _, HDyn None -> HDyn None
 		| _ when for_eq && safe_cast t1 t2 -> t2
 		| _ when for_eq && safe_cast t2 t1 -> t1
 		| _ ->
@@ -771,7 +774,7 @@ and cast_to ctx (r:reg) (t:ttype) p =
 		let out = alloc_tmp ctx t in
 		op ctx (OToVirtual (out,r));
 		out
-	| HDyn None, (HObj _ | HDynObj | HFun _ | HArray _ | HDyn _) ->
+	| HDyn None, _ ->
 		let out = alloc_tmp ctx t in
 		op ctx (OSafeCast (out, r));
 		out
@@ -876,7 +879,7 @@ and jump_expr ctx e jcond =
 		jump ctx (fun i -> if jcond then OJTrue (r,i) else OJFalse (r,i))
 
 and eval_args ctx el t =
-	List.map2 (fun e t -> eval_to ctx e t) el (match t with HFun (args,_) -> args | _ -> assert false)
+	List.map2 (fun e t -> eval_to ctx e t) el (match t with HFun (args,_) -> args | HDyn None -> List.map (fun _ -> HDyn None) el | _ -> assert false)
 
 and eval_null_check ctx e =
 	let r = eval_expr ctx e in
@@ -1222,8 +1225,10 @@ and eval_expr ctx e =
 						op ctx (OAdd (r,a,b))
 					| HObj { pname = "String" } ->
 						op ctx (OCall2 (r,alloc_fun_path ctx ([],"String") "__add__",a,b))
-					| _ ->
-						assert false)
+					| HDyn None ->
+						op ctx (OCall2 (r,alloc_fun_path ctx ([],"Std") "__add__",a,b))
+					| t ->
+						error ("Cannot add " ^ tstr t) e.epos)
 				| OpSub | OpMult | OpMod | OpDiv ->
 					(match rtype ctx r with
 					| HI8 | HI16 | HI32 | HF32 | HF64 ->
@@ -1871,7 +1876,7 @@ let generate_member ctx c f =
 	match f.cf_kind with
 	| Var _ -> ()
 	| Method m ->
-		ignore(make_fun ctx (alloc_fid ctx c f) (match f.cf_expr with Some { eexpr = TFunction f } -> f | _ -> assert false) (Some c) None);
+		ignore(make_fun ctx (alloc_fid ctx c f) (match f.cf_expr with Some { eexpr = TFunction f } -> f | _ -> error "Missing function body" f.cf_pos) (Some c) None);
 		if f.cf_name = "toString" && not (List.memq f c.cl_overrides) && not (PMap.mem "__string" c.cl_fields) then begin
 			let p = f.cf_pos in
 			(* function __string() return this.toString().bytes *)
@@ -2209,7 +2214,7 @@ let check code =
 				ignore(rtype b);
 			| OSafeCast (a,b) ->
 				reg a (HDyn None);
-				if not (safe_cast (rtype b) (HDyn None)) then reg b HDynObj;
+				ignore(rtype b);
 			| OArraySize (r,a) ->
 				(match rtype a with
 				| HArray _ -> ()
@@ -2319,6 +2324,10 @@ type value =
 	| VVirtual of vvirtual
 	| VDynObj of vdynobj
 	| VEnum of int * value array
+	| VAbstract of vabstract
+
+and vabstract =
+	| AHashBytes of (string, value) Hashtbl.t
 
 and vfunction =
 	| FFun of fundecl
@@ -2414,6 +2423,7 @@ let interp code =
 		| VVirtual v -> "virtual(" ^ vstr_d v.vvalue ^ ")"
 		| VDynObj d -> "dynobj(" ^ String.concat "," (Hashtbl.fold (fun f i acc -> (f^":"^vstr_d d.dvalues.(i)) :: acc) d.dfields []) ^ ")"
 		| VEnum (i,vals) -> "enum#" ^ string_of_int i  ^ "(" ^ String.concat "," (Array.to_list (Array.map vstr_d vals)) ^ ")"
+		| VAbstract _ -> "abstract"
 
 	and vstr v t =
 		match v with
@@ -2437,6 +2447,7 @@ let interp code =
 		| VRef (regs,i,t) -> "*" ^ (vstr regs.(i) t)
 		| VVirtual v -> vstr v.vvalue (HDyn None)
 		| VDynObj d -> "{" ^ String.concat ", " (Hashtbl.fold (fun f i acc -> (f^":"^vstr d.dvalues.(i) d.dtypes.(i)) :: acc) d.dfields []) ^ "}"
+		| VAbstract _ -> "abstract"
 		| VEnum (i,vals) ->
 			(match t with
 			| HEnum e ->
@@ -2507,14 +2518,22 @@ let interp code =
 				Int32.to_int (if d = 0l then Int32.sub (Int32.logand a 0xFFFFl) (Int32.logand b 0xFFFFl) else d)
 			| _ -> assert false
 		in
-		let vcompare a b =
+		let vcompare ra rb =
+			let a = get ra in
+			let b = get rb in
 			match a, b with
 			| VInt a, VInt b -> Int32.compare a b
 			| VFloat a, VFloat b -> compare a b
 			| VNull, VNull -> 0
 			| VNull, _ -> 1
 			| _, VNull -> -1
-			| VObj a, VObj b -> if a == b then 0 else 1
+			| VObj oa, VObj ob ->
+				if oa == ob then 0 else
+				let fid = ref None in
+				Array.iter (fun p -> if p.fname = "__compare" then fid := Some p.fmethod) oa.oproto.pclass.pproto;
+				(match !fid with
+				| None -> 1
+				| Some f -> (match fcall (func f) [a;b] with VInt i -> Int32.to_int i | _ -> assert false));
 			| _ ->
 				error ("Can't compare " ^ vstr_d a ^ " and " ^ vstr_d b)
 		in
@@ -2566,10 +2585,10 @@ let interp code =
 			| OCallN (r,f,rl) -> set r (fcall (func f) (List.map get rl))
 			| OGetGlobal (r,g) -> set r (global g)
 			| OSetGlobal (r,g) -> Array.unsafe_set globals g (get r)
-			| OEq (r,a,b) -> set r (VBool (vcompare (get a) (get b) = 0))
-			| ONotEq (r,a,b) -> set r (VBool (vcompare (get a) (get b) <> 0))
-			| OSGte (r,a,b) -> set r (VBool (vcompare (get a) (get b) >= 0))
-			| OSLt (r,a,b) -> set r (VBool (vcompare (get a) (get b) < 0))
+			| OEq (r,a,b) -> set r (VBool (vcompare a b = 0))
+			| ONotEq (r,a,b) -> set r (VBool (vcompare a b <> 0))
+			| OSGte (r,a,b) -> set r (VBool (vcompare a b >= 0))
+			| OSLt (r,a,b) -> set r (VBool (vcompare a b < 0))
 			| OUGte (r,a,b) -> set r (VBool (ucompare (get a) (get b) >= 0))
 			| OULt (r,a,b) -> set r (VBool (ucompare (get a) (get b) < 0))
 			| OJTrue (r,i) -> if get r = VBool true then pos := !pos + i
@@ -2577,12 +2596,12 @@ let interp code =
 			| ORet r -> raise (Return regs.(r))
 			| OJNull (r,i) -> if get r == VNull then pos := !pos + i
 			| OJNotNull (r,i) -> if get r != VNull then pos := !pos + i
-			| OJSLt (a,b,i) -> if vcompare (get a) (get b) < 0 then pos := !pos + i
-			| OJSGte (a,b,i) -> if vcompare (get a) (get b) >= 0 then pos := !pos + i
+			| OJSLt (a,b,i) -> if vcompare a b < 0 then pos := !pos + i
+			| OJSGte (a,b,i) -> if vcompare a b >= 0 then pos := !pos + i
 			| OJULt (a,b,i) -> if ucompare (get a) (get b) < 0 then pos := !pos + i
 			| OJUGte (a,b,i) -> if ucompare (get a) (get b) >= 0 then pos := !pos + i
-			| OJEq (a,b,i) -> if vcompare (get a) (get b) = 0 then pos := !pos + i
-			| OJNeq (a,b,i) -> if vcompare (get a) (get b) <> 0 then pos := !pos + i
+			| OJEq (a,b,i) -> if vcompare a b = 0 then pos := !pos + i
+			| OJNeq (a,b,i) -> if vcompare a b <> 0 then pos := !pos + i
 			| OJAlways i -> pos := !pos + i
 			| OUnDyn (r,a) -> set r (match get a with VNull -> default (rtype r) | VDyn (v,_) -> v | _ -> assert false)
 			| OToDyn (r,a) -> set r (VDyn (get a, f.regs.(a)))
@@ -2703,6 +2722,7 @@ let interp code =
 				let v = get v in
 				set r (match v, rtype r with
 					| VObj o, HObj c when o.oproto.pclass == c -> v
+					| VNull, HObj _ -> v
 					| _, t -> error ("Failed to cast " ^ vstr_d v ^ " to " ^ tstr t)
 				)
 			| OUnsafeCast (r,v) ->
@@ -2970,6 +2990,14 @@ let interp code =
 				(function
 				| [VBytes str; VInt len] -> (try VFloat (Interp.parse_float (String.sub str 0 (int len))) with _ -> VFloat nan)
 				| _ -> assert false)
+			| "bytes_compare" ->
+				(function
+				| [VBytes a; VInt apos; VBytes b; VInt bpos; VInt len] -> VInt (Int32.of_int (String.compare (String.sub a (int apos) (int len)) (String.sub b (int bpos) (int len))))
+				| _ -> assert false)
+			| "hballoc" ->
+				(function
+				| [] -> VAbstract (AHashBytes (Hashtbl.create 0))
+				| _ -> assert false)
 			| _ -> (fun args -> error ("Unresolved native " ^ name)))
 		| _ ->
 			(fun args -> error ("Unresolved native " ^ name))))

+ 4 - 0
std/hl/_std/Std.hx

@@ -59,5 +59,9 @@ class Std {
 		return @:privateAccess s.bytes.parseFloat(0, s.size);
 	}
 
+	@:keep static function __add__( a : Dynamic, b : Dynamic ) : Dynamic {
+		throw "TODO";
+		return null;
+	}
 
 }

+ 5 - 0
std/hl/_std/String.hx

@@ -72,6 +72,11 @@ class String {
 		return bytes;
 	}
 	
+	@:keep function __compare( s : String ) : Int {
+		var v = bytes.compare(0, s.bytes, 0, size < s.size ? size : s.size);
+		return v == 0 ? size - s.size : v;
+	}
+	
 	@:keep static inline function __alloc__( b : hl.types.Bytes, blen : Int, clen : Int ) : String {
 		var s : String = untyped $new(String);
 		s.bytes = b;

+ 116 - 0
std/hl/_std/Type.hx

@@ -0,0 +1,116 @@
+enum ValueType {
+	TNull;
+	TInt;
+	TFloat;
+	TBool;
+	TObject;
+	TFunction;
+	TClass( c : Class<Dynamic> );
+	TEnum( e : Enum<Dynamic> );
+	TUnknown;
+}
+
+@:coreApi
+class Type {
+
+	public static function getClass<T>( o : T ) : Class<T> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function getEnum( o : EnumValue ) : Enum<Dynamic> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function getSuperClass( c : Class<Dynamic> ) : Class<Dynamic> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function getClassName( c : Class<Dynamic> ) : String {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function getEnumName( e : Enum<Dynamic> ) : String {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function resolveClass( name : String ) : Class<Dynamic> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function resolveEnum( name : String ) : Enum<Dynamic> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function createInstance<T>( cl : Class<T>, args : Array<Dynamic> ) : T {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function createEmptyInstance<T>( cl : Class<T> ) : T {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function createEnum<T>( e : Enum<T>, constr : String, ?params : Array<Dynamic> ) : T {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function createEnumIndex<T>( e : Enum<T>, index : Int, ?params : Array<Dynamic> ) : T {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function getInstanceFields( c : Class<Dynamic> ) : Array<String> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function getClassFields( c : Class<Dynamic> ) : Array<String> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function getEnumConstructs( e : Enum<Dynamic> ) : Array<String> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function typeof( v : Dynamic ) : ValueType {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function enumEq<T:EnumValue>( a : T, b : T ) : Bool {
+		throw "TODO";
+		return false;
+	}
+	
+	public static function enumConstructor( e : EnumValue ) : String {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function enumParameters( e : EnumValue ) : Array<Dynamic> {
+		throw "TODO";
+		return null;
+	}
+	
+	public static function enumIndex( e : EnumValue ) : Int {
+		throw "TODO";
+		return 0;
+	}
+
+	public static function allEnums<T>( e : Enum<T> ) : Array<T> {
+		throw "TODO";
+		return null;
+	}
+
+}

+ 5 - 0
std/hl/types/Bytes.hx

@@ -53,6 +53,11 @@ package hl.types;
 		return 0.;
 	}
 	
+	@:hlNative("std","bytes_compare")
+	public function compare( pos : Int, bytes : Bytes, bytesPos : Int, size : Int ) : Int {
+		return 0;
+	}
+	
 	/**
 		Count the number of UTF8 chars into the given Bytes data.
 	**/

+ 22 - 13
std/hl/types/NativeBytesMap.hx

@@ -23,31 +23,40 @@ class NativeBytesMapIterator {
 abstract NativeBytesMap(NativeAbstract<"BytesMap">) {
 
 	@:extern public inline function new() {
-		this = untyped $hballoc();
+		this = alloc();
+	}
+	
+	@:hlNative("std","hballoc") function alloc() : NativeAbstract<"BytesMap"> {
+		return null;
 	}
 
-	@:extern public inline function set( key : Bytes, value : Dynamic ) {
-		untyped $hbset(this, key, value);
+	@:hlNative("std","hbset")
+	public function set( key : Bytes, value : Dynamic ) {
 	}
 
-	@:extern public inline function exists( key : Bytes ) : Bool {
-		return untyped $hbexists(this, key);
+	@:hlNative("std","hbexists")
+	public function exists( key : Bytes ) : Bool {
+		return false;
 	}
 	
-	@:extern public inline function get( key : Bytes ) : Dynamic {
-		return untyped $hbget(this, key);
+	@:hlNative("std","hbget")
+	public function get( key : Bytes ) : Dynamic {
+		return null;
 	}
 
-	@:extern public inline function remove( key : Bytes ) : Bool {
-		return untyped $hbremove(this, key);
+	@:hlNative("std","hbremove")
+	public function remove( key : Bytes ) : Bool {
+		return false;
 	}
 
-	@:extern public inline function keysArray() : NativeArray<Bytes> {
-		return untyped $hbkeys(this);
+	@:hlNative("std","hbkeys")
+	public function keysArray() : NativeArray<Bytes> {
+		return null;
 	}
 
-	@:extern public inline function valuesArray() : NativeArray<Dynamic> {
-		return untyped $hbvalues(this);
+	@:hlNative("std","hbvalues")
+	public function valuesArray() : NativeArray<Dynamic> {
+		return null;
 	}
 
 	@:extern public inline function iterator() {