Skip to content

Commit 8812aaf

Browse files
esbenbjerreesbenbjerre
committed
support decimal literal attribute
1 parent e754739 commit 8812aaf

File tree

15 files changed

+299
-52
lines changed

15 files changed

+299
-52
lines changed

‎docs/release-notes/.FSharp.Compiler.Service/9.0.200.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88

99
### Added
1010

11+
* Support literal attribute on decimals ([PR #17769](https://github.com/dotnet/fsharp/pull/17769))
1112

1213
### Changed
1314

‎src/Compiler/Checking/PostInferenceChecks.fs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1958,7 +1958,8 @@ and CheckAttribArgExpr cenv env expr =
19581958
| Const.Single _
19591959
| Const.Char _
19601960
| Const.Zero
1961-
| Const.String _ -> ()
1961+
| Const.String _
1962+
| Const.Decimal _ -> ()
19621963
| _ ->
19631964
if cenv.reportErrors then
19641965
errorR (Error (FSComp.SR.tastNotAConstantExpression(), m))

‎src/Compiler/CodeGen/IlxGen.fs‎

Lines changed: 66 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8563,10 +8563,15 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt =
85638563

85648564
let ilFieldDef = mkILStaticField (fspec.Name, fty, None, None, access)
85658565

8566+
let isDecimalConstant =
8567+
match vref.LiteralValue with
8568+
| Some(Const.Decimal _) -> true
8569+
| _ -> false
8570+
85668571
let ilFieldDef =
85678572
match vref.LiteralValue with
8568-
| Some konst -> ilFieldDef.WithLiteralDefaultValue(Some(GenFieldInit m konst))
8569-
| None -> ilFieldDef
8573+
| Some konst when not isDecimalConstant -> ilFieldDef.WithLiteralDefaultValue(Some(GenFieldInit m konst))
8574+
| _ -> ilFieldDef
85708575

85718576
let ilFieldDef =
85728577
let isClassInitializer = (cgbuf.MethodName = ".cctor")
@@ -8578,6 +8583,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt =
85788583
|| not isClassInitializer
85798584
|| hasLiteralAttr
85808585
)
8586+
|| isDecimalConstant
85818587
)
85828588

85838589
let ilAttribs =
@@ -8590,6 +8596,64 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt =
85908596

85918597
let ilAttribs = GenAdditionalAttributesForTy g vspec.Type @ ilAttribs
85928598

8599+
let ilAttribs =
8600+
if isDecimalConstant then
8601+
match vref.LiteralValue with
8602+
| Some(Const.Decimal d) ->
8603+
match System.Decimal.GetBits d with
8604+
| [| lo; med; hi; signExp |] ->
8605+
let scale = (min (((signExp &&& 0xFF0000) >>> 16) &&& 0xFF) 28) |> byte
8606+
let sign = if (signExp &&& 0x80000000) <> 0 then 1uy else 0uy
8607+
8608+
let attrib =
8609+
mkILCustomAttribute (
8610+
g.attrib_DecimalConstantAttribute.TypeRef,
8611+
[
8612+
g.ilg.typ_Byte
8613+
g.ilg.typ_Byte
8614+
g.ilg.typ_Int32
8615+
g.ilg.typ_Int32
8616+
g.ilg.typ_Int32
8617+
],
8618+
[
8619+
ILAttribElem.Byte scale
8620+
ILAttribElem.Byte sign
8621+
ILAttribElem.UInt32(uint32 hi)
8622+
ILAttribElem.UInt32(uint32 med)
8623+
ILAttribElem.UInt32(uint32 lo)
8624+
],
8625+
[]
8626+
)
8627+
8628+
let ilInstrs =
8629+
[
8630+
mkLdcInt32 lo
8631+
mkLdcInt32 med
8632+
mkLdcInt32 hi
8633+
mkLdcInt32 (int32 sign)
8634+
mkLdcInt32 (int32 scale)
8635+
mkNormalNewobj (
8636+
mkILCtorMethSpecForTy (
8637+
fspec.ActualType,
8638+
[
8639+
g.ilg.typ_Int32
8640+
g.ilg.typ_Int32
8641+
g.ilg.typ_Int32
8642+
g.ilg.typ_Bool
8643+
g.ilg.typ_Byte
8644+
]
8645+
)
8646+
)
8647+
mkNormalStsfld fspec
8648+
]
8649+
8650+
CG.EmitInstrs cgbuf (pop 0) (Push0) ilInstrs
8651+
[ attrib ]
8652+
| _ -> failwith "unreachable"
8653+
| _ -> failwith "unreachable"
8654+
else
8655+
ilAttribs
8656+
85938657
let ilFieldDef =
85948658
ilFieldDef.With(customAttrs = mkILCustomAttrs (ilAttribs @ [ g.DebuggerBrowsableNeverAttribute ]))
85958659

