Browse Source

[typer] type int literals as float where expected

see #10918
Simon Krajewski 2 years ago
parent
commit
d3527fcc20
5 changed files with 27 additions and 17 deletions
  1. 21 10
      src/core/texpr.ml
  2. 2 3
      src/core/withType.ml
  3. 1 1
      src/optimization/analyzer.ml
  4. 1 1
      src/typing/matcher.ml
  5. 2 2
      src/typing/typer.ml

+ 21 - 10
src/core/texpr.ml

@@ -569,12 +569,23 @@ let rec constructor_side_effects e =
 let replace_separators s c =
 	String.concat c (ExtString.String.nsplit s "_")
 
-let type_constant basic c p =
+let type_constant basic with_type c p =
 	match c with
 	| Int (s,_) ->
 		if String.length s > 10 && String.sub s 0 2 = "0x" then typing_error "Invalid hexadecimal integer" p;
-		(try mk (TConst (TInt (Int32.of_string s))) basic.tint p
-		with _ -> mk (TConst (TFloat s)) basic.tfloat p)
+		let float () =
+			mk (TConst (TFloat s)) basic.tfloat p
+		in
+		begin match with_type with
+			| WithType.WithType(t,_) when TOther.ExtType.is_float t ->
+				float()
+			| _ ->
+				begin try
+					mk (TConst (TInt (Int32.of_string s))) basic.tint p
+				with _ ->
+					float()
+				end
+			end
 	| Float (f,_) -> mk (TConst (TFloat f)) basic.tfloat p
 	| String(s,qs) -> mk (TConst (TString s)) basic.tstring p (* STRINGTODO: qs? *)
 	| Ident "true" -> mk (TConst (TBool true)) basic.tbool p
@@ -583,21 +594,21 @@ let type_constant basic c p =
 	| Ident t -> typing_error ("Invalid constant :  " ^ t) p
 	| Regexp _ -> typing_error "Invalid constant" p
 
-let rec type_constant_value basic (e,p) =
+let rec type_constant_value basic with_type (e,p) =
 	match e with
 	| EConst c ->
-		type_constant basic c p
+		type_constant basic with_type c p
 	| EParenthesis e ->
-		type_constant_value basic e
+		type_constant_value basic with_type e
 	| EObjectDecl el ->
-		mk (TObjectDecl (List.map (fun (k,e) -> k,type_constant_value basic e) el)) (mk_anon (ref Closed)) p
+		mk (TObjectDecl (List.map (fun (k,e) -> k,type_constant_value basic with_type e) el)) (mk_anon (ref Closed)) p
 	| EArrayDecl el ->
-		mk (TArrayDecl (List.map (type_constant_value basic) el)) (basic.tarray t_dynamic) p
+		mk (TArrayDecl (List.map (type_constant_value basic with_type) el)) (basic.tarray t_dynamic) p
 	| _ ->
 		typing_error "Constant value expected" p
 
 let is_constant_value basic e =
-	try (ignore (type_constant_value basic e); true) with Error (Custom _,_,_) -> false
+	try (ignore (type_constant_value basic WithType.value e); true) with Error (Custom _,_,_) -> false
 
 let for_remap basic v e1 e2 p =
 	let v' = alloc_var v.v_kind v.v_name e1.etype e1.epos in
@@ -640,7 +651,7 @@ let build_metadata api t =
 		mk (TObjectDecl (List.map (fun (f,el,p) ->
 			if Hashtbl.mem h f then typing_error ("Duplicate metadata '" ^ f ^ "'") p;
 			Hashtbl.add h f ();
-			(f,null_pos,NoQuotes), mk (match el with [] -> TConst TNull | _ -> TArrayDecl (List.map (type_constant_value api) el)) (api.tarray t_dynamic) p
+			(f,null_pos,NoQuotes), mk (match el with [] -> TConst TNull | _ -> TArrayDecl (List.map (type_constant_value api WithType.value) el)) (api.tarray t_dynamic) p
 		) ml)) t_dynamic p
 	in
 	let make_meta l =

+ 2 - 3
src/core/withType.ml

@@ -1,5 +1,3 @@
-open Type
-
 type with_type_source_information = {
 	si_name : string;
 	si_doc : string option;
@@ -13,7 +11,7 @@ type with_type_source =
 type t =
 	| NoValue
 	| Value of with_type_source option
-	| WithType of Type.t * with_type_source option
+	| WithType of TType.t * with_type_source option
 
 let make_with_type_source_information name doc = {
 	si_name = name;
@@ -39,4 +37,5 @@ let to_string = function
 			| Some(FunctionArgument si | StructureField si) -> si.si_name
 			| _ -> "None"
 		in
+		let open TPrinting in
 		Printf.sprintf "WithType(%s, %s)" (s_type (print_context()) t) name

+ 1 - 1
src/optimization/analyzer.ml

@@ -489,7 +489,7 @@ module ConstPropagation = DataFlow(struct
 			| Top | Bottom | EnumValue _ | Null _ ->
 				raise Not_found
 			| Const ct ->
-				let e' = Texpr.type_constant ctx.com.basic (tconst_to_const ct) e.epos in
+				let e' = Texpr.type_constant ctx.com.basic WithType.value (tconst_to_const ct) e.epos in
 				if not (type_change_ok ctx.com e'.etype e.etype) then raise Not_found;
 				e'
 			| ModuleType(mt,t) ->

+ 1 - 1
src/typing/matcher.ml

@@ -347,7 +347,7 @@ module Pattern = struct
 					| _ -> ()
 				end;
 				let p = pos e in
-				let e = Texpr.type_constant ctx.com.basic ct p in
+				let e = Texpr.type_constant ctx.com.basic (WithType.with_type t) ct p in
 				unify_expected e.etype;
 				let ct = match e.eexpr with TConst ct -> ct | _ -> die "" __LOC__ in
 				PatConstructor(con_const ct p,[])

+ 2 - 2
src/typing/typer.ml

@@ -1866,10 +1866,10 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		| other -> typing_error (other ^ " is not a valid integer suffix") p)
 	| EConst (Float (s, Some suffix) as c) ->
 		(match suffix with
-		| "f64" -> Texpr.type_constant ctx.com.basic c p
+		| "f64" -> Texpr.type_constant ctx.com.basic with_type c p
 		| other -> typing_error (other ^ " is not a valid float suffix") p)
 	| EConst c ->
-		Texpr.type_constant ctx.com.basic c p
+		Texpr.type_constant ctx.com.basic with_type c p
 	| EBinop (OpNullCoal,e1,e2) ->
 		let vr = new value_reference ctx in
 		let e1 = type_expr ctx (Expr.ensure_block e1) with_type in