diff --git a/docs/release-notes/.FSharp.Core/9.0.300.md b/docs/release-notes/.FSharp.Core/9.0.300.md index 5e6903f3fa4..e9625cf8de2 100644 --- a/docs/release-notes/.FSharp.Core/9.0.300.md +++ b/docs/release-notes/.FSharp.Core/9.0.300.md @@ -2,6 +2,7 @@ ### Added * Added nullability annotations to `.Using` builder method for `async` and `task` builders ([PR #18292](https://github.com/dotnet/fsharp/pull/18292)) +* Add `Measure` static type and module which aids in the addition, removal, and conversion of units of measure for primitive types and common collections of primitive types. ([Language Suggestion #892](https://github.com/fsharp/fslang-suggestions/issues/892)) ([RFC FS-1148 #784](https://github.com/fsharp/fslang-design/pull/784)) ([PR #17581](https://github.com/dotnet/fsharp/pull/17518)) ### Changed diff --git a/src/FSharp.Core/FSharp.Core.fsproj b/src/FSharp.Core/FSharp.Core.fsproj index b0abd5048bd..bf8d21b2db6 100644 --- a/src/FSharp.Core/FSharp.Core.fsproj +++ b/src/FSharp.Core/FSharp.Core.fsproj @@ -276,6 +276,9 @@ Queries/Query.fs + + Units/Measure.fs + Units/SI.fs diff --git a/src/FSharp.Core/Measure.fs b/src/FSharp.Core/Measure.fs new file mode 100644 index 00000000000..149467eb6fc --- /dev/null +++ b/src/FSharp.Core/Measure.fs @@ -0,0 +1,113 @@ +namespace Microsoft.FSharp.Core + +open System.ComponentModel + +[] +type Measure = + static member inline Tag(value: byte) : byte<'Measure> = + LanguagePrimitives.ByteWithMeasure value + + static member inline Tag(value: sbyte) : sbyte<'Measure> = + LanguagePrimitives.SByteWithMeasure value + + static member inline Tag(value: int16) : int16<'Measure> = + LanguagePrimitives.Int16WithMeasure value + + static member inline Tag(value: uint16) : uint16<'Measure> = + LanguagePrimitives.UInt16WithMeasure value + + static member inline Tag(value: int) : int<'Measure> = + LanguagePrimitives.Int32WithMeasure value + + static member inline Tag(value: uint) : uint<'Measure> = + LanguagePrimitives.UInt32WithMeasure value + + static member inline Tag(value: int64) : int64<'Measure> = + LanguagePrimitives.Int64WithMeasure value + + static member inline Tag(value: uint64) : uint64<'Measure> = + LanguagePrimitives.UInt64WithMeasure value + + static member inline Tag(value: nativeint) : nativeint<'Measure> = + LanguagePrimitives.IntPtrWithMeasure value + + static member inline Tag(value: unativeint) : unativeint<'Measure> = + LanguagePrimitives.UIntPtrWithMeasure value + + static member inline Tag(value: float) : float<'Measure> = + LanguagePrimitives.FloatWithMeasure value + + static member inline Tag(value: float32) : float32<'Measure> = + LanguagePrimitives.Float32WithMeasure value + + static member inline Tag(value: decimal) : decimal<'Measure> = + LanguagePrimitives.DecimalWithMeasure value + + static member inline InvokeTag value : '``T<'Measure>`` = + let inline call_2 (_: ^a, b: ^b) = + ((^a or ^b): (static member Tag: _ -> _) b) + + call_2 (Unchecked.defaultof, value) + + static member inline Untag(value: byte<'Measure>) = + byte value + + static member inline Untag(value: sbyte<'Measure>) = + sbyte value + + static member inline Untag(value: int16<'Measure>) = + int16 value + + static member inline Untag(value: uint16<'Measure>) = + uint16 value + + static member inline Untag(value: int<'Measure>) = + int value + + static member inline Untag(value: uint<'Measure>) = + uint value + + static member inline Untag(value: int64<'Measure>) = + int64 value + + static member inline Untag(value: uint64<'Measure>) = + uint64 value + + static member inline Untag(value: nativeint<'Measure>) = + nativeint value + + static member inline Untag(value: unativeint<'Measure>) = + unativeint value + + static member inline Untag(value: float<'Measure>) = + float value + + static member inline Untag(value: float32<'Measure>) = + float32 value + + static member inline Untag(value: decimal<'Measure>) = + decimal value + + static member inline InvokeUntag value : 'T = + let inline call_2 (_: ^a, b: ^b) = + ((^a or ^b): (static member Untag: _ -> _) b) + + call_2 (Unchecked.defaultof, value) + +[] +module Measure = + /// Tags a value with a unit of measure. + let inline tag (value: 'T) : '``T<'Measure>`` = + Measure.InvokeTag value + + /// Removes a unit of measure from a value. + let inline untag (value: '``T<'Measure>``) : 'T = + Measure.InvokeUntag value + + /// Tags a value with a new unit of measure. + let inline retag (value: '``T<'Measure1>``) : '``T<'Measure2>`` = + tag (untag value: 'T) + + /// Maps a value with a unit of measure to another value with a unit of measure. + let inline map ([] mapping: 'T -> 'U) (value: '``T<'Measure1>``) : '``U<'Measure2>`` = + tag (mapping (untag value))