‎src/Compiler/TypedTree/TcGlobals.fs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1490,6 +1490,7 @@ type TcGlobals(
14901490
member val attrib_CallerFilePathAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute"
14911491
member val attrib_CallerMemberNameAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute"
14921492
member val attrib_SkipLocalsInitAttribute = findSysAttrib "System.Runtime.CompilerServices.SkipLocalsInitAttribute"
1493+
member val attrib_DecimalConstantAttribute = findSysAttrib "System.Runtime.CompilerServices.DecimalConstantAttribute"
14931494
member val attribs_Unsupported = v_attribs_Unsupported
14941495

14951496
member val attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute"

‎src/Compiler/TypedTree/TcGlobals.fsi‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -474,6 +474,8 @@ type internal TcGlobals =
474474

475475
member attrib_SkipLocalsInitAttribute: BuiltinAttribInfo
476476

477+
member attrib_DecimalConstantAttribute: BuiltinAttribInfo
478+
477479
member attrib_StructAttribute: BuiltinAttribInfo
478480

479481
member attrib_StructLayoutAttribute: BuiltinAttribInfo

‎src/Compiler/TypedTree/TypedTreeOps.fs‎

Lines changed: 14 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -10020,7 +10020,7 @@ let EvalArithUnOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt3
1002010020
| _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m))
1002110021
with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m))
1002210022

10023-
let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt32, opUInt64, opSingle, opDouble) (arg1: Expr) (arg2: Expr) =
10023+
let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt32, opUInt64, opSingle, opDouble, opDecimal) (arg1: Expr) (arg2: Expr) =
1002410024
// At compile-time we check arithmetic
1002510025
let m = unionRanges arg1.Range arg2.Range
1002610026
try
@@ -10035,6 +10035,7 @@ let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt
1003510035
| Expr.Const (Const.UInt64 x1, _, ty), Expr.Const (Const.UInt64 x2, _, _) -> Expr.Const (Const.UInt64 (opUInt64 x1 x2), m, ty)
1003610036
| Expr.Const (Const.Single x1, _, ty), Expr.Const (Const.Single x2, _, _) -> Expr.Const (Const.Single (opSingle x1 x2), m, ty)
1003710037
| Expr.Const (Const.Double x1, _, ty), Expr.Const (Const.Double x2, _, _) -> Expr.Const (Const.Double (opDouble x1 x2), m, ty)
10038+
| Expr.Const (Const.Decimal x1, _, ty), Expr.Const (Const.Decimal x2, _, _) -> Expr.Const (Const.Decimal (opDecimal x1 x2), m, ty)
1003810039
| _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m))
1003910040
with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m))
1004010041

@@ -10066,9 +10067,10 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) =
1006610067
| Const.Single _
1006710068
| Const.Char _
1006810069
| Const.Zero
10069-
| Const.String _ ->
10070+
| Const.String _
10071+
| Const.Decimal _ ->
1007010072
x
10071-
| Const.Decimal _ | Const.IntPtr _ | Const.UIntPtr _ | Const.Unit ->
10073+
| Const.IntPtr _ | Const.UIntPtr _ | Const.Unit ->
1007210074
errorR (Error ( FSComp.SR.tastNotAConstantExpression(), m))
1007310075
x
1007410076

@@ -10084,7 +10086,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) =
1008410086

