Bläddra i källkod

Std.string working

Nicolas Cannasse 10 år sedan
förälder
incheckning
082f73c351
4 ändrade filer med 65 tillägg och 12 borttagningar
  1. 45 11
      genhl.ml
  2. 6 0
      std/hl/_std/Std.hx
  3. 5 1
      std/hl/_std/String.hx
  4. 9 0
      std/hl/types/Bytes.hx

+ 45 - 11
genhl.ml

@@ -480,7 +480,7 @@ and class_type ctx c =
 		) c.cl_ordered_fields;
 		(try
 			let cf = PMap.find "toString" c.cl_fields in
-			if List.memq cf c.cl_overrides then raise Not_found;
+			if List.memq cf c.cl_overrides || PMap.mem "__string" c.cl_fields then raise Not_found;
 			DynArray.add pa { fname = "__string"; fid = alloc_string ctx "__string"; fmethod = alloc_fun_path ctx c.cl_path "__string"; fvirtual = None; }
 		with Not_found ->
 			());
@@ -1273,7 +1273,7 @@ let generate_member ctx c f =
 	| Var _ -> ()
 	| Method m ->
 		make_fun ctx (alloc_fid ctx c f) (match f.cf_expr with Some { eexpr = TFunction f } -> f | _ -> assert false) (Some c);
-		if f.cf_name = "toString" && not (List.memq f c.cl_overrides) then begin
+		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 *)
 			let ethis = mk (TConst TThis) (TInst (c,List.map snd c.cl_params)) p in
@@ -1698,31 +1698,53 @@ let interp code =
 
 	let error msg = raise (Runtime_error msg) in
 
-	let rec vstr v =
+	let rec vstr_d v =
 		match v with
 		| VNull -> "null"
 		| VInt i -> Int32.to_string i ^ "i"
 		| VFloat f -> string_of_float f ^ "f"
 		| VBool b -> if b then "true" else "false"
-		| VDyn (v,t) -> "dyn(" ^ vstr v ^ ")"
+		| VDyn (v,t) -> "dyn(" ^ vstr_d v ^ ")"
 		| VObj o ->
 			let p = "#" ^ o.oproto.pclass.pname in
 			let fid = ref None in
 			Array.iter (fun p -> if p.fname = "__string" then fid := Some p.fmethod) o.oproto.pclass.pproto;
 			(match !fid with
 			| None -> p
-			| Some f -> p ^ ":" ^ vstr (fcall (func f) [v]))
+			| Some f -> p ^ ":" ^ vstr_d (fcall (func f) [v]))
 		| VBytes b -> "bytes(" ^ (if String.length b > 0 && String.get b (String.length b - 1) = '\x00' then String.sub b 0 (String.length b - 1) else b) ^ ")"
 		| VClosure (f,o) ->
 			(match o with
 			| None -> fstr f
-			| Some v -> fstr f ^ "(" ^ vstr v ^ ")")
-		| VArray (a,t) -> "array<" ^ tstr t ^ ">(" ^ String.concat "," (Array.to_list (Array.map vstr a)) ^ ")"
+			| Some v -> fstr f ^ "(" ^ vstr_d v ^ ")")
+		| VArray (a,t) -> "array<" ^ tstr t ^ ">(" ^ String.concat "," (Array.to_list (Array.map vstr_d a)) ^ ")"
 		| VUndef -> "undef"
 		| VType t -> "type(" ^ tstr t ^ ")"
-		| VRef (regs,i) -> "ref(" ^ vstr regs.(i) ^ ")"
-		| VVirtual v -> "virtual(" ^ vstr v.vvalue ^ ")"
-		| VDynObj d -> "dynobj(" ^ String.concat "," (Hashtbl.fold (fun f i acc -> (f^":"^vstr d.dvalues.(i)) :: acc) d.dfields []) ^ ")"
+		| VRef (regs,i) -> "ref(" ^ vstr_d regs.(i) ^ ")"
+		| 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 []) ^ ")"
+
+	and vstr v =
+		match v with
+		| VNull -> "null"
+		| VInt i -> Int32.to_string i
+		| VFloat f -> string_of_float f
+		| VBool b -> if b then "true" else "false"
+		| VDyn (v,_) -> vstr v
+		| VObj o ->
+			let fid = ref None in
+			Array.iter (fun p -> if p.fname = "__string" then fid := Some p.fmethod) o.oproto.pclass.pproto;
+			(match !fid with
+			| None -> "#" ^ o.oproto.pclass.pname
+			| Some f -> vstr (fcall (func f) [v]))
+		| VBytes b -> (if String.length b > 0 && String.get b (String.length b - 1) = '\x00' then String.sub b 0 (String.length b - 1) else b)
+		| VClosure (f,_) -> fstr f
+		| VArray (a,_) -> "[" ^ String.concat ", " (Array.to_list (Array.map vstr a)) ^ "]"
+		| VUndef -> "undef"
+		| VType t -> tstr t
+		| VRef (regs,i) -> "*" ^ (vstr regs.(i))
+		| VVirtual v -> vstr v.vvalue
+		| VDynObj d -> "{" ^ String.concat ", " (Hashtbl.fold (fun f i acc -> (f^":"^vstr d.dvalues.(i)) :: acc) d.dfields []) ^ "}"
 
 	and fstr = function
 		| FFun f -> "function@" ^ string_of_int f.findex
@@ -2089,13 +2111,25 @@ let interp code =
 				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))
 		)
 	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;
 	match functions.(code.entrypoint) with
-	| FFun f when f.ftype = HFun([],HVoid) -> (try call f [] with InterpThrow v -> error ("Uncaught exception " ^ vstr v))
+	| FFun f when f.ftype = HFun([],HVoid) -> (try call f [] with InterpThrow v -> error ("Uncaught exception " ^ vstr_d v))
 	| _ -> assert false
 
 (* --------------------------------------------------------------------------------------------------------------------- *)

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

@@ -26,5 +26,11 @@ class Std {
 	public static inline function int( v : Float ) : Int {
 		return untyped $int(v);
 	}
+	
+	public static function string( v : Dynamic ) : String {
+		var len = 0;
+		var bytes = hl.types.Bytes.ofValue(v,new hl.types.Ref(len));
+		return @:privateAccess String.__alloc__(bytes,len,bytes.utf8Length(0,len));
+	}
 
 }

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

@@ -66,7 +66,11 @@ class String {
 		return null;
 	}
 	
-	@:keep static function __alloc__( b : hl.types.Bytes, blen : Int, clen : Int ) : String {
+	@:keep function __string() : hl.types.Bytes {
+		return bytes;
+	}
+	
+	@:keep static inline function __alloc__( b : hl.types.Bytes, blen : Int, clen : Int ) : String {
 		var s : String = untyped $new(String);
 		s.bytes = b;
 		s.length = clen;

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

@@ -14,4 +14,13 @@ package hl.types;
 		untyped $bset(this,pos,value);
 		return value;
 	}
+	@:hlNative("std","utf8length")
+	function utf8Length( startPos : Int, bytesCount : Int ) : Int {
+		return 0;
+	}
+	
+	@:hlNative("std","value_to_string")
+	public static function ofValue( v : Dynamic, len : Ref<Int> ) : Bytes {
+		return null;
+	}
 }