changed abstract syntax for types relations

ast.ml

@@ -245,8 +245,8 @@ type class_flag =
 
 type abstract_flag =
 	| APrivAbstract
-	| ASubType of complex_type
-	| ASuperType of complex_type
+	| AFromType of complex_type
+	| AToType of complex_type
 	| AIsType of complex_type
 
 type enum_constructor = {

gencommon.ml

@@ -67,13 +67,13 @@ let rec like_float t =
   match follow t with
     | TAbstract({ a_path = ([], "Float") },[])
     | TAbstract({ a_path = ([], "Int") },[]) -> true
-    | TAbstract(a, _) -> List.exists like_float a.a_super || List.exists like_float a.a_sub
+    | TAbstract(a, _) -> List.exists like_float a.a_from || List.exists like_float a.a_to
     | _ -> false
 
 let rec like_int t =
   match follow t with
     | TAbstract({ a_path = ([], "Int") },[]) -> true
-    | TAbstract(a, _) -> List.exists like_int a.a_super || List.exists like_float a.a_sub
+    | TAbstract(a, _) -> List.exists like_int a.a_from || List.exists like_float a.a_to
     | _ -> false
 
 
@@ -3644,11 +3644,11 @@ struct
             List.iter (fun t ->
               let t = apply_params a2.a_types params2 t in
               get_arg original t
-            ) a2.a_super;
+            ) a2.a_to;
             List.iter (fun t ->
               let t = apply_params a.a_types params t in
               get_arg t applied
-            ) a.a_sub
+            ) a.a_from
           end
 
         | TInst(cl, params), TInst(cl2, params2) ->
@@ -3674,12 +3674,12 @@ struct
           List.iter (fun t ->
             let t = apply_params a.a_types params t in
             get_arg t applied
-          ) a.a_sub
+          ) a.a_from
         | _, TAbstract(a2, params2) ->
           List.iter (fun t ->
             let t = apply_params a2.a_types params2 t in
             get_arg original t
-          ) a2.a_super
+          ) a2.a_to
 
         | TEnum(e, params), TEnum(e2, params2) ->
           List.iter2 (get_arg) params params2

genxml.ml

@@ -194,8 +194,8 @@ let gen_type_decl com pos t =
 	| TAbstractDecl a ->
 		let doc = gen_doc_opt a.a_doc in
 		let meta = gen_meta a.a_meta in
-		let sub = (match a.a_sub with [] -> [] | l -> [node "sub" [] (List.map gen_type l)]) in
-		let super = (match a.a_super with [] -> [] | l -> [node "super" [] (List.map gen_type l)]) in
+		let sub = (match a.a_from with [] -> [] | l -> [node "from" [] (List.map gen_type l)]) in
+		let super = (match a.a_to with [] -> [] | l -> [node "to" [] (List.map gen_type l)]) in
 		node "abstract" (gen_type_params pos a.a_private (tpath t) a.a_types a.a_pos m) (sub @ super @ doc @ meta)
 
 let att_str att =

parser.ml

@@ -247,8 +247,9 @@ and parse_type_decl s =
 				d_flags = List.map snd c;
 				d_data = t;
 			}, punion p1 p2)
-		| [< '(Kwd Abstract,p1); doc = get_doc; name = type_name; tl = parse_constraint_params; sl = psep Comma parse_abstract_relations; '(BrOpen,_); fl, p2 = parse_class_fields false p1 >] ->
+		| [< '(Kwd Abstract,p1); doc = get_doc; name = type_name; st = parse_abstract_subtype; tl = parse_constraint_params; sl = plist parse_abstract_relations; '(BrOpen,_); fl, p2 = parse_class_fields false p1 >] ->
 			let flags = List.map (fun (_,c) -> match c with EPrivate -> APrivAbstract | EExtern -> error (Custom "extern abstract not allowed") p1) c in
