From d3527fcc2051457f0aa40488ac882731269d9c8a Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 27 Mar 2023 12:05:21 +0200 Subject: [PATCH] [typer] type int literals as float where expected see #10918 --- src/core/texpr.ml | 31 +++++++++++++++++++++---------- src/core/withType.ml | 5 ++--- src/optimization/analyzer.ml | 2 +- src/typing/matcher.ml | 2 +- src/typing/typer.ml | 4 ++-- 5 files changed, 27 insertions(+), 17 deletions(-) diff --git a/src/core/texpr.ml b/src/core/texpr.ml index 37a72d128c8..528c839c08d 100644 --- a/src/core/texpr.ml +++ b/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 = diff --git a/src/core/withType.ml b/src/core/withType.ml index 6f42b3d4f96..5ca9034581c 100644 --- a/src/core/withType.ml +++ b/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 diff --git a/src/optimization/analyzer.ml b/src/optimization/analyzer.ml index 8b79d8d6e42..df267e2d45a 100644 --- a/src/optimization/analyzer.ml +++ b/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) -> diff --git a/src/typing/matcher.ml b/src/typing/matcher.ml index ff4a8dafa9d..c74fe03f9b4 100644 --- a/src/typing/matcher.ml +++ b/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,[]) diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 19eff1464d4..6e920b18eb5 100644 --- a/src/typing/typer.ml +++ b/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