浏览代码

allow abstract to abstract cast

Simon Krajewski 12 年之前
父节点
当前提交
7572590658
共有 3 个文件被更改,包括 44 次插入8 次删除
  1. 16 8
      codegen.ml
  2. 22 0
      tests/unit/MyAbstract.hx
  3. 6 0
      tests/unit/TestBasetypes.hx

+ 16 - 8
codegen.ml

@@ -1317,7 +1317,7 @@ let handle_abstract_casts ctx e =
 	let find_from_cast c a t p =
 		let rec loop cfl = match cfl with
 			| [] ->
-				error (Printf.sprintf "Cannot cast %s to %s" (s_type_path a.a_path) (s_type (print_context()) t)) p;
+				raise Not_found
 			| cf :: cfl when has_meta ":from" cf.cf_meta ->
 				begin match follow cf.cf_type with
 				| TFun([_,_,ta],_) when type_iseq ta t ->
@@ -1333,7 +1333,7 @@ let handle_abstract_casts ctx e =
 	let find_to_cast c a t p =
 		let rec loop cfl = match cfl with
 			| [] ->
-				error (Printf.sprintf "Cannot cast %s to %s" (s_type (print_context()) t) (s_type_path a.a_path)) p;
+				raise Not_found
 			| cf :: cfl when has_meta ":to" cf.cf_meta ->
 				begin match follow cf.cf_type with
 				| TFun([ta],r) when type_iseq r t ->
@@ -1349,18 +1349,26 @@ let handle_abstract_casts ctx e =
 	let rec check_cast tleft eright p =
 		let eright = loop eright in
 		match follow tleft,follow eright.etype with
-		| TAbstract({a_impl = Some _} as a1,_),TAbstract({a_impl = Some _} as a2,_) ->
-			if a1 != a2 then
-				error "not implemented yet" p
-			else
+		| (TAbstract({a_impl = Some c1} as a1,_) as t1),(TAbstract({a_impl = Some c2} as a2,_) as t2) ->
+			if a1 == a2 then
 				eright
+			else begin
+				let c,cf = try
+					c1,find_from_cast c1 a1 t2 p
+				with Not_found -> try
+					c2,find_to_cast c2 a2 t1 p
+				with Not_found ->
+					error (Printf.sprintf "Cannot cast %s to %s" (s_type_path a2.a_path) (s_type_path a1.a_path)) p
+				in
+				make_cast_call c cf [eright] tleft p
+			end
 		| TDynamic _,_ | _,TDynamic _ ->
 			eright
 		| TAbstract({a_impl = Some c} as a ,_),t ->
-			let cf = find_from_cast c a eright.etype p in
+			let cf = try find_from_cast c a eright.etype p with Not_found -> error (Printf.sprintf "Cannot cast %s to %s" (s_type_path a.a_path) (s_type (print_context()) t)) p in
 			make_cast_call c cf [eright] tleft p
 		| t,TAbstract({a_impl = Some c} as a,_) ->
-			let cf = find_to_cast c a t p in
+			let cf = try find_to_cast c a t p with Not_found -> error (Printf.sprintf "Cannot cast %s to %s" (s_type (print_context()) t) (s_type_path a.a_path)) p in
 			make_cast_call c cf [eright] tleft p
 		| _ ->
 			eright

+ 22 - 0
tests/unit/MyAbstract.hx

@@ -31,4 +31,26 @@ abstract TemplateWrap(haxe.Template) {
 	@:to inline function toString() {
 		return this.execute( { t: "really works!"});
 	}
+}
+
+abstract Meter(Float) {
+	public inline function new(f)
+		this = f
+	
+	public inline function get()
+		return this
+		
+	@:from static public inline function fromFloat(f:Float)
+		return new Meter(f)
+}
+
+abstract Kilometer(Float) {
+	public inline function new(f)
+		this = f
+		
+	@:from static public inline function fromMeter(m:Meter)
+		return new Kilometer(m.get() / 1000.)
+		
+	@:to public inline function toFloat()
+		return this
 }

+ 6 - 0
tests/unit/TestBasetypes.hx

@@ -348,4 +348,10 @@ class TestBasetypes extends Test {
 		var arr:Array<String> = [tpl];
 		eq(arr[0], "Abstract casting really works!");
 	}
+	
+	function testAbstractToAbstractCast() {
+		var m:unit.MyAbstract.Meter = 122.2;
+		var km:unit.MyAbstract.Kilometer = m;
+		feq(km, 0.1222);
+	}
 }