Skip to content

Commit eaa7b12

Browse files
keramskerams
committed
Add support for char and floating point arithmetic
1 parent b57974b commit eaa7b12

File tree

2 files changed

+94
-30
lines changed

2 files changed

+94
-30
lines changed

‎src/Compiler/TypedTree/TypedTreeOps.fs‎

Lines changed: 58 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -3742,12 +3742,26 @@ let (|SpecificUnopExpr|_|) g vrefReqd expr =
37423742
| UnopExpr g (vref, arg1) when valRefEq g vref vrefReqd -> Some arg1
37433743
| _ -> None
37443744

3745-
let (|SignedIntegerConstExpr|_|) expr =
3745+
let (|SignedConstExpr|_|) expr =
37463746
match expr with
37473747
| Expr.Const (Const.Int32 _, _, _)
37483748
| Expr.Const (Const.SByte _, _, _)
37493749
| Expr.Const (Const.Int16 _, _, _)
3750-
| Expr.Const (Const.Int64 _, _, _) -> Some ()
3750+
| Expr.Const (Const.Int64 _, _, _)
3751+
| Expr.Const (Const.Single _, _, _)
3752+
| Expr.Const (Const.Double _, _, _) -> Some ()
3753+
| _ -> None
3754+
3755+
let (|IntegerConstExpr|_|) expr =
3756+
match expr with
3757+
| Expr.Const (Const.Int32 _, _, _)
3758+
| Expr.Const (Const.SByte _, _, _)
3759+
| Expr.Const (Const.Int16 _, _, _)
3760+
| Expr.Const (Const.Int64 _, _, _)
3761+
| Expr.Const (Const.Byte _, _, _)
3762+
| Expr.Const (Const.UInt16 _, _, _)
3763+
| Expr.Const (Const.UInt32 _, _, _)
3764+
| Expr.Const (Const.UInt64 _, _, _) -> Some ()
37513765
| _ -> None
37523766

37533767
let (|SpecificBinopExpr|_|) g vrefReqd expr =
@@ -9672,7 +9686,7 @@ let EvalArithShiftOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUI
96729686
| _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m))
96739687
with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m))
96749688

9675-
let EvalArithUnOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt32, opUInt64) (arg1: Expr) =
9689+
let EvalArithUnOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt32, opUInt64, opSingle, opDouble) (arg1: Expr) =
96769690
// At compile-time we check arithmetic
96779691
let m = arg1.Range
96789692
try
@@ -9685,10 +9699,12 @@ let EvalArithUnOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt3
96859699
| Expr.Const (Const.UInt16 x1, _, ty) -> Expr.Const (Const.UInt16 (opUInt16 x1), m, ty)
96869700
| Expr.Const (Const.UInt32 x1, _, ty) -> Expr.Const (Const.UInt32 (opUInt32 x1), m, ty)
96879701
| Expr.Const (Const.UInt64 x1, _, ty) -> Expr.Const (Const.UInt64 (opUInt64 x1), m, ty)
9702+
| Expr.Const (Const.Single x1, _, ty) -> Expr.Const (Const.Single (opSingle x1), m, ty)
9703+
| Expr.Const (Const.Double x1, _, ty) -> Expr.Const (Const.Double (opDouble x1), m, ty)
96889704
| _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m))
96899705
with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m))
96909706

9691-
let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt32, opUInt64) (arg1: Expr) (arg2: Expr) =
9707+
let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt32, opUInt64, opSingle, opDouble) (arg1: Expr) (arg2: Expr) =
96929708
// At compile-time we check arithmetic
96939709
let m = unionRanges arg1.Range arg2.Range
96949710
try
@@ -9701,11 +9717,16 @@ let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt
97019717
| Expr.Const (Const.UInt16 x1, _, ty), Expr.Const (Const.UInt16 x2, _, _) -> Expr.Const (Const.UInt16 (opUInt16 x1 x2), m, ty)
97029718
| Expr.Const (Const.UInt32 x1, _, ty), Expr.Const (Const.UInt32 x2, _, _) -> Expr.Const (Const.UInt32 (opUInt32 x1 x2), m, ty)
97039719
| Expr.Const (Const.UInt64 x1, _, ty), Expr.Const (Const.UInt64 x2, _, _) -> Expr.Const (Const.UInt64 (opUInt64 x1 x2), m, ty)
9720+
| Expr.Const (Const.Single x1, _, ty), Expr.Const (Const.Single x2, _, _) -> Expr.Const (Const.Single (opSingle x1 x2), m, ty)
9721+
| Expr.Const (Const.Double x1, _, ty), Expr.Const (Const.Double x2, _, _) -> Expr.Const (Const.Double (opDouble x1 x2), m, ty)
97049722
| _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m))
97059723
with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m))
97069724

