diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 563add19a67..f8e27c8da0d 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -737,6 +737,7 @@ type TcGlobals( let v_bitwise_unary_not_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_LogicalNot" , None , None , [vara], mk_unop_ty varaTy) let v_bitwise_shift_left_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_LeftShift" , None , None , [vara], mk_shiftop_ty varaTy) let v_bitwise_shift_right_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_RightShift" , None , None , [vara], mk_shiftop_ty varaTy) + let v_exponentiation_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Exponentiation" , None , None , [vara;varb], ([[varaTy];[varbTy]], varaTy)) let v_unchecked_addition_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Addition" , None , None , [vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) let v_unchecked_subtraction_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Subtraction" , None , None , [vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) let v_unchecked_multiply_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Multiply" , None , None , [vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) @@ -1550,6 +1551,7 @@ type TcGlobals( member val bitwise_unary_not_vref = ValRefForIntrinsic v_bitwise_unary_not_info member val bitwise_shift_left_vref = ValRefForIntrinsic v_bitwise_shift_left_info member val bitwise_shift_right_vref = ValRefForIntrinsic v_bitwise_shift_right_info + member val exponentiation_vref = ValRefForIntrinsic v_exponentiation_info member val unchecked_addition_vref = ValRefForIntrinsic v_unchecked_addition_info member val unchecked_unary_plus_vref = ValRefForIntrinsic v_unchecked_unary_plus_info member val unchecked_unary_minus_vref = ValRefForIntrinsic v_unchecked_unary_minus_info @@ -1894,7 +1896,7 @@ type TcGlobals( Some (info, tyargs, argExprs) | "Pow", [aty;bty], _, [_;_] -> // Call Operators.(**) - let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "op_Exponentiation", None, None, [vara; varb], ([[varaTy]; [varbTy]], varaTy)) + let info = v_exponentiation_info let tyargs = [aty;bty] Some (info, tyargs, argExprs) | "Atan2", [aty;_], Some bty, [_;_] -> diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 8d555ba3ec7..774f994aaa1 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3767,6 +3767,12 @@ let (|IntegerConstExpr|_|) expr = | Expr.Const (Const.UInt64 _, _, _) -> Some () | _ -> None +let (|FloatConstExpr|_|) expr = + match expr with + | Expr.Const (Const.Single _, _, _) + | Expr.Const (Const.Double _, _, _) -> Some () + | _ -> None + let (|SpecificBinopExpr|_|) g vrefReqd expr = match expr with | BinopExpr g (vref, arg1, arg2) when valRefEq g vref vrefReqd -> Some (arg1, arg2) @@ -9582,7 +9588,7 @@ let IsSimpleSyntacticConstantExpr g inputExpr = valRefEq g vref g.bitwise_unary_not_vref || valRefEq g vref g.enum_vref) -> checkExpr vrefs arg - // compare, =, <>, +, -, <, >, <=, >=, <<<, >>>, &&& + // compare, =, <>, +, -, <, >, <=, >=, <<<, >>>, &&&, |||, ^^^ | BinopExpr g (vref, arg1, arg2) when (valRefEq g vref g.equals_operator_vref || valRefEq g vref g.compare_operator_vref || @@ -9595,12 +9601,13 @@ let IsSimpleSyntacticConstantExpr g inputExpr = valRefEq g vref g.unchecked_addition_vref || valRefEq g vref g.unchecked_multiply_vref || valRefEq g vref g.unchecked_subtraction_vref || - // Note: division and modulus can raise exceptions, so are not included + // Note: division and modulus can raise exceptions, so are not included valRefEq g vref g.bitwise_shift_left_vref || valRefEq g vref g.bitwise_shift_right_vref || valRefEq g vref g.bitwise_xor_vref || valRefEq g vref g.bitwise_and_vref || - valRefEq g vref g.bitwise_or_vref) && + valRefEq g vref g.bitwise_or_vref || + valRefEq g vref g.exponentiation_vref) && (not (typeEquiv g (tyOfExpr g arg1) g.string_ty) && not (typeEquiv g (tyOfExpr g arg1) g.decimal_ty) ) -> checkExpr vrefs arg1 && checkExpr vrefs arg2 | Expr.Val (vref, _, _) -> vref.Deref.IsCompiledAsStaticPropertyWithoutField || vrefs.Contains vref.Stamp @@ -9789,6 +9796,36 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) = | _ -> errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)) x + | SpecificBinopExpr g g.bitwise_xor_vref (arg1, arg2) -> + checkFeature() + let v1 = EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1 + + match v1 with + | IntegerConstExpr -> + EvalArithBinOp ((^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) + | _ -> + errorR (Error (FSComp.SR.tastNotAConstantExpression(), x.Range)) + x + | SpecificBinopExpr g g.exponentiation_vref (arg1, arg2) -> + checkFeature() + let v1 = EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1 + + match v1 with + | FloatConstExpr -> + EvalArithBinOp (ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ( ** ), ( ** )) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2) + | _ -> + errorR (Error (FSComp.SR.tastNotAConstantExpression(), x.Range)) + x + | SpecificUnopExpr g g.bitwise_unary_not_vref arg1 -> + checkFeature() + let v1 = EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1 + + match v1 with + | IntegerConstExpr -> + EvalArithUnOp ((~~~), (~~~), (~~~), (~~~), (~~~), (~~~), (~~~), (~~~), ignore, ignore) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) + | _ -> + errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)) + x | SpecificUnopExpr g g.unchecked_unary_minus_vref arg1 -> checkFeature() let v1 = EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1 diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs index 5c0d3211aea..77a3e8786f9 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs @@ -41,6 +41,8 @@ let [] bytesInKilobyte2 = bytesInMegabyte / 1024L let [] secondsInDayPlusThree = 3 + (60 * 60 * 24) let [] bitwise = 1us &&& (3us ||| 4us) + +let [] bitwise2 = 1y ^^^ (3y + ~~~4y) """ |> withLangVersionPreview |> compile @@ -51,6 +53,7 @@ let [] bitwise = 1us &&& (3us ||| 4us) """.field public static literal int64 bytesInKilobyte2 = int64(0x400)""" """.field public static literal int32 secondsInDayPlusThree = int32(0x00015183)""" """.field public static literal uint16 bitwise = uint16(0x0001)""" + """.field public static literal int8 bitwise2 = int8(0xFF)""" ] [] @@ -62,6 +65,8 @@ module LiteralArithmetic let [] bytesInMegabyte = 1024. * 1024. + 0.1 +let [] bytesInMegabyte' = 1024f ** 2f + let [] bytesInKilobyte = bytesInMegabyte / 1024. + 0.1 let [] secondsInDayPlusThree = 3.1f + (60f * 60f * 24f) @@ -73,6 +78,10 @@ let [] chars = 'a' + 'b' - 'a' |> shouldSucceed |> verifyIL [ """.field public static literal float64 bytesInMegabyte = float64(1048576.1000000001)""" + if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then + """.field public static literal float32 'bytesInMegabyte\'' = float32(1048576.)""" + else + """.field public static literal float32 'bytesInMegabyte\'' = float32(1048576)""" """.field public static literal float64 bytesInKilobyte = float64(1024.10009765625)""" """.field public static literal float32 secondsInDayPlusThree = float32(86403.102)""" """.field public static literal char chars = char(0x0062)"""