1008510087
match v1 with
1008610088
| IntegerConstExpr ->
10087-
EvalArithBinOp ((|||), (|||), (|||), (|||), (|||), (|||), (|||), (|||), ignore2, ignore2) v1 (EvalAttribArgExpr suppressLangFeatureCheck g arg2)
10089+
EvalArithBinOp ((|||), (|||), (|||), (|||), (|||), (|||), (|||), (|||), ignore2, ignore2, ignore2) v1 (EvalAttribArgExpr suppressLangFeatureCheck g arg2)
1008810090
| _ ->
1008910091
errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range))
1009010092
x
@@ -10099,7 +10101,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) =
1009910101
Expr.Const (Const.Char (x1 + x2), m, ty)
1010010102
| _ ->
1010110103
checkFeature()
10102-
EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) v1 v2
10104+
EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) v1 v2
1010310105
| SpecificBinopExpr g g.unchecked_subtraction_vref (arg1, arg2) ->
1010410106
checkFeature()
1010510107
let v1, v2 = EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1, EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2
@@ -10108,16 +10110,16 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) =
1010810110
| Expr.Const (Const.Char x1, m, ty), Expr.Const (Const.Char x2, _, _) ->
1010910111
Expr.Const (Const.Char (x1 - x2), m, ty)
1011010112
| _ ->
10111-
EvalArithBinOp (Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-)) v1 v2
10113+
EvalArithBinOp (Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-)) v1 v2
1011210114
| SpecificBinopExpr g g.unchecked_multiply_vref (arg1, arg2) ->
1011310115
checkFeature()
10114-
EvalArithBinOp (Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
10116+
EvalArithBinOp (Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
1011510117
| SpecificBinopExpr g g.unchecked_division_vref (arg1, arg2) ->
1011610118
checkFeature()
10117-
EvalArithBinOp ((/), (/), (/), (/), (/), (/), (/), (/), (/), (/)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
10119+
EvalArithBinOp ((/), (/), (/), (/), (/), (/), (/), (/), (/), (/), (/)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
1011810120
| SpecificBinopExpr g g.unchecked_modulus_vref (arg1, arg2) ->
1011910121
checkFeature()
10120-
EvalArithBinOp ((%), (%), (%), (%), (%), (%), (%), (%), (%), (%)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
10122+
EvalArithBinOp ((%), (%), (%), (%), (%), (%), (%), (%), (%), (%), (%)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
1012110123
| SpecificBinopExpr g g.bitwise_shift_left_vref (arg1, arg2) ->
1012210124
checkFeature()
1012310125
EvalArithShiftOp ((<<<), (<<<), (<<<), (<<<), (<<<), (<<<), (<<<), (<<<)) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg1) (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
@@ -10130,7 +10132,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) =
1013010132

1013110133
match v1 with
1013210134
| IntegerConstExpr ->
10133-
EvalArithBinOp ((&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
10135+
EvalArithBinOp ((&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), ignore2, ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
1013410136
| _ ->
1013510137
errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range))
1013610138
x
@@ -10140,7 +10142,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) =
1014010142

1014110143
match v1 with
1014210144
| IntegerConstExpr ->
10143-
EvalArithBinOp ((^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
10145+
EvalArithBinOp ((^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), (^^^), ignore2, ignore2, ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
1014410146
| _ ->
1014510147
errorR (Error (FSComp.SR.tastNotAConstantExpression(), x.Range))
1014610148
x
@@ -10150,7 +10152,7 @@ let rec EvalAttribArgExpr suppressLangFeatureCheck (g: TcGlobals) (x: Expr) =
1015010152

1015110153
match v1 with
1015210154
| FloatConstExpr ->
10153-
EvalArithBinOp (ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ( ** ), ( ** )) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
10155+
EvalArithBinOp (ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ignore2, ( ** ), ( ** ), ignore2) v1 (EvalAttribArgExpr SuppressLanguageFeatureCheck.Yes g arg2)
1015410156
| _ ->
1015510157
errorR (Error (FSComp.SR.tastNotAConstantExpression(), x.Range))
1015610158
x

‎tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -144,13 +144,12 @@ module LetBindings_Basic =
144144
|> verifyCompile
145145
|> shouldFail
146146
|> withDiagnostics [
147-
(Error 267, Line 11, Col 18, Line 11, Col 19, "This is not a valid constant expression or custom attribute value")
148-
(Error 837, Line 11, Col 13, Line 11, Col 31, "This is not a valid constant expression")
149-
(Error 267, Line 14, Col 13, Line 14, Col 17, "This is not a valid constant expression or custom attribute value")
150-
(Error 267, Line 17, Col 13, Line 17, Col 15, "This is not a valid constant expression or custom attribute value")
151-
(Error 267, Line 20, Col 13, Line 20, Col 17, "This is not a valid constant expression or custom attribute value")
152-
(Error 267, Line 23, Col 13, Line 23, Col 18, "This is not a valid constant expression or custom attribute value")
153-
(Warning 3178, Line 26, Col 13, Line 26, Col 26, "This is not valid literal expression. The [<Literal>] attribute will be ignored.")
147+
(Error 267, Line 10, Col 18, Line 10, Col 19, "This is not a valid constant expression or custom attribute value")
148+
(Error 837, Line 10, Col 13, Line 10, Col 31, "This is not a valid constant expression")
149+
(Error 267, Line 16, Col 13, Line 16, Col 15, "This is not a valid constant expression or custom attribute value")
150+
(Error 267, Line 19, Col 13, Line 19, Col 17, "This is not a valid constant expression or custom attribute value")
151+
(Error 267, Line 22, Col 13, Line 22, Col 18, "This is not a valid constant expression or custom attribute value")
152+
(Warning 3178, Line 25, Col 13, Line 25, Col 26, "This is not valid literal expression. The [<Literal>] attribute will be ignored.")
154153
]
155154

156155
// SOURCE=E_Pathological01.fs SCFLAGS=--test:ErrorRanges # E_Pathological01.fs
@@ -303,4 +302,4 @@ type C() =
303302
|> withDiagnostics [
304303
(Warning 3582, Line 4, Col 5, Line 4, Col 12, "This is a function definition that shadows a union case. If this is what you want, ignore or suppress this warning. If you want it to be a union case deconstruction, add parentheses.")
305304
(Warning 3582, Line 5, Col 5, Line 5, Col 11, "This is a function definition that shadows a union case. If this is what you want, ignore or suppress this warning. If you want it to be a union case deconstruction, add parentheses.")
306-
]
305+
]

‎tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/E_Literals04.fs‎

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,10 @@
11
// #Regression #Conformance #DeclarationElements #LetBindings
2-
//<Expects status="error" span="(11,18)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
3-
//<Expects status="error" span="(11,13)" id="FS0837">This is not a valid constant expression$</Expects>
4-
//<Expects status="error" span="(14,13)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
5-
//<Expects status="error" span="(17,13)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
6-
//<Expects status="error" span="(20,13)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
7-
//<Expects status="error" span="(23,13)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
8-
//<Expects status="warning" span="(26,13)" id="FS3178">This is not valid literal expression. The \[<Literal>\] attribute will be ignored\.$</Expects>
2+
//<Expects status="error" span="(10,18)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
3+
//<Expects status="error" span="(10,13)" id="FS0837">This is not a valid constant expression$</Expects>
4+
//<Expects status="error" span="(16,13)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
5+
//<Expects status="error" span="(19,13)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
6+
//<Expects status="error" span="(22,13)" id="FS0267">This is not a valid constant expression or custom attribute value$</Expects>
7+
//<Expects status="warning" span="(25,13)" id="FS3178">This is not valid literal expression. The \[<Literal>\] attribute will be ignored\.$</Expects>
98

109
[<Literal>]
1110
let lit01 = (let x = "2" in x)

‎tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/Decimal.fs‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
2+
3+
namespace Conformance.PatternMatching
4+
5+
open Xunit
6+
open FSharp.Test
7+
open FSharp.Test.Compiler
8+
9+
module Decimal =
10+
11+
[<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"literal01.fs"|])>]
12+
let ``Decimal - literal01.fs - --test:ErrorRanges`` compilation =
13+
compilation
14+
|> asFsx
15+
|> withOptions ["--test:ErrorRanges";]
16+
|> compile
17+
|> shouldSucceed
18+
19+
[<Theory; Directory(__SOURCE_DIRECTORY__, Includes = [|"incompleteMatchesLiteral01.fs"|])>]
20+
let ``Decimal - incompleteMatchesLiteral01.fs - --test:ErrorRanges`` compilation =
21+
compilation
22+
|> asFs
23+
|> withOptions ["--test:ErrorRanges"]
24+
|> typecheck
25+
|> shouldFail
26+
|> withSingleDiagnostic (Warning 25, Line 7, Col 11, Line 7, Col 13, "Incomplete pattern matches on this expression. For example, the value '3M' may indicate a case not covered by the pattern(s).")

‎tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Decimal/incompleteMatchesLiteral01.fs‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
[<Literal>]
2+
let One = 1m
3+
[<Literal>]
4+
let Two = 2m
5+
6+
let test() =
7+
match 3m with
8+
| 0m -> false
9+
| One | Two -> false
10+
11+
exit 0

0 commit comments

Comments
 (0)