97079725
// See also PostTypeCheckSemanticChecks.CheckAttribArgExpr, which must match this precisely
97089726
let rec EvalAttribArgExpr g x =
9727+
let ignore (_x: 'a) = Unchecked.defaultof<'a>
9728+
let ignore2 (_x: 'a) (_y: 'a) = Unchecked.defaultof<'a>
9729+
97099730
match x with
97109731

97119732
// Detect standard constants
@@ -9739,40 +9760,61 @@ let rec EvalAttribArgExpr g x =
97399760
EvalAttribArgExpr g arg1
97409761
// Detect bitwise or of attribute flags
97419762
| AttribBitwiseOrExpr g (arg1, arg2) ->
9742-
EvalArithBinOp ((|||), (|||), (|||), (|||), (|||), (|||), (|||), (|||)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
9763+
let v1 = EvalAttribArgExpr g arg1
9764+
9765+
match v1 with
9766+
| IntegerConstExpr ->
9767+
EvalArithBinOp ((|||), (|||), (|||), (|||), (|||), (|||), (|||), (|||), ignore2, ignore2) v1 (EvalAttribArgExpr g arg2)
9768+
| _ ->
9769+
errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range))
9770+
x
97439771
| SpecificBinopExpr g g.unchecked_addition_vref (arg1, arg2) ->
97449772
// At compile-time we check arithmetic
97459773
let v1, v2 = EvalAttribArgExpr g arg1, EvalAttribArgExpr g arg2
97469774
match v1, v2 with
9747-
| Expr.Const (Const.String x1, m, ty), Expr.Const (Const.String x2, _, _) -> Expr.Const (Const.String (x1 + x2), m, ty)
9775+
| Expr.Const (Const.String x1, m, ty), Expr.Const (Const.String x2, _, _) ->
9776+
Expr.Const (Const.String (x1 + x2), m, ty)
9777+
| Expr.Const (Const.Char x1, m, ty), Expr.Const (Const.Char x2, _, _) ->
9778+
Expr.Const (Const.Char (x1 + x2), m, ty)
97489779
| _ ->
9749-
EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) v1 v2
9780+
EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) v1 v2
97509781
| SpecificBinopExpr g g.unchecked_subtraction_vref (arg1, arg2) ->
9751-
EvalArithBinOp (Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
9782+
let v1, v2 = EvalAttribArgExpr g arg1, EvalAttribArgExpr g arg2
9783+
match v1, v2 with
9784+
| Expr.Const (Const.Char x1, m, ty), Expr.Const (Const.Char x2, _, _) ->
9785+
Expr.Const (Const.Char (x1 - x2), m, ty)
9786+
| _ ->
9787+
EvalArithBinOp (Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-)) v1 v2
97529788
| SpecificBinopExpr g g.unchecked_multiply_vref (arg1, arg2) ->
9753-
EvalArithBinOp (Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
9789+
EvalArithBinOp (Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
97549790
| SpecificBinopExpr g g.unchecked_division_vref (arg1, arg2) ->
9755-
EvalArithBinOp ((/), (/), (/), (/), (/), (/), (/), (/)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
9791+
EvalArithBinOp ((/), (/), (/), (/), (/), (/), (/), (/), (/), (/)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
97569792
| SpecificBinopExpr g g.unchecked_modulus_vref (arg1, arg2) ->
9757-
EvalArithBinOp ((%), (%), (%), (%), (%), (%), (%), (%)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
9793+
EvalArithBinOp ((%), (%), (%), (%), (%), (%), (%), (%), (%), (%)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
97589794
| SpecificBinopExpr g g.bitwise_shift_left_vref (arg1, arg2) ->
97599795
EvalArithShiftOp ((<<<), (<<<), (<<<), (<<<), (<<<), (<<<), (<<<), (<<<)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
97609796
| SpecificBinopExpr g g.bitwise_shift_right_vref (arg1, arg2) ->
97619797
EvalArithShiftOp ((>>>), (>>>), (>>>), (>>>), (>>>), (>>>), (>>>), (>>>)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
97629798
| SpecificBinopExpr g g.bitwise_and_vref (arg1, arg2) ->
9763-
EvalArithBinOp ((&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2)
9799+
let v1 = EvalAttribArgExpr g arg1
9800+
9801+
match v1 with
9802+
| IntegerConstExpr ->
9803+
EvalArithBinOp ((&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), (&&&), ignore2, ignore2) v1 (EvalAttribArgExpr g arg2)
9804+
| _ ->
9805+
errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range))
9806+
x
97649807
| SpecificUnopExpr g g.unchecked_unary_minus_vref arg1 ->
97659808
let v1 = EvalAttribArgExpr g arg1
97669809

97679810
match v1 with
9768-
| SignedIntegerConstExpr ->
9769-
let ignore (_x: 'a) = Unchecked.defaultof<'a>
9770-
EvalArithUnOp (Checked.(~-), Checked.(~-), Checked.(~-), Checked.(~-), ignore, ignore, ignore, ignore) v1
9811+
| SignedConstExpr ->
9812+
EvalArithUnOp (Checked.(~-), Checked.(~-), Checked.(~-), Checked.(~-), ignore, ignore, ignore, ignore, Checked.(~-), Checked.(~-)) v1
97719813
| _ ->
97729814
errorR (Error ( FSComp.SR.tastNotAConstantExpression(), v1.Range))
97739815
x
97749816
| SpecificUnopExpr g g.unchecked_unary_plus_vref arg1 ->
9775-
EvalArithUnOp ((~+), (~+), (~+), (~+), (~+), (~+), (~+), (~+)) (EvalAttribArgExpr g arg1)
9817+
EvalArithUnOp ((~+), (~+), (~+), (~+), (~+), (~+), (~+), (~+), (~+), (~+)) (EvalAttribArgExpr g arg1)
97769818
| SpecificUnopExpr g g.unchecked_unary_not_vref arg1 ->
97779819
match EvalAttribArgExpr g arg1 with
97789820
| Expr.Const (Const.Bool value, m, ty) ->

‎tests/FSharp.Compiler.ComponentTests/EmittedIL/Literals.fs‎

Lines changed: 36 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -27,9 +27,9 @@ let main _ =
2727

2828

2929
[<Fact>]
30-
let ``Arithmetics in integer literals is evaluated at compile-time``() =
30+
let ``Arithmetic in integer literals is evaluated at compile time``() =
3131
FSharp """
32-
module LiteralArithmetics
32+
module LiteralArithmetic
3333
3434
let [<Literal>] bytesInMegabyte = 1024L * 1024L
3535
@@ -52,9 +52,31 @@ let [<Literal>] bitwise = 1us &&& (3us ||| 4us)
5252
]
5353

5454
[<Fact>]
55-
let ``Logical operations on booleans are evaluated at compile-time``() =
55+
let ``Arithmetic in char and floating point literals is evaluated at compile time``() =
5656
FSharp """
57-
module LiteralArithmetics
57+
module LiteralArithmetic
58+
59+
let [<Literal>] bytesInMegabyte = 1024. * 1024.
60+
61+
let [<Literal>] bytesInKilobyte = bytesInMegabyte / 1024.
62+
63+
let [<Literal>] secondsInDayPlusThree = 3f + (60f * 60f * 24f)
64+
65+
let [<Literal>] chars = 'a' + 'b' - 'a'
66+
"""
67+
|> compile
68+
|> shouldSucceed
69+
|> verifyIL [
70+
""".field public static literal float64 bytesInMegabyte = float64(1048576.)"""
71+
""".field public static literal float64 bytesInKilobyte = float64(1024.)"""
72+
""".field public static literal float32 secondsInDayPlusThree = float32(86403.)"""
73+
""".field public static literal char chars = char(0x0062)"""
74+
]
75+
76+
[<Fact>]
77+
let ``Logical operations on booleans are evaluated at compile time``() =
78+
FSharp """
79+
module LiteralArithmetic
5880
5981
let [<Literal>] flag = true
6082
@@ -83,9 +105,9 @@ let [<Literal>] complex3 = true || (flag && not flippedFlag)
83105
]
84106

85107
[<Fact>]
86-
let ``Arithmetics can be used for constructing enum literals``() =
108+
let ``Arithmetic can be used for constructing enum literals``() =
87109
FSharp """
88-
module LiteralArithmetics
110+
module LiteralArithmetic
89111
90112
type E =
91113
| A = 1
@@ -96,13 +118,13 @@ let [<Literal>] x = enum<E> (1 + 1)
96118
|> compile
97119
|> shouldSucceed
98120
|> verifyIL [
99-
""".field public static literal valuetype LiteralArithmetics/E x = int32(0x00000002)"""
121+
""".field public static literal valuetype LiteralArithmetic/E x = int32(0x00000002)"""
100122
]
101123

102124
[<Fact>]
103-
let ``Arithmetics can be used for constructing literals in attributes``() =
125+
let ``Arithmetic can be used for constructing literals in attributes``() =
104126
FSharp """
105-
module LiteralArithmetics
127+
module LiteralArithmetic
106128
107129
open System.Runtime.CompilerServices
108130
@@ -120,7 +142,7 @@ let x () =
120142
[<Fact>]
121143
let ``Compilation fails when addition in literal overflows``() =
122144
FSharp """
123-
module LiteralArithmetics
145+
module LiteralArithmetic
124146
125147
let [<Literal>] x = System.Int32.MaxValue + 1
126148
"""
@@ -136,9 +158,9 @@ let [<Literal>] x = System.Int32.MaxValue + 1
136158
}
137159

138160
[<Fact>]
139-
let ``Compilation fails when using decimal arithmetics in literal``() =
161+
let ``Compilation fails when using decimal arithmetic in literal``() =
140162
FSharp """
141-
module LiteralArithmetics
163+
module LiteralArithmetic
142164
143165
let [<Literal>] x = 1m + 1m
144166
"""
@@ -166,9 +188,9 @@ let [<Literal>] x = 1m + 1m
166188
]
167189

168190
[<Fact>]
169-
let ``Compilation fails when using arithmetics with a non-literal in literal``() =
191+
let ``Compilation fails when using arithmetic with a non-literal in literal``() =
170192
FSharp """
171-
module LiteralArithmetics
193+
module LiteralArithmetic
172194
173195
let [<Literal>] x = 1 + System.DateTime.Now.Hour
174196
"""

0 commit comments

Comments
 (0)