2
0
Эх сурвалжийг харах

partial unify_int support

Nicolas Cannasse 16 жил өмнө
parent
commit
cc2d17218c
1 өөрчлөгдсөн 30 нэмэгдсэн , 17 устгасан
  1. 30 17
      typer.ml

+ 30 - 17
typer.ml

@@ -514,6 +514,16 @@ let type_field ctx e i p get =
 	| t ->
 		no_field()
 
+(*
+	We want to try unifying as an integer and apply side effects.
+	However, in case the value is not a normal Monomorph but one issued
+	from a Dynamic relaxation, we will instead unify with float since
+	we don't want to accidentaly truncate the value
+*)
+let unify_int ctx e =
+	unify ctx e.etype ctx.api.tint e.epos;
+	true
+
 let rec type_binop ctx op e1 e2 p =
 	match op with
 	| OpAssign ->
@@ -573,12 +583,14 @@ let rec type_binop ctx op e1 e2 p =
 		| KInt, KFloat
 		| KFloat, KFloat ->
 			ctx.api.tfloat
-		| KUnk , KInt
+		| KUnk , KInt ->
+			if unify_int ctx e1 then ctx.api.tint else ctx.api.tfloat
 		| KUnk , KFloat
 		| KUnk , KString  ->
 			unify ctx e1.etype e2.etype e1.epos;
 			e1.etype
-		| KInt , KUnk
+		| KInt , KUnk ->
+			if unify_int ctx e2 then ctx.api.tint else ctx.api.tfloat
 		| KFloat , KUnk
 		| KString , KUnk ->
 			unify ctx e2.etype e1.etype e2.epos;
@@ -590,10 +602,9 @@ let rec type_binop ctx op e1 e2 p =
 		| KDyn , _ ->
 			e1.etype
 		| KUnk , KUnk ->
-			let t = ctx.api.tint in
-			unify ctx e1.etype t e1.epos;
-			unify ctx e2.etype t e2.epos;
-			t
+			let ok1 = unify_int ctx e1 in
+			let ok2 = unify_int ctx e2 in
+			if ok1 && ok2 then ctx.api.tint else ctx.api.tfloat
 		| KParam t1, KParam t2 when t1 == t2 ->
 			t1
 		| KParam t, KInt | KInt, KParam t ->
@@ -621,7 +632,6 @@ let rec type_binop ctx op e1 e2 p =
 	| OpMult
 	| OpDiv
 	| OpSub ->
-		let i = ctx.api.tint in
 		let result = ref (if op = OpDiv then ctx.api.tfloat else ctx.api.tint) in
 		(match classify e1.etype, classify e2.etype with
 		| KFloat, KFloat ->
@@ -635,14 +645,16 @@ let rec type_binop ctx op e1 e2 p =
 		| KParam _, KFloat | KFloat, KParam _ ->
 			result := ctx.api.tfloat
 		| KFloat, _ ->
-			unify ctx e2.etype i e2.epos;
+			ignore(unify_int ctx e2);
 			result := ctx.api.tfloat
 		| _, KFloat ->
-			unify ctx e1.etype i e1.epos;
+			ignore(unify_int ctx e1);
 			result := ctx.api.tfloat
 		| _ , _ ->
-			unify ctx e1.etype i e1.epos;
-			unify ctx e2.etype i e2.epos);
+			let ok1 = unify_int ctx e1 in
+			let ok2 = unify_int ctx e2 in
+			if not ok1 || not ok2  then result := ctx.api.tfloat;
+		);
 		mk_op !result
 	| OpEq
 	| OpNotEq ->
@@ -657,11 +669,13 @@ let rec type_binop ctx op e1 e2 p =
 	| OpLte ->
 		(match classify e1.etype, classify e2.etype with
 		| KInt , KInt | KInt , KFloat | KFloat , KInt | KFloat , KFloat | KString , KString -> ()
-		| KInt , KUnk | KFloat , KUnk | KString , KUnk -> unify ctx e2.etype e1.etype e2.epos
-		| KUnk , KInt | KUnk , KFloat | KUnk , KString -> unify ctx e1.etype e2.etype e1.epos
+		| KInt , KUnk -> ignore(unify_int ctx e2)
+		| KFloat , KUnk | KString , KUnk -> unify ctx e2.etype e1.etype e2.epos
+		| KUnk , KInt -> ignore(unify_int ctx e1)
+		| KUnk , KFloat | KUnk , KString -> unify ctx e1.etype e2.etype e1.epos
 		| KUnk , KUnk ->
-			unify ctx e1.etype ctx.api.tint e1.epos;
-			unify ctx e2.etype ctx.api.tint e2.epos;
+			ignore(unify_int ctx e1);
+			ignore(unify_int ctx e2);
 		| KDyn , KInt | KDyn , KFloat | KDyn , KString -> ()
 		| KInt , KDyn | KFloat , KDyn | KString , KDyn -> ()
 		| KDyn , KDyn -> ()
@@ -715,8 +729,7 @@ and type_unop ctx op flag e p =
 				unify ctx e.etype ctx.api.tfloat e.epos;
 				t
 			| _ ->
-				unify ctx e.etype ctx.api.tint e.epos;
-				ctx.api.tint)
+				if unify_int ctx e then ctx.api.tint else ctx.api.tfloat)
 		) in
 		match op, e.eexpr with
 		| Neg , TConst (TInt i) -> mk (TConst (TInt (Int32.neg i))) t p