+			let flags = (match st with None -> flags | Some t -> AIsType t :: flags) in
 			(EAbstract {
 				d_name = name;
 				d_doc = doc;
@@ -289,9 +290,13 @@ and parse_import s p1 =
 
 and parse_abstract_relations s =
 	match s with parser
-	| [< '(Binop OpLte,_); t = parse_complex_type >] -> ASuperType t
-	| [< '(Binop OpAssign,p1); '(Binop OpGt,p2) when p1.pmax = p2.pmin; t = parse_complex_type >] -> ASubType t
-	| [< '(POpen, _); t = parse_complex_type; '(PClose,_) >] -> AIsType t
+	| [< '(Const (Ident "to"),_); t = parse_complex_type >] -> AToType t
+	| [< '(Const (Ident "from"),_); t = parse_complex_type >] -> AFromType t
+
+and parse_abstract_subtype s =
+	match s with parser
+	| [< '(POpen, _); t = parse_complex_type; '(PClose,_) >] -> Some t
+	| [< >] -> None
 
 and parse_package s = psep Dot lower_ident_or_macro s
 

std/StdTypes.hx

@@ -34,18 +34,18 @@ abstract Void { }
 /**
 	The standard Int type. Its precision depends on the platform.
 **/
-@:notNull @:runtimeValue abstract Int <= Float { }
+@:coreType @:notNull @:runtimeValue abstract Int to Float { }
 
 #if (flash9 || flash9doc || cs)
 /**
 	The unsigned Int type is only defined for Flash9. It's currently
 	handled the same as a normal Int.
 **/
-@:notNull @:runtimeValue abstract UInt => Int, <= Int { }
+@:coreType @:notNull @:runtimeValue abstract UInt to Int from Int { }
 #end
 
 #if (java || cs)
-@:notNull @:runtimeValue abstract Single => Float, <= Float {}
+@:coreType @:notNull @:runtimeValue abstract Single to Float from Float {}
 #end
 
 /**

tests/unit/MyAbstract.hx

@@ -2,7 +2,7 @@ package unit;
 
 abstract MyAbstract(Int) {
 
-    public /*inline*/ function new(x) {
+    public inline function new(x) {
         this = x;
     }
 

type.ml

@@ -246,9 +246,9 @@ and tabstract = {
 	mutable a_types : type_params;
 
 	mutable a_impl : tclass option;
-	mutable a_this : t;	
-	mutable a_sub : t list;
-	mutable a_super : t list;
+	mutable a_this : t;
+	mutable a_from : t list;
+	mutable a_to : t list;
 }
 
 and module_type =
@@ -996,10 +996,10 @@ let rec unify a b =
 		if not (List.exists (fun t ->
 			let t = apply_params a1.a_types tl1 t in
 			try unify t b; true with Unify_error _ -> false
-		) a1.a_super) && not (List.exists (fun t ->
+		) a1.a_to) && not (List.exists (fun t ->
 			let t = apply_params a2.a_types tl2 t in
 			try unify a t; true with Unify_error _ -> false
-		) a2.a_sub) then error [cannot_unify a b]
+		) a2.a_from) then error [cannot_unify a b]
 	| TInst (c1,tl1) , TInst (c2,tl2) ->
 		let rec loop c tl =
 			if c == c2 then begin
@@ -1146,7 +1146,7 @@ let rec unify a b =
 		if not (List.exists (fun t ->
 			let t = apply_params aa.a_types tl t in
 			try unify t b; true with Unify_error _ -> false
-		) aa.a_super) then error [cannot_unify a b];
+		) aa.a_to) then error [cannot_unify a b];
 	| TInst ({ cl_kind = KTypeParameter ctl } as c,pl), TAbstract _ ->
 		(* one of the constraints must satisfy the abstract *)
 		if not (List.exists (fun t ->
@@ -1157,7 +1157,7 @@ let rec unify a b =
 		if not (List.exists (fun t ->
 			let t = apply_params bb.a_types tl t in
 			try unify a t; true with Unify_error _ -> false
-		) bb.a_sub) then error [cannot_unify a b];
+		) bb.a_from) then error [cannot_unify a b];
 	| _ , _ ->
 		error [cannot_unify a b]
 

typeload.ml

@@ -103,8 +103,8 @@ let make_module ctx mpath file tdecls loadp =
 				a_doc = d.d_doc;
 				a_types = [];
 				a_meta = d.d_meta;
-				a_sub = [];
-				a_super = [];
+				a_from = [];
+				a_to = [];
 				a_impl = None;
 				a_this = mk_mono();
 			} in
@@ -134,6 +134,7 @@ let make_module ctx mpath file tdecls loadp =
 							fu with
 							f_expr = (match fu.f_expr with
 							| None -> None
+							| Some (EBlock [EBinop (OpAssign,(EConst (Ident "this"),_),e),_],_) -> Some (EReturn (Some e), pos e)
 							| Some (EBlock el,p) -> Some (EBlock (init p :: el @ [ret p]),p)
 							| Some e -> Some (EBlock [init p;e;ret p],p)
 							)
@@ -1851,14 +1852,24 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 	| EAbstract d ->
 		let a = (match get_type d.d_name with TAbstractDecl a -> a | _ -> assert false) in
 		let ctx = { ctx with type_params = a.a_types } in
+		let is_type = ref false in
+		let load_type t =
+			let t = load_complex_type ctx p t in
+			if not (has_meta ":coreType" a.a_meta) then begin
+				if !is_type then begin
+					(try type_eq EqStrict a.a_this t with Unify_error _ -> error "You can only declare from/to with your subtype" p);
+				end else
+					error "Missing subtype declaration or @:coreType declaration" p;
+			end;
+			t
+		in
 		List.iter (function
-			| APrivAbstract -> ()
-			| ASubType t -> a.a_sub <- load_complex_type ctx p t :: a.a_sub
-			| ASuperType t -> a.a_super <- load_complex_type ctx p t :: a.a_super
+			| AFromType t -> a.a_from <- load_type t :: a.a_from
+			| AToType t -> a.a_to <- load_type t :: a.a_to
 			| AIsType t ->
-				(match a.a_this with
-				| TMono _ -> a.a_this <- load_complex_type ctx p t
-				| _ -> error "Duplicate This-type definition" p)
+				a.a_this <- load_complex_type ctx p t;
+				is_type := true;
+			| APrivAbstract -> ()
 		) d.d_flags
 
 let type_module ctx m file tdecls p =

typer.ml

@@ -83,7 +83,7 @@ let rec classify t =
 	| TInst ({ cl_path = ([],"String") },[]) -> KString
 	| TAbstract ({ a_path = [],"Int" },[]) -> KInt
 	| TAbstract ({ a_path = [],"Float" },[]) -> KFloat
-	| TAbstract (a,[]) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) a.a_super -> KParam t
+	| TAbstract (a,[]) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) a.a_to -> KParam t
 	| TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) ctl -> KParam t
 	| TMono r when !r = None -> KUnk
 	| TDynamic _ -> KDyn