Skip to content

F
fsharp

dotNET Platform / fsharp
11 个月 前同步成功

通知 0
Star 1
Fork 0
F
fsharp

体验新版 GitCode，发现更多精彩内容 >>

未验证 提交 05b560d0 编写于 作者: D Don Syme 提交者： GitHub
1 浏览文件
操作

Format most of FSharp.Core (#13150) 

* modify fantomasignore

* fix setting

* no single line functions in FSHarp.Core

* update fantomas

* apply formatting
上级 778b04c0
展开全部 显示空白变更内容
内联 并排
Showing with 8619 addition and 5268 deletion
.fantomasignore
浏览文件 @ 05b560d0
......@@ -13,7 +13,6 @@ artifacts/
# Explicitly unformatted implementation files
src/FSharp.Core/**/*.fs
src/Compiler/Checking/**/*.fs
src/Compiler/CodeGen/**/*.fs
src/Compiler/DependencyManager/**/*.fs
......@@ -28,6 +27,23 @@ src/Compiler/SyntaxTree/**/*.fs
src/Compiler/TypedTree/**/*.fs
src/Microsoft.FSharp.Compiler/**/*.fs
# Fantomas limitations on implementation files in FSharp.Core (to investigate)
src/FSharp.Core/array2.fs
src/FSharp.Core/array3.fs
src/FSharp.Core/Linq.fs
src/FSharp.Core/local.fs
src/FSharp.Core/nativeptr.fs
src/FSharp.Core/prim-types-prelude.fs
src/FSharp.Core/prim-types.fs
src/FSharp.Core/printf.fs
src/FSharp.Core/Query.fs
src/FSharp.Core/seqcore.fs
# Fantomas limitation https://github.com/fsprojects/fantomas/issues/2264
src/FSharp.Core/SI.fs
# Fantomas limitations on implementation files (to investigate)
src/Compiler/AbstractIL/ilwrite.fs
......
src/FSharp.Core/.editorconfig 0 → 100644
浏览文件 @ 05b560d0
[*.fs]
fsharp_max_function_binding_width=1
src/FSharp.Core/MutableTuple.fs
浏览文件 @ 05b560d0
......@@ -25,152 +25,192 @@ open Microsoft.FSharp.Core
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type AnonymousObject<'T1> =
val private item1 : 'T1
val private item1: 'T1
member x.Item1 = x.item1
new (Item1) = { item1 = Item1 }
new(Item1) = { item1 = Item1 }
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type AnonymousObject<'T1, 'T2> =
val private item1 : 'T1
val private item1: 'T1
member x.Item1 = x.item1
val private item2 : 'T2
val private item2: 'T2
member x.Item2 = x.item2
new (Item1, Item2) = { item1 = Item1; item2 = Item2 }
new(Item1, Item2) = { item1 = Item1; item2 = Item2 }
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type AnonymousObject<'T1, 'T2, 'T3> =
val private item1 : 'T1
val private item1: 'T1
member x.Item1 = x.item1
val private item2 : 'T2
val private item2: 'T2
member x.Item2 = x.item2
val private item3 : 'T3
val private item3: 'T3
member x.Item3 = x.item3
new (Item1, Item2, Item3) = { item1 = Item1; item2 = Item2; item3 = Item3 }
new(Item1, Item2, Item3) =
{
item1 = Item1
item2 = Item2
item3 = Item3
}
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type AnonymousObject<'T1, 'T2, 'T3, 'T4> =
val private item1 : 'T1
val private item1: 'T1
member x.Item1 = x.item1
val private item2 : 'T2
val private item2: 'T2
member x.Item2 = x.item2
val private item3 : 'T3
val private item3: 'T3
member x.Item3 = x.item3
val private item4 : 'T4
val private item4: 'T4
member x.Item4 = x.item4
new (Item1, Item2, Item3, Item4) = { item1 = Item1; item2 = Item2; item3 = Item3; item4 = Item4 }
new(Item1, Item2, Item3, Item4) =
{
item1 = Item1
item2 = Item2
item3 = Item3
item4 = Item4
}
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type AnonymousObject<'T1, 'T2, 'T3, 'T4, 'T5> =
val private item1 : 'T1
val private item1: 'T1
member x.Item1 = x.item1
val private item2 : 'T2
val private item2: 'T2
member x.Item2 = x.item2
val private item3 : 'T3
val private item3: 'T3
member x.Item3 = x.item3
val private item4 : 'T4
val private item4: 'T4
member x.Item4 = x.item4
val private item5 : 'T5
val private item5: 'T5
member x.Item5 = x.item5
new (Item1, Item2, Item3, Item4, Item5) = { item1 = Item1; item2 = Item2; item3 = Item3; item4 = Item4 ; item5 = Item5 }
new(Item1, Item2, Item3, Item4, Item5) =
{
item1 = Item1
item2 = Item2
item3 = Item3
item4 = Item4
item5 = Item5
}
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type AnonymousObject<'T1, 'T2, 'T3, 'T4, 'T5, 'T6> =
val private item1 : 'T1
val private item1: 'T1
member x.Item1 = x.item1
val private item2 : 'T2
val private item2: 'T2
member x.Item2 = x.item2
val private item3 : 'T3
val private item3: 'T3
member x.Item3 = x.item3
val private item4 : 'T4
val private item4: 'T4
member x.Item4 = x.item4
val private item5 : 'T5
val private item5: 'T5
member x.Item5 = x.item5
val private item6 : 'T6
val private item6: 'T6
member x.Item6 = x.item6
new (Item1, Item2, Item3, Item4, Item5, Item6) = { item1 = Item1; item2 = Item2; item3 = Item3; item4 = Item4 ; item5 = Item5 ; item6 = Item6 }
new(Item1, Item2, Item3, Item4, Item5, Item6) =
{
item1 = Item1
item2 = Item2
item3 = Item3
item4 = Item4
item5 = Item5
item6 = Item6
}
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type AnonymousObject<'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'T7> =
val private item1 : 'T1
val private item1: 'T1
member x.Item1 = x.item1
val private item2 : 'T2
val private item2: 'T2
member x.Item2 = x.item2
val private item3 : 'T3
val private item3: 'T3
member x.Item3 = x.item3
val private item4 : 'T4
val private item4: 'T4
member x.Item4 = x.item4
val private item5 : 'T5
val private item5: 'T5
member x.Item5 = x.item5
val private item6 : 'T6
val private item6: 'T6
member x.Item6 = x.item6
val private item7 : 'T7
val private item7: 'T7
member x.Item7 = x.item7
new (Item1, Item2, Item3, Item4, Item5, Item6, Item7) = { item1 = Item1; item2 = Item2; item3 = Item3; item4 = Item4 ; item5 = Item5 ; item6 = Item6 ; item7 = Item7 }
new(Item1, Item2, Item3, Item4, Item5, Item6, Item7) =
{
item1 = Item1
item2 = Item2
item3 = Item3
item4 = Item4
item5 = Item5
item6 = Item6
item7 = Item7
}
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type AnonymousObject<'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'T7, 'T8> =
val private item1 : 'T1
val private item1: 'T1
member x.Item1 = x.item1
val private item2 : 'T2
val private item2: 'T2
member x.Item2 = x.item2
val private item3 : 'T3
val private item3: 'T3
member x.Item3 = x.item3
val private item4 : 'T4
val private item4: 'T4
member x.Item4 = x.item4
val private item5 : 'T5
val private item5: 'T5
member x.Item5 = x.item5
val private item6 : 'T6
val private item6: 'T6
member x.Item6 = x.item6
val private item7 : 'T7
val private item7: 'T7
member x.Item7 = x.item7
val private item8 : 'T8
val private item8: 'T8
member x.Item8 = x.item8
new (Item1, Item2, Item3, Item4, Item5, Item6, Item7, Item8) = { item1 = Item1; item2 = Item2; item3 = Item3; item4 = Item4 ; item5 = Item5 ; item6 = Item6 ; item7 = Item7; item8 = Item8 }
new(Item1, Item2, Item3, Item4, Item5, Item6, Item7, Item8) =
{
item1 = Item1
item2 = Item2
item3 = Item3
item4 = Item4
item5 = Item5
item6 = Item6
item7 = Item7
item8 = Item8
}
src/FSharp.Core/Nullable.fs
浏览文件 @ 05b560d0
......@@ -9,134 +9,297 @@ open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
module NullableOperators =
let (?>=) (x : Nullable<'T>) (y: 'T) = x.HasValue && x.Value >= y
let (?>=) (x: Nullable<'T>) (y: 'T) =
x.HasValue && x.Value >= y
let (?>) (x : Nullable<'T>) (y: 'T) = x.HasValue && x.Value > y
let (?>) (x: Nullable<'T>) (y: 'T) =
x.HasValue && x.Value > y
let (?<=) (x : Nullable<'T>) (y: 'T) = x.HasValue && x.Value <= y
let (?<=) (x: Nullable<'T>) (y: 'T) =
x.HasValue && x.Value <= y
let (?<) (x : Nullable<'T>) (y: 'T) = x.HasValue && x.Value < y
let (?<) (x: Nullable<'T>) (y: 'T) =
x.HasValue && x.Value < y
let (?=) (x: Nullable<'T>) (y: 'T) =
x.HasValue && x.Value = y
let (?=) (x : Nullable<'T>) (y: 'T) = x.HasValue && x.Value = y
let (?<>) (x : Nullable<'T>) (y: 'T) = not (x ?= y)
let (>=?) (x : 'T) (y: Nullable<'T>) = y.HasValue && x >= y.Value
let (>?) (x : 'T) (y: Nullable<'T>) = y.HasValue && x > y.Value
let (<=?) (x : 'T) (y: Nullable<'T>) = y.HasValue && x <= y.Value
let (<?) (x : 'T) (y: Nullable<'T>) = y.HasValue && x < y.Value
let (=?) (x : 'T) (y: Nullable<'T>) = y.HasValue && x = y.Value
let (<>?) (x : 'T) (y: Nullable<'T>) = not (x =? y)
let (?>=?) (x : Nullable<'T>) (y: Nullable<'T>) = (x.HasValue && y.HasValue && x.Value >= y.Value)
let (?>?) (x : Nullable<'T>) (y: Nullable<'T>) = (x.HasValue && y.HasValue && x.Value > y.Value)
let (?<=?) (x : Nullable<'T>) (y: Nullable<'T>) = (x.HasValue && y.HasValue && x.Value <= y.Value)
let (?<?) (x : Nullable<'T>) (y: Nullable<'T>) = (x.HasValue && y.HasValue && x.Value < y.Value)
let (?=?) (x : Nullable<'T>) (y: Nullable<'T>) = (not x.HasValue && not y.HasValue) || (x.HasValue && y.HasValue && x.Value = y.Value)
let (?<>?) (x : Nullable<'T>) (y: Nullable<'T>) = not (x ?=? y)
let inline (?+) (x : Nullable<_>) y = if x.HasValue then Nullable(x.Value + y) else Nullable()
let inline (+?) x (y: Nullable<_>) = if y.HasValue then Nullable(x + y.Value) else Nullable()
let inline (?+?) (x : Nullable<_>) (y: Nullable<_>) = if x.HasValue && y.HasValue then Nullable(x.Value + y.Value) else Nullable()
let inline (?-) (x : Nullable<_>) y = if x.HasValue then Nullable(x.Value - y) else Nullable()
let inline (-?) x (y: Nullable<_>) = if y.HasValue then Nullable(x - y.Value) else Nullable()
let inline (?-?) (x : Nullable<_>) (y: Nullable<_>) = if x.HasValue && y.HasValue then Nullable(x.Value - y.Value) else Nullable()
let inline ( ?* ) (x : Nullable<_>) y = if x.HasValue then Nullable(x.Value * y) else Nullable()
let inline ( *? ) x (y: Nullable<_>) = if y.HasValue then Nullable(x * y.Value) else Nullable()
let inline ( ?*? ) (x : Nullable<_>) (y: Nullable<_>) = if x.HasValue && y.HasValue then Nullable(x.Value * y.Value) else Nullable()
let inline ( ?% ) (x : Nullable<_>) y = if x.HasValue then Nullable(x.Value % y) else Nullable()
let inline ( %? ) x (y: Nullable<_>) = if y.HasValue then Nullable(x % y.Value) else Nullable()
let inline ( ?%? ) (x : Nullable<_>) (y: Nullable<_>) = if x.HasValue && y.HasValue then Nullable(x.Value % y.Value) else Nullable()
let inline ( ?/ ) (x : Nullable<_>) y = if x.HasValue then Nullable(x.Value / y) else Nullable()
let inline ( /? ) x (y: Nullable<_>) = if y.HasValue then Nullable(x / y.Value) else Nullable()
let inline ( ?/? ) (x : Nullable<_>) (y: Nullable<_>) = if x.HasValue && y.HasValue then Nullable(x.Value / y.Value) else Nullable()
let (?<>) (x: Nullable<'T>) (y: 'T) =
not (x ?= y)
let (>=?) (x: 'T) (y: Nullable<'T>) =
y.HasValue && x >= y.Value
let (>?) (x: 'T) (y: Nullable<'T>) =
y.HasValue && x > y.Value
let (<=?) (x: 'T) (y: Nullable<'T>) =
y.HasValue && x <= y.Value
let (<?) (x: 'T) (y: Nullable<'T>) =
y.HasValue && x < y.Value
let (=?) (x: 'T) (y: Nullable<'T>) =
y.HasValue && x = y.Value
let (<>?) (x: 'T) (y: Nullable<'T>) =
not (x =? y)
let (?>=?) (x: Nullable<'T>) (y: Nullable<'T>) =
(x.HasValue && y.HasValue && x.Value >= y.Value)
let (?>?) (x: Nullable<'T>) (y: Nullable<'T>) =
(x.HasValue && y.HasValue && x.Value > y.Value)
let (?<=?) (x: Nullable<'T>) (y: Nullable<'T>) =
(x.HasValue && y.HasValue && x.Value <= y.Value)
let (?<?) (x: Nullable<'T>) (y: Nullable<'T>) =
(x.HasValue && y.HasValue && x.Value < y.Value)
let (?=?) (x: Nullable<'T>) (y: Nullable<'T>) =
(not x.HasValue && not y.HasValue)
|| (x.HasValue && y.HasValue && x.Value = y.Value)
let (?<>?) (x: Nullable<'T>) (y: Nullable<'T>) =
not (x ?=? y)
let inline (?+) (x: Nullable<_>) y =
if x.HasValue then
Nullable(x.Value + y)
else
Nullable()
let inline (+?) x (y: Nullable<_>) =
if y.HasValue then
Nullable(x + y.Value)
else
Nullable()
let inline (?+?) (x: Nullable<_>) (y: Nullable<_>) =
if x.HasValue && y.HasValue then
Nullable(x.Value + y.Value)
else
Nullable()
let inline (?-) (x: Nullable<_>) y =
if x.HasValue then
Nullable(x.Value - y)
else
Nullable()
let inline (-?) x (y: Nullable<_>) =
if y.HasValue then
Nullable(x - y.Value)
else
Nullable()
let inline (?-?) (x: Nullable<_>) (y: Nullable<_>) =
if x.HasValue && y.HasValue then
Nullable(x.Value - y.Value)
else
Nullable()
let inline (?*) (x: Nullable<_>) y =
if x.HasValue then
Nullable(x.Value * y)
else
Nullable()
let inline ( *? ) x (y: Nullable<_>) =
if y.HasValue then
Nullable(x * y.Value)
else
Nullable()
let inline (?*?) (x: Nullable<_>) (y: Nullable<_>) =
if x.HasValue && y.HasValue then
Nullable(x.Value * y.Value)
else
Nullable()
let inline (?%) (x: Nullable<_>) y =
if x.HasValue then
Nullable(x.Value % y)
else
Nullable()
let inline (%?) x (y: Nullable<_>) =
if y.HasValue then
Nullable(x % y.Value)
else
Nullable()
let inline (?%?) (x: Nullable<_>) (y: Nullable<_>) =
if x.HasValue && y.HasValue then
Nullable(x.Value % y.Value)
else
Nullable()
let inline (?/) (x: Nullable<_>) y =
if x.HasValue then
Nullable(x.Value / y)
else
Nullable()
let inline (/?) x (y: Nullable<_>) =
if y.HasValue then
Nullable(x / y.Value)
else
Nullable()
let inline (?/?) (x: Nullable<_>) (y: Nullable<_>) =
if x.HasValue && y.HasValue then
Nullable(x.Value / y.Value)
else
Nullable()
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module Nullable =
[<CompiledName("ToUInt8")>]
let inline uint8 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.byte value.Value) else Nullable()
let inline uint8 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.byte value.Value)
else
Nullable()
[<CompiledName("ToInt8")>]
let inline int8 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.sbyte value.Value) else Nullable()
let inline int8 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.sbyte value.Value)
else
Nullable()
[<CompiledName("ToByte")>]
let inline byte (value:Nullable<_>) = if value.HasValue then Nullable(Operators.byte value.Value) else Nullable()
let inline byte (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.byte value.Value)
else
Nullable()
[<CompiledName("ToSByte")>]
let inline sbyte (value:Nullable<_>) = if value.HasValue then Nullable(Operators.sbyte value.Value) else Nullable()
let inline sbyte (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.sbyte value.Value)
else
Nullable()
[<CompiledName("ToInt16")>]
let inline int16 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.int16 value.Value) else Nullable()
let inline int16 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.int16 value.Value)
else
Nullable()
[<CompiledName("ToUInt16")>]
let inline uint16 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.uint16 value.Value) else Nullable()
let inline uint16 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.uint16 value.Value)
else
Nullable()
[<CompiledName("ToInt")>]
let inline int (value:Nullable<_>) = if value.HasValue then Nullable(Operators.int value.Value) else Nullable()
let inline int (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.int value.Value)
else
Nullable()
[<CompiledName("ToUInt")>]
let inline uint (value: Nullable<_>) = if value.HasValue then Nullable(Operators.uint value.Value) else Nullable()
let inline uint (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.uint value.Value)
else
Nullable()
[<CompiledName("ToEnum")>]
let inline enum (value:Nullable< int32 >) = if value.HasValue then Nullable(Operators.enum value.Value) else Nullable()
let inline enum (value: Nullable<int32>) =
if value.HasValue then
Nullable(Operators.enum value.Value)
else
Nullable()
[<CompiledName("ToInt32")>]
let inline int32 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.int32 value.Value) else Nullable()
let inline int32 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.int32 value.Value)
else
Nullable()
[<CompiledName("ToUInt32")>]
let inline uint32 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.uint32 value.Value) else Nullable()
let inline uint32 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.uint32 value.Value)
else
Nullable()
[<CompiledName("ToInt64")>]
let inline int64 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.int64 value.Value) else Nullable()
let inline int64 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.int64 value.Value)
else
Nullable()
[<CompiledName("ToUInt64")>]
let inline uint64 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.uint64 value.Value) else Nullable()
let inline uint64 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.uint64 value.Value)
else
Nullable()
[<CompiledName("ToFloat32")>]
let inline float32 (value:Nullable<_>) = if value.HasValue then Nullable(Operators.float32 value.Value) else Nullable()
let inline float32 (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.float32 value.Value)
else
Nullable()
[<CompiledName("ToFloat")>]
let inline float (value:Nullable<_>) = if value.HasValue then Nullable(Operators.float value.Value) else Nullable()
let inline float (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.float value.Value)
else
Nullable()
[<CompiledName("ToSingle")>]
let inline single (value:Nullable<_>) = if value.HasValue then Nullable(Operators.float32 value.Value) else Nullable()
let inline single (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.float32 value.Value)
else
Nullable()
[<CompiledName("ToDouble")>]
let inline double (value:Nullable<_>) = if value.HasValue then Nullable(Operators.float value.Value) else Nullable()
let inline double (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.float value.Value)
else
Nullable()
[<CompiledName("ToIntPtr")>]
let inline nativeint (value:Nullable<_>) = if value.HasValue then Nullable(Operators.nativeint value.Value) else Nullable()
let inline nativeint (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.nativeint value.Value)
else
Nullable()
[<CompiledName("ToUIntPtr")>]
let inline unativeint (value:Nullable<_>) = if value.HasValue then Nullable(Operators.unativeint value.Value) else Nullable()
let inline unativeint (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.unativeint value.Value)
else
Nullable()
[<CompiledName("ToDecimal")>]
let inline decimal (value:Nullable<_>) = if value.HasValue then Nullable(Operators.decimal value.Value) else Nullable()
let inline decimal (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.decimal value.Value)
else
Nullable()
[<CompiledName("ToChar")>]
let inline char (value:Nullable<_>) = if value.HasValue then Nullable(Operators.char value.Value) else Nullable()
let inline char (value: Nullable<_>) =
if value.HasValue then
Nullable(Operators.char value.Value)
else
Nullable()
src/FSharp.Core/QueryExtensions.fs
浏览文件 @ 05b560d0
......@@ -19,26 +19,30 @@ open System.Linq.Expressions
/// A type used to reconstruct a grouping after applying a mutable->immutable mapping transformation
/// on a result of a query.
type Grouping<'K, 'T>(key:'K, values:seq<'T>) =
type Grouping<'K, 'T>(key: 'K, values: seq<'T>) =
interface System.Linq.IGrouping<'K, 'T> with
member _.Key = key
interface System.Collections.IEnumerable with
member _.GetEnumerator() = values.GetEnumerator() :> System.Collections.IEnumerator
member _.GetEnumerator() =
values.GetEnumerator() :> System.Collections.IEnumerator
interface System.Collections.Generic.IEnumerable<'T> with
member _.GetEnumerator() = values.GetEnumerator()
member _.GetEnumerator() =
values.GetEnumerator()
module internal Adapters =
let memoize f =
let d = new System.Collections.Concurrent.ConcurrentDictionary<Type,'b>(HashIdentity.Structural)
fun x -> d.GetOrAdd(x, fun r -> f r)
let d =
new System.Collections.Concurrent.ConcurrentDictionary<Type, 'b>(HashIdentity.Structural)
let isPartiallyImmutableRecord : Type -> bool =
fun x -> d.GetOrAdd(x, (fun r -> f r))
let isPartiallyImmutableRecord: Type -> bool =
memoize (fun t ->
FSharpType.IsRecord t &&
not (FSharpType.GetRecordFields t |> Array.forall (fun f -> f.CanWrite)) )
FSharpType.IsRecord t
&& not (FSharpType.GetRecordFields t |> Array.forall (fun f -> f.CanWrite)))
let MemberInitializationHelperMeth =
methodhandleof (fun x -> LeafExpressionConverter.MemberInitializationHelper x)
......@@ -57,121 +61,148 @@ module internal Adapters =
let (|LeftSequentialSeries|) e =
let rec leftSequentialSeries acc e =
match e with
| Patterns.Sequential(e1, e2) -> leftSequentialSeries (e2 :: acc) e1
| Patterns.Sequential (e1, e2) -> leftSequentialSeries (e2 :: acc) e1
| _ -> e :: acc
leftSequentialSeries [] e
/// Tests whether a list consists only of assignments of properties of the
/// given variable, null values (ignored) and ends by returning the given variable
/// (pattern returns only property assignments)
let (|PropSetList|_|) varArg (list:Expr list) =
let (|PropSetList|_|) varArg (list: Expr list) =
let rec propSetList acc x =
match x with
// detect " v.X <- y"
| ((Patterns.PropertySet(Some(Patterns.Var var), _, _, _)) as p) :: xs when var = varArg ->
propSetList (p :: acc) xs
| ((Patterns.PropertySet (Some (Patterns.Var var), _, _, _)) as p) :: xs when var = varArg -> propSetList (p :: acc) xs
// skip unit values
| (Patterns.Value (v, _)) :: xs when v = null -> propSetList acc xs
// detect "v"
| [Patterns.Var var] when var = varArg -> Some acc
| [ Patterns.Var var ] when var = varArg -> Some acc
| _ -> None
propSetList [] list
/// Recognize object construction written using 'new O(Prop1 = <e>, Prop2 = <e>, ...)'
let (|ObjectConstruction|_|) e =
match e with
| Patterns.Let ( var, (Patterns.NewObject(_, []) as init), LeftSequentialSeries propSets ) ->
| Patterns.Let (var, (Patterns.NewObject (_, []) as init), LeftSequentialSeries propSets) ->
match propSets with
| PropSetList var propSets -> Some(var, init, propSets)
| _ -> None
| _ -> None
// Get arrays of types & map of transformations
let tupleTypes =
[| typedefof<System.Tuple<_>>, typedefof<AnonymousObject<_>>
[|
typedefof<System.Tuple<_>>, typedefof<AnonymousObject<_>>
typedefof<_ * _>, typedefof<AnonymousObject<_, _>>
typedefof<_ * _ * _>, typedefof<AnonymousObject<_, _, _>>
typedefof<_ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _>>
typedefof<_ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _>>
typedefof<_ * _ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _, _>>
typedefof<_ * _ * _ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _, _, _>>
typedefof<_ * _ * _ * _ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _, _, _, _>> |]
typedefof<_ * _ * _ * _ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _, _, _, _>>
|]
let anonObjectTypes = tupleTypes |> Array.map snd
let tupleToAnonTypeMap =
let t = new Dictionary<Type,Type>()
for (k,v) in tupleTypes do t.[k] <- v
let t = new Dictionary<Type, Type>()
for (k, v) in tupleTypes do
t.[k] <- v
t
let anonToTupleTypeMap =
let t = new Dictionary<Type,Type>()
for (k,v) in tupleTypes do t.[v] <- k
t
let t = new Dictionary<Type, Type>()
for (k, v) in tupleTypes do
t.[v] <- k
t
/// Recognize anonymous type construction written using 'new AnonymousObject(<e1>, <e2>, ...)'
let (|NewAnonymousObject|_|) e =
match e with
| Patterns.NewObject(ctor,args) when
| Patterns.NewObject (ctor, args) when
let dty = ctor.DeclaringType
dty.IsGenericType && anonToTupleTypeMap.ContainsKey (dty.GetGenericTypeDefinition()) ->
Some (ctor, args)
dty.IsGenericType
&& anonToTupleTypeMap.ContainsKey(dty.GetGenericTypeDefinition())
->
Some(ctor, args)
| _ -> None
let OneNewAnonymousObject (args:Expr list) =
let OneNewAnonymousObject (args: Expr list) =
// Will fit into a single tuple type
let typ = anonObjectTypes.[args.Length - 1]
let typ = typ.MakeGenericType [| for a in args -> a.Type |]
let ctor = typ.GetConstructors().[0]
let res = Expr.NewObject (ctor, args)
assert (match res with NewAnonymousObject _ -> true | _ -> false)
let res = Expr.NewObject(ctor, args)
assert
(match res with
| NewAnonymousObject _ -> true
| _ -> false)
res
let rec NewAnonymousObject (args:Expr list) : Expr =
let rec NewAnonymousObject (args: Expr list) : Expr =
match args with
| x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: tail ->
// Too long to fit single tuple - nested tuple after first 7
OneNewAnonymousObject [ x1; x2; x3; x4; x5; x6; x7; NewAnonymousObject (x8 :: tail) ]
| args ->
OneNewAnonymousObject args
OneNewAnonymousObject [ x1; x2; x3; x4; x5; x6; x7; NewAnonymousObject(x8 :: tail) ]
| args -> OneNewAnonymousObject args
let AnonymousObjectGet (e:Expr,i:int) =
let AnonymousObjectGet (e: Expr, i: int) =
// Recursively generate tuple get
// (may be nested e.g. TupleGet(<e>, 9) ~> <e>.Item8.Item3)
let rec walk i (inst:Expr) (newType:Type) =
let rec walk i (inst: Expr) (newType: Type) =
// Get property (at most the last one)
let propInfo = newType.GetProperty ("Item" + string (1 + min i 7))
let res = Expr.PropertyGet (inst, propInfo)
let propInfo = newType.GetProperty("Item" + string (1 + min i 7))
let res = Expr.PropertyGet(inst, propInfo)
// Do we need to add another property get for the last property?
if i < 7 then res
else walk (i - 7) res (newType.GetGenericArguments().[7])
if i < 7 then
res
else
walk (i - 7) res (newType.GetGenericArguments().[7])
walk i e e.Type
let RewriteTupleType (ty:Type) conv =
let RewriteTupleType (ty: Type) conv =
// Tuples are generic, so lookup only for generic types
assert ty.IsGenericType
let generic = ty.GetGenericTypeDefinition()
match tupleToAnonTypeMap.TryGetValue generic with
| true, mutableTupleType ->
// Recursively transform type arguments
mutableTupleType.MakeGenericType (ty.GetGenericArguments() |> Array.toList |> conv |> Array.ofList)
mutableTupleType.MakeGenericType(ty.GetGenericArguments() |> Array.toList |> conv |> Array.ofList)
| _ ->
assert false
failwith "unreachable"
let (|RecordFieldGetSimplification|_|) (expr:Expr) =
let (|RecordFieldGetSimplification|_|) (expr: Expr) =
match expr with
| Patterns.PropertyGet(Some (Patterns.NewRecord(typ,els)),propInfo,[]) ->
let fields = Microsoft.FSharp.Reflection.FSharpType.GetRecordFields(typ,System.Reflection.BindingFlags.Public|||System.Reflection.BindingFlags.NonPublic)
| Patterns.PropertyGet (Some (Patterns.NewRecord (typ, els)), propInfo, []) ->
let fields =
Microsoft.FSharp.Reflection.FSharpType.GetRecordFields(
typ,
System.Reflection.BindingFlags.Public
||| System.Reflection.BindingFlags.NonPublic
)
match fields |> Array.tryFindIndex (fun p -> p = propInfo) with
| None -> None
| Some i -> if i < els.Length then Some els.[i] else None
| Some i ->
if i < els.Length then
Some els.[i]
else
None
| _ -> None
/// The generic MethodInfo for Select function
/// Describes how we got from productions of immutable objects to productions of anonymous objects, with enough information
/// that we can invert the process in final query results.
......@@ -179,7 +210,7 @@ module internal Adapters =
type ConversionDescription =
| TupleConv of ConversionDescription list
| RecordConv of Type * ConversionDescription list
| GroupingConv of (* origKeyType: *) Type * (* origElemType: *) Type * ConversionDescription
| GroupingConv (* origKeyType: *) of Type (* origElemType: *) * Type * ConversionDescription
| SeqConv of ConversionDescription
| NoConv
......@@ -189,16 +220,16 @@ module internal Adapters =
match conv with
| TupleConv convs ->
assert (FSharpType.IsTuple ty)
match convs with
| x1 :: x2 :: x3 :: x4 :: x5 :: x6 :: x7 :: x8 :: tail ->
RewriteTupleType ty (List.map2 ConvImmutableTypeToMutableType [x1;x2;x3;x4;x5;x6;x7;TupleConv (x8 :: tail)])
| _ ->
RewriteTupleType ty (List.map2 ConvImmutableTypeToMutableType convs)
| RecordConv (_,convs) ->
RewriteTupleType ty (List.map2 ConvImmutableTypeToMutableType [ x1; x2; x3; x4; x5; x6; x7; TupleConv(x8 :: tail) ])
| _ -> RewriteTupleType ty (List.map2 ConvImmutableTypeToMutableType convs)
| RecordConv (_, convs) ->
assert (isPartiallyImmutableRecord ty)
let types = [| for f in FSharpType.GetRecordFields ty -> f.PropertyType |]
ConvImmutableTypeToMutableType (TupleConv convs) (FSharpType.MakeTupleType types)
| GroupingConv (_keyTy,_elemTy,conv) ->
| GroupingConv (_keyTy, _elemTy, conv) ->
assert ty.IsGenericType
assert (ty.GetGenericTypeDefinition() = typedefof<System.Linq.IGrouping<_, _>>)
let keyt1 = ty.GetGenericArguments().[0]
......@@ -207,58 +238,79 @@ module internal Adapters =
| SeqConv conv ->
assert ty.IsGenericType
let isIQ = ty.GetGenericTypeDefinition() = typedefof<IQueryable<_>>
assert (ty.GetGenericTypeDefinition() = typedefof<seq<_>> || ty.GetGenericTypeDefinition() = typedefof<IQueryable<_>>)
assert
(ty.GetGenericTypeDefinition() = typedefof<seq<_>>
|| ty.GetGenericTypeDefinition() = typedefof<IQueryable<_>>)
let elemt1 = ty.GetGenericArguments().[0]
let args = [| ConvImmutableTypeToMutableType conv elemt1 |]
if isIQ then typedefof<IQueryable<_>>.MakeGenericType args else typedefof<seq<_>>.MakeGenericType args
if isIQ then
typedefof<IQueryable<_>>.MakeGenericType args
else
typedefof<seq<_>>.MakeGenericType args
| NoConv -> ty
let IsNewAnonymousObjectHelperQ =
let mhandle = (methodhandleof (fun x -> LeafExpressionConverter.NewAnonymousObjectHelper x))
let minfo = (System.Reflection.MethodInfo.GetMethodFromHandle mhandle) :?> System.Reflection.MethodInfo
let mhandle =
(methodhandleof (fun x -> LeafExpressionConverter.NewAnonymousObjectHelper x))
let minfo =
(System.Reflection.MethodInfo.GetMethodFromHandle mhandle) :?> System.Reflection.MethodInfo
let gmd = minfo.GetGenericMethodDefinition()
(fun tm ->
match tm with
| Patterns.Call(_obj,minfo2,_args) -> minfo2.IsGenericMethod && (gmd = minfo2.GetGenericMethodDefinition())
| Patterns.Call (_obj, minfo2, _args) -> minfo2.IsGenericMethod && (gmd = minfo2.GetGenericMethodDefinition())
| _ -> false)
/// Cleanup the use of property-set object constructions in leaf expressions that form parts of F# queries.
let rec CleanupLeaf expr =
if IsNewAnonymousObjectHelperQ expr then expr else // this has already been cleaned up, don't do it twice
if IsNewAnonymousObjectHelperQ expr then
expr
else // this has already been cleaned up, don't do it twice
// rewrite bottom-up
let expr =
match expr with
| ExprShape.ShapeCombination(comb,args) -> match args with [] -> expr | _ -> ExprShape.RebuildShapeCombination(comb,List.map CleanupLeaf args)
| ExprShape.ShapeLambda(v,body) -> Expr.Lambda (v, CleanupLeaf body)
| ExprShape.ShapeCombination (comb, args) ->
match args with
| [] -> expr
| _ -> ExprShape.RebuildShapeCombination(comb, List.map CleanupLeaf args)
| ExprShape.ShapeLambda (v, body) -> Expr.Lambda(v, CleanupLeaf body)
| ExprShape.ShapeVar _ -> expr
match expr with
// Detect all object construction expressions - wrap them in 'MemberInitializationHelper'
// so that it can be translated to Expression.MemberInit
| ObjectConstruction(var, init, propSets) ->
| ObjectConstruction (var, init, propSets) ->
// Wrap object initialization into a value (
let methInfo = MemberInitializationHelperMeth.MakeGenericMethod [| var.Type |]
Expr.Call (methInfo, [ List.reduceBack (fun a b -> Expr.Sequential (a,b)) (propSets @ [init]) ])
Expr.Call(methInfo, [ List.reduceBack (fun a b -> Expr.Sequential(a, b)) (propSets @ [ init ]) ])
// Detect all anonymous type constructions - wrap them in 'NewAnonymousObjectHelper'
// so that it can be translated to Expression.New with member arguments.
| NewAnonymousObject(ctor, args) ->
let methInfo = NewAnonymousObjectHelperMeth.MakeGenericMethod [| ctor.DeclaringType |]
Expr.Call (methInfo, [ Expr.NewObject (ctor,args) ])
| expr ->
expr
| NewAnonymousObject (ctor, args) ->
let methInfo =
NewAnonymousObjectHelperMeth.MakeGenericMethod [| ctor.DeclaringType |]
Expr.Call(methInfo, [ Expr.NewObject(ctor, args) ])
| expr -> expr
/// Simplify gets of tuples and gets of record fields.
let rec SimplifyConsumingExpr e =
// rewrite bottom-up
let e =
match e with
| ExprShape.ShapeCombination(comb,args) -> ExprShape.RebuildShapeCombination(comb,List.map SimplifyConsumingExpr args)
| ExprShape.ShapeLambda(v,body) -> Expr.Lambda (v, SimplifyConsumingExpr body)
| ExprShape.ShapeCombination (comb, args) -> ExprShape.RebuildShapeCombination(comb, List.map SimplifyConsumingExpr args)
| ExprShape.ShapeLambda (v, body) -> Expr.Lambda(v, SimplifyConsumingExpr body)
| ExprShape.ShapeVar _ -> e
match e with
| Patterns.TupleGet(Patterns.NewTuple els,i) -> els.[i]
| Patterns.TupleGet (Patterns.NewTuple els, i) -> els.[i]
| RecordFieldGetSimplification newExpr -> newExpr
| _ -> e
......@@ -270,15 +322,21 @@ module internal Adapters =
match expr with
// Replace immutable tuples by anonymous objects
| Patterns.NewTuple exprs ->
let argExprsNow, argScripts = exprs |> List.map (ProduceMoreMutables tipf) |> List.unzip
let argExprsNow, argScripts =
exprs |> List.map (ProduceMoreMutables tipf) |> List.unzip
NewAnonymousObject argExprsNow, TupleConv argScripts
// Replace immutable records by anonymous objects
| Patterns.NewRecord(typ, args) when isPartiallyImmutableRecord typ ->
let argExprsNow, argScripts = args |> List.map (ProduceMoreMutables tipf) |> List.unzip
| Patterns.NewRecord (typ, args) when isPartiallyImmutableRecord typ ->
let argExprsNow, argScripts =
args |> List.map (ProduceMoreMutables tipf) |> List.unzip
NewAnonymousObject argExprsNow, RecordConv(typ, argScripts)
| expr ->
tipf expr
| expr -> tipf expr
let MakeSeqConv conv = match conv with NoConv -> NoConv | _ -> SeqConv conv
let MakeSeqConv conv =
match conv with
| NoConv -> NoConv
| _ -> SeqConv conv
src/FSharp.Core/array.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/async.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/collections.fs
浏览文件 @ 05b560d0
......@@ -10,39 +10,56 @@ open System.Collections.Generic
module HashIdentity =
let inline Structural<'T when 'T : equality> : IEqualityComparer<'T> =
let inline Structural<'T when 'T: equality> : IEqualityComparer<'T> =
LanguagePrimitives.FastGenericEqualityComparer<'T>
let inline LimitedStructural<'T when 'T : equality>(limit) : IEqualityComparer<'T> =
let inline LimitedStructural<'T when 'T: equality> (limit) : IEqualityComparer<'T> =
LanguagePrimitives.FastLimitedGenericEqualityComparer<'T>(limit)
let Reference<'T when 'T : not struct > : IEqualityComparer<'T> =
let Reference<'T when 'T: not struct> : IEqualityComparer<'T> =
{ new IEqualityComparer<'T> with
member _.GetHashCode(x) = LanguagePrimitives.PhysicalHash(x)
member _.Equals(x,y) = LanguagePrimitives.PhysicalEquality x y }
member _.GetHashCode(x) =
LanguagePrimitives.PhysicalHash(x)
let inline NonStructural< 'T when 'T : equality and 'T : (static member ( = ) : 'T * 'T -> bool) > =
member _.Equals(x, y) =
LanguagePrimitives.PhysicalEquality x y
}
let inline NonStructural<'T when 'T: equality and 'T: (static member (=): 'T * 'T -> bool)> =
{ new IEqualityComparer<'T> with
member _.GetHashCode(x) = NonStructuralComparison.hash x
member _.Equals(x, y) = NonStructuralComparison.(=) x y }
member _.GetHashCode(x) =
NonStructuralComparison.hash x
member _.Equals(x, y) =
NonStructuralComparison.(=) x y
}
let inline FromFunctions hasher equality : IEqualityComparer<'T> =
let eq = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(equality)
let eq = OptimizedClosures.FSharpFunc<_, _, _>.Adapt (equality)
{ new IEqualityComparer<'T> with
member _.GetHashCode(x) = hasher x
member _.Equals(x,y) = eq.Invoke(x,y) }
member _.GetHashCode(x) =
hasher x
member _.Equals(x, y) =
eq.Invoke(x, y)
}
module ComparisonIdentity =
let inline Structural<'T when 'T : comparison > : IComparer<'T> =
let inline Structural<'T when 'T: comparison> : IComparer<'T> =
LanguagePrimitives.FastGenericComparer<'T>
let inline NonStructural< 'T when 'T : (static member ( < ) : 'T * 'T -> bool) and 'T : (static member ( > ) : 'T * 'T -> bool) > : IComparer<'T> =
let inline NonStructural<'T when 'T: (static member (<): 'T * 'T -> bool) and 'T: (static member (>): 'T * 'T -> bool)> : IComparer<'T> =
{ new IComparer<'T> with
member _.Compare(x,y) = NonStructuralComparison.compare x y }
member _.Compare(x, y) =
NonStructuralComparison.compare x y
}
let FromFunction comparer =
let comparer = OptimizedClosures.FSharpFunc<'T,'T,int>.Adapt(comparer)
{ new IComparer<'T> with
member _.Compare(x,y) = comparer.Invoke(x,y) }
let comparer = OptimizedClosures.FSharpFunc<'T, 'T, int>.Adapt (comparer)
{ new IComparer<'T> with
member _.Compare(x, y) =
comparer.Invoke(x, y)
}
src/FSharp.Core/event.fs
浏览文件 @ 05b560d0
......@@ -17,63 +17,80 @@ module private Atomic =
let inline setWith (thunk: 'a -> 'a) (value: byref<'a>) =
let mutable exchanged = false
let mutable oldValue = value
while not exchanged do
let comparand = oldValue
let newValue = thunk comparand
oldValue <- Interlocked.CompareExchange(&value, newValue, comparand)
if obj.ReferenceEquals(comparand, oldValue) then
exchanged <- true
[<CompiledName("FSharpDelegateEvent`1")>]
type DelegateEvent<'Delegate when 'Delegate :> System.Delegate>() =
let mutable multicast : System.Delegate = null
member x.Trigger(args:obj[]) =
let mutable multicast: System.Delegate = null
member x.Trigger(args: obj[]) =
match multicast with
| null -> ()
| d -> d.DynamicInvoke(args) |> ignore
member x.Publish =
{ new IDelegateEvent<'Delegate> with
member x.AddHandler(d) =
Atomic.setWith (fun value -> System.Delegate.Combine(value, d)) &multicast
member x.RemoveHandler(d) =
Atomic.setWith (fun value -> System.Delegate.Remove(value, d)) &multicast }
Atomic.setWith (fun value -> System.Delegate.Remove(value, d)) &multicast
}
type EventDelegee<'Args>(observer: System.IObserver<'Args>) =
static let makeTuple =
if Microsoft.FSharp.Reflection.FSharpType.IsTuple(typeof<'Args>) then
Microsoft.FSharp.Reflection.FSharpValue.PreComputeTupleConstructor(typeof<'Args>)
else
fun _ -> assert false; null // should not be called, one-argument case don't use makeTuple function
fun _ ->
assert false
null // should not be called, one-argument case don't use makeTuple function
member x.Invoke(_sender:obj, args: 'Args) =
observer.OnNext args
member x.Invoke(_sender:obj, a, b) =
let args = makeTuple([|a; b|]) :?> 'Args
member x.Invoke(_sender: obj, args: 'Args) =
observer.OnNext args
member x.Invoke(_sender:obj, a, b, c) =
let args = makeTuple([|a; b; c|]) :?> 'Args
member x.Invoke(_sender: obj, a, b) =
let args = makeTuple ([| a; b |]) :?> 'Args
observer.OnNext args
member x.Invoke(_sender:obj, a, b, c, d) =
let args = makeTuple([|a; b; c; d|]) :?> 'Args
member x.Invoke(_sender: obj, a, b, c) =
let args = makeTuple ([| a; b; c |]) :?> 'Args
observer.OnNext args
member x.Invoke(_sender:obj, a, b, c, d, e) =
let args = makeTuple([|a; b; c; d; e|]) :?> 'Args
member x.Invoke(_sender: obj, a, b, c, d) =
let args = makeTuple ([| a; b; c; d |]) :?> 'Args
observer.OnNext args
member x.Invoke(_sender:obj, a, b, c, d, e, f) =
let args = makeTuple([|a; b; c; d; e; f|]) :?> 'Args
member x.Invoke(_sender: obj, a, b, c, d, e) =
let args = makeTuple ([| a; b; c; d; e |]) :?> 'Args
observer.OnNext args
member x.Invoke(_sender: obj, a, b, c, d, e, f) =
let args = makeTuple ([| a; b; c; d; e; f |]) :?> 'Args
observer.OnNext args
type EventWrapper<'Delegate,'Args> = delegate of 'Delegate * obj * 'Args -> unit
type EventWrapper<'Delegate, 'Args> = delegate of 'Delegate * obj * 'Args -> unit
[<CompiledName("FSharpEvent`2")>]
type Event<'Delegate, 'Args when 'Delegate : delegate<'Args, unit> and 'Delegate :> System.Delegate and 'Delegate: not struct>() =
type Event<'Delegate, 'Args when 'Delegate: delegate<'Args, unit> and 'Delegate :> System.Delegate and 'Delegate: not struct>() =
let mutable multicast : 'Delegate = Unchecked.defaultof<_>
let mutable multicast: 'Delegate = Unchecked.defaultof<_>
static let mi, argTypes =
let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
let mi = typeof<'Delegate>.GetMethod("Invoke",instanceBindingFlags)
let instanceBindingFlags =
BindingFlags.Instance
||| BindingFlags.Public
||| BindingFlags.NonPublic
||| BindingFlags.DeclaredOnly
let mi = typeof<'Delegate>.GetMethod ("Invoke", instanceBindingFlags)
let actualTypes = mi.GetParameters() |> Array.map (fun p -> p.ParameterType)
mi, actualTypes.[1..]
......@@ -81,31 +98,40 @@ type Event<'Delegate, 'Args when 'Delegate : delegate<'Args, unit> and 'Delegate
// CreateDelegate creates a delegate that is fast to invoke.
static let invoker =
if argTypes.Length = 1 then
(System.Delegate.CreateDelegate(typeof<EventWrapper<'Delegate,'Args>>, mi) :?> EventWrapper<'Delegate,'Args>)
(System.Delegate.CreateDelegate(typeof<EventWrapper<'Delegate, 'Args>>, mi) :?> EventWrapper<'Delegate, 'Args>)
else
null
// For the multi-arg case, use a slower DynamicInvoke.
static let invokeInfo =
let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
let instanceBindingFlags =
BindingFlags.Instance
||| BindingFlags.Public
||| BindingFlags.NonPublic
||| BindingFlags.DeclaredOnly
let mi =
typeof<EventDelegee<'Args>>.GetMethods(instanceBindingFlags)
|> Seq.filter(fun mi -> mi.Name = "Invoke" && mi.GetParameters().Length = argTypes.Length + 1)
typeof<EventDelegee<'Args>>.GetMethods (instanceBindingFlags)
|> Seq.filter (fun mi -> mi.Name = "Invoke" && mi.GetParameters().Length = argTypes.Length + 1)
|> Seq.exactlyOne
if mi.IsGenericMethodDefinition then
mi.MakeGenericMethod argTypes
else
mi
member x.Trigger(sender:obj,args: 'Args) =
member x.Trigger(sender: obj, args: 'Args) =
// Copy multicast value into local variable to avoid changing during member call.
let multicast = multicast
match box multicast with
| null -> ()
| _ ->
match invoker with
| null ->
let args = Array.append [| sender |] (Microsoft.FSharp.Reflection.FSharpValue.GetTupleFields(box args))
let args =
Array.append [| sender |] (Microsoft.FSharp.Reflection.FSharpValue.GetTupleFields(box args))
multicast.DynamicInvoke(args) |> ignore
| _ ->
// For the one-argument case, use an optimization that allows a fast call.
......@@ -114,41 +140,56 @@ type Event<'Delegate, 'Args when 'Delegate : delegate<'Args, unit> and 'Delegate
member x.Publish =
{ new obj() with
member x.ToString() = "<published event>"
interface IEvent<'Delegate,'Args> with
member x.ToString() =
"<published event>"
interface IEvent<'Delegate, 'Args> with
member e.AddHandler(d) =
Atomic.setWith (fun value -> System.Delegate.Combine(value, d) :?> 'Delegate) &multicast
member e.RemoveHandler(d) =
Atomic.setWith (fun value -> System.Delegate.Remove(value, d) :?> 'Delegate) &multicast
interface System.IObservable<'Args> with
member e.Subscribe(observer) =
let obj = new EventDelegee<'Args>(observer)
let h = System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeInfo) :?> 'Delegate
let h =
System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeInfo) :?> 'Delegate
(e :?> IDelegateEvent<'Delegate>).AddHandler(h)
{ new System.IDisposable with
member x.Dispose() = (e :?> IDelegateEvent<'Delegate>).RemoveHandler(h) } }
{ new System.IDisposable with
member x.Dispose() =
(e :?> IDelegateEvent<'Delegate>).RemoveHandler(h)
}
}
[<CompiledName("FSharpEvent`1")>]
type Event<'T> =
val mutable multicast : Handler<'T>
val mutable multicast: Handler<'T>
new() = { multicast = null }
member x.Trigger(arg:'T) =
member x.Trigger(arg: 'T) =
match x.multicast with
| null -> ()
| d -> d.Invoke(null,arg) |> ignore
| d -> d.Invoke(null, arg) |> ignore
member x.Publish =
{ new obj() with
member x.ToString() = "<published event>"
member x.ToString() =
"<published event>"
interface IEvent<'T> with
member e.AddHandler(d) =
Atomic.setWith (fun value -> System.Delegate.Combine(value, d) :?> Handler<'T>) &x.multicast
member e.RemoveHandler(d) =
Atomic.setWith (fun value -> System.Delegate.Remove(value, d) :?> Handler<'T>) &x.multicast
interface System.IObservable<'T> with
member e.Subscribe(observer) =
let h = new Handler<_>(fun sender args -> observer.OnNext(args))
(e :?> IEvent<_,_>).AddHandler(h)
(e :?> IEvent<_, _>).AddHandler(h)
{ new System.IDisposable with
member x.Dispose() = (e :?> IEvent<_,_>).RemoveHandler(h) } }
member x.Dispose() =
(e :?> IEvent<_, _>).RemoveHandler(h)
}
}
src/FSharp.Core/eventmodule.fs
浏览文件 @ 05b560d0
......@@ -9,73 +9,92 @@ open Microsoft.FSharp.Control
[<RequireQualifiedAccess>]
module Event =
[<CompiledName("Create")>]
let create<'T>() =
let create<'T> () =
let ev = new Event<'T>()
ev.Trigger, ev.Publish
[<CompiledName("Map")>]
let map mapping (sourceEvent: IEvent<'Delegate,'T>) =
let map mapping (sourceEvent: IEvent<'Delegate, 'T>) =
let ev = new Event<_>()
sourceEvent.Add(fun x -> ev.Trigger(mapping x))
ev.Publish
[<CompiledName("Filter")>]
let filter predicate (sourceEvent: IEvent<'Delegate,'T>) =
let filter predicate (sourceEvent: IEvent<'Delegate, 'T>) =
let ev = new Event<_>()
sourceEvent.Add(fun x -> if predicate x then ev.Trigger x)
ev.Publish
[<CompiledName("Partition")>]
let partition predicate (sourceEvent: IEvent<'Delegate,'T>) =
let partition predicate (sourceEvent: IEvent<'Delegate, 'T>) =
let ev1 = new Event<_>()
let ev2 = new Event<_>()
sourceEvent.Add(fun x -> if predicate x then ev1.Trigger x else ev2.Trigger x)
ev1.Publish,ev2.Publish
sourceEvent.Add(fun x ->
if predicate x then
ev1.Trigger x
else
ev2.Trigger x)
ev1.Publish, ev2.Publish
[<CompiledName("Choose")>]
let choose chooser (sourceEvent: IEvent<'Delegate,'T>) =
let choose chooser (sourceEvent: IEvent<'Delegate, 'T>) =
let ev = new Event<_>()
sourceEvent.Add(fun x -> match chooser x with None -> () | Some r -> ev.Trigger r)
sourceEvent.Add(fun x ->
match chooser x with
| None -> ()
| Some r -> ev.Trigger r)
ev.Publish
[<CompiledName("Scan")>]
let scan collector state (sourceEvent: IEvent<'Delegate,'T>) =
let scan collector state (sourceEvent: IEvent<'Delegate, 'T>) =
let mutable state = state
let ev = new Event<_>()
sourceEvent.Add(fun msg ->
let z = state
let z = collector z msg
state <- z;
state <- z
ev.Trigger(z))
ev.Publish
[<CompiledName("Add")>]
let add callback (sourceEvent: IEvent<'Delegate,'T>) = sourceEvent.Add(callback)
let add callback (sourceEvent: IEvent<'Delegate, 'T>) =
sourceEvent.Add(callback)
[<CompiledName("Pairwise")>]
let pairwise (sourceEvent : IEvent<'Delegate,'T>) : IEvent<'T * 'T> =
let pairwise (sourceEvent: IEvent<'Delegate, 'T>) : IEvent<'T * 'T> =
let ev = new Event<'T * 'T>()
let mutable lastArgs = None
sourceEvent.Add(fun args2 ->
(match lastArgs with
| None -> ()
| Some args1 -> ev.Trigger(args1,args2))
| Some args1 -> ev.Trigger(args1, args2))
lastArgs <- Some args2)
ev.Publish
[<CompiledName("Merge")>]
let merge (event1: IEvent<'Del1,'T>) (event2: IEvent<'Del2,'T>) =
let merge (event1: IEvent<'Del1, 'T>) (event2: IEvent<'Del2, 'T>) =
let ev = new Event<_>()
event1.Add(fun x -> ev.Trigger(x))
event2.Add(fun x -> ev.Trigger(x))
ev.Publish
[<CompiledName("Split")>]
let split (splitter : 'T -> Choice<'U1,'U2>) (sourceEvent: IEvent<'Delegate,'T>) =
let split (splitter: 'T -> Choice<'U1, 'U2>) (sourceEvent: IEvent<'Delegate, 'T>) =
let ev1 = new Event<_>()
let ev2 = new Event<_>()
sourceEvent.Add(fun x -> match splitter x with Choice1Of2 y -> ev1.Trigger(y) | Choice2Of2 z -> ev2.Trigger(z))
ev1.Publish,ev2.Publish
sourceEvent.Add(fun x ->
match splitter x with
| Choice1Of2 y -> ev1.Trigger(y)
| Choice2Of2 z -> ev2.Trigger(z))
ev1.Publish, ev2.Publish
src/FSharp.Core/list.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/mailbox.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/map.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/math/z.fs
浏览文件 @ 05b560d0
......@@ -28,58 +28,62 @@ module NumericLiterals =
module NumericLiteralI =
let tab64 = new System.Collections.Generic.Dictionary<int64,obj>()
let tabParse = new System.Collections.Generic.Dictionary<string,obj>()
let tab64 = new System.Collections.Generic.Dictionary<int64, obj>()
let tabParse = new System.Collections.Generic.Dictionary<string, obj>()
let FromInt64Dynamic (value:int64) : obj =
let FromInt64Dynamic (value: int64) : obj =
lock tab64 (fun () ->
let mutable res = Unchecked.defaultof<_>
let ok = tab64.TryGetValue(value,&res)
if ok then res else
let ok = tab64.TryGetValue(value, &res)
if ok then
res
else
res <- BigInteger(value)
tab64.[value] <- res
res)
let inline get32 (x32:int32) = FromInt64Dynamic (int64 x32)
let inline get32 (x32: int32) =
FromInt64Dynamic(int64 x32)
let inline isOX s = not (System.String.IsNullOrEmpty(s)) && s.Length > 2 && s.[0] = '0' && s.[1] = 'x'
let inline isOX s =
not (System.String.IsNullOrEmpty(s))
&& s.Length > 2
&& s.[0] = '0'
&& s.[1] = 'x'
let FromZero () : 'T =
(get32 0 :?> 'T)
when 'T : BigInteger = BigInteger.Zero
(get32 0 :?> 'T) when 'T: BigInteger = BigInteger.Zero
let FromOne () : 'T =
(get32 1 :?> 'T)
when 'T : BigInteger = BigInteger.One
(get32 1 :?> 'T) when 'T: BigInteger = BigInteger.One
let FromInt32 (value:int32): 'T =
(get32 value :?> 'T)
when 'T : BigInteger = new BigInteger(value)
let FromInt32 (value: int32) : 'T =
(get32 value :?> 'T) when 'T: BigInteger = new BigInteger(value)
let FromInt64 (value:int64): 'T =
(FromInt64Dynamic value :?> 'T)
when 'T : BigInteger = new BigInteger(value)
let FromInt64 (value: int64) : 'T =
(FromInt64Dynamic value :?> 'T) when 'T: BigInteger = new BigInteger(value)
let getParse s =
lock tabParse (fun () ->
let mutable res = Unchecked.defaultof<_>
let ok = tabParse.TryGetValue(s,&res)
let ok = tabParse.TryGetValue(s, &res)
if ok then
res
else
let v =
if isOX s then
BigInteger.Parse (s.[2..],NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture)
BigInteger.Parse(s.[2..], NumberStyles.AllowHexSpecifier, CultureInfo.InvariantCulture)
else
BigInteger.Parse (s,NumberStyles.AllowLeadingSign,CultureInfo.InvariantCulture)
BigInteger.Parse(s, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture)
res <- v
tabParse.[s] <- res
res)
let FromStringDynamic (text:string) : obj =
let FromStringDynamic (text: string) : obj =
getParse text
let FromString (text:string) : 'T =
(FromStringDynamic text :?> 'T)
when 'T : BigInteger = getParse text
let FromString (text: string) : 'T =
(FromStringDynamic text :?> 'T) when 'T: BigInteger = getParse text
src/FSharp.Core/observable.fs
浏览文件 @ 05b560d0
......@@ -12,7 +12,11 @@ open Microsoft.FSharp.Control
module Observable =
let inline protect f succeed fail =
match (try Choice1Of2 (f ()) with e -> Choice2Of2 e) with
match (try
Choice1Of2(f ())
with e ->
Choice2Of2 e)
with
| Choice1Of2 x -> (succeed x)
| Choice2Of2 e -> (fail e)
......@@ -21,27 +25,26 @@ module Observable =
let mutable stopped = false
abstract Next : value : 'T -> unit
abstract Next: value: 'T -> unit
abstract Error : error : exn -> unit
abstract Error: error: exn -> unit
abstract Completed : unit -> unit
abstract Completed: unit -> unit
interface IObserver<'T> with
member x.OnNext value =
if not stopped then
x.Next value
if not stopped then x.Next value
member x.OnError e =
if not stopped then
stopped <- true
x.Error e
member x.OnCompleted () =
member x.OnCompleted() =
if not stopped then
stopped <- true
x.Completed ()
x.Completed()
[<CompiledName("Map")>]
let map mapping (source: IObservable<'T>) =
......@@ -53,9 +56,13 @@ module Observable =
member x.Next(v) =
protect (fun () -> mapping v) observer.OnNext observer.OnError
member x.Error(e) = observer.OnError(e)
member x.Error(e) =
observer.OnError(e)
member x.Completed() = observer.OnCompleted() } }
member x.Completed() =
observer.OnCompleted()
}
}
[<CompiledName("Choose")>]
let choose chooser (source: IObservable<'T>) =
......@@ -65,11 +72,20 @@ module Observable =
{ new BasicObserver<'T>() with
member x.Next(v) =
protect (fun () -> chooser v) (function None -> () | Some v2 -> observer.OnNext v2) observer.OnError
protect
(fun () -> chooser v)
(function
| None -> ()
| Some v2 -> observer.OnNext v2)
observer.OnError
member x.Error(e) = observer.OnError(e)
member x.Error(e) =
observer.OnError(e)
member x.Completed() = observer.OnCompleted() } }
member x.Completed() =
observer.OnCompleted()
}
}
[<CompiledName("Filter")>]
let filter predicate (source: IObservable<'T>) =
......@@ -84,42 +100,59 @@ module Observable =
{ new IObservable<'U> with
member x.Subscribe(observer) =
let mutable state = state
source.Subscribe
{ new BasicObserver<'T>() with
member x.Next(v) =
let z = state
protect (fun () -> collector z v) (fun z ->
protect
(fun () -> collector z v)
(fun z ->
state <- z
observer.OnNext z) observer.OnError
observer.OnNext z)
observer.OnError
member x.Error(e) = observer.OnError(e)
member x.Error(e) =
observer.OnError(e)
member x.Completed() = observer.OnCompleted() } }
member x.Completed() =
observer.OnCompleted()
}
}
[<CompiledName("Add")>]
let add callback (source: IObservable<'T>) = source.Add(callback)
let add callback (source: IObservable<'T>) =
source.Add(callback)
[<CompiledName("Subscribe")>]
let subscribe (callback: 'T -> unit) (source: IObservable<'T>) = source.Subscribe(callback)
let subscribe (callback: 'T -> unit) (source: IObservable<'T>) =
source.Subscribe(callback)
[<CompiledName("Pairwise")>]
let pairwise (source : IObservable<'T>) : IObservable<'T * 'T> =
let pairwise (source: IObservable<'T>) : IObservable<'T * 'T> =
{ new IObservable<_> with
member x.Subscribe(observer) =
let mutable lastArgs = None
source.Subscribe
{ new BasicObserver<'T>() with
member x.Next(args2) =
match lastArgs with
| None -> ()
| Some args1 -> observer.OnNext (args1,args2)
| Some args1 -> observer.OnNext(args1, args2)
lastArgs <- Some args2
member x.Error(e) = observer.OnError(e)
member x.Error(e) =
observer.OnError(e)
member x.Completed() = observer.OnCompleted() } }
member x.Completed() =
observer.OnCompleted()
}
}
[<CompiledName("Merge")>]
let merge (source1: IObservable<'T>) (source2: IObservable<'T>) =
......@@ -128,12 +161,12 @@ module Observable =
let mutable stopped = false
let mutable completed1 = false
let mutable completed2 = false
let h1 =
source1.Subscribe
{ new IObserver<'T> with
member x.OnNext(v) =
if not stopped then
observer.OnNext v
if not stopped then observer.OnNext v
member x.OnError(e) =
if not stopped then
......@@ -143,15 +176,17 @@ module Observable =
member x.OnCompleted() =
if not stopped then
completed1 <- true
if completed1 && completed2 then
stopped <- true
observer.OnCompleted() }
observer.OnCompleted()
}
let h2 =
source2.Subscribe
{ new IObserver<'T> with
member x.OnNext(v) =
if not stopped then
observer.OnNext v
if not stopped then observer.OnNext v
member x.OnError(e) =
if not stopped then
......@@ -161,17 +196,30 @@ module Observable =
member x.OnCompleted() =
if not stopped then
completed2 <- true
if completed1 && completed2 then
stopped <- true
observer.OnCompleted() }
observer.OnCompleted()
}
{ new IDisposable with
member x.Dispose() =
h1.Dispose()
h2.Dispose() } }
h2.Dispose()
}
}
[<CompiledName("Split")>]
let split (splitter : 'T -> Choice<'U1,'U2>) (source: IObservable<'T>) =
choose (fun v -> match splitter v with Choice1Of2 x -> Some x | _ -> None) source,
choose (fun v -> match splitter v with Choice2Of2 x -> Some x | _ -> None) source
let split (splitter: 'T -> Choice<'U1, 'U2>) (source: IObservable<'T>) =
choose
(fun v ->
match splitter v with
| Choice1Of2 x -> Some x
| _ -> None)
source,
choose
(fun v ->
match splitter v with
| Choice2Of2 x -> Some x
| _ -> None)
source
src/FSharp.Core/option.fs
浏览文件 @ 05b560d0
......@@ -56,13 +56,13 @@ module Option =
| Some _ -> 1
[<CompiledName("Fold")>]
let fold<'T,'State> folder (state:'State) (option: 'T option) =
let fold<'T, 'State> folder (state: 'State) (option: 'T option) =
match option with
| None -> state
| Some x -> folder state x
[<CompiledName("FoldBack")>]
let foldBack<'T,'State> folder (option: option<'T>) (state:'State) =
let foldBack<'T, 'State> folder (option: option<'T>) (state: 'State) =
match option with
| None -> state
| Some x -> folder x state
......@@ -95,18 +95,18 @@ module Option =
let map mapping option =
match option with
| None -> None
| Some x -> Some (mapping x)
| Some x -> Some(mapping x)
[<CompiledName("Map2")>]
let map2 mapping option1 option2 =
match option1, option2 with
| Some x, Some y -> Some (mapping x y)
| Some x, Some y -> Some(mapping x y)
| _ -> None
[<CompiledName("Map3")>]
let map3 mapping option1 option2 option3 =
match option1, option2, option3 with
| Some x, Some y, Some z -> Some (mapping x y z)
| Some x, Some y, Some z -> Some(mapping x y z)
| _ -> None
[<CompiledName("Bind")>]
......@@ -130,13 +130,13 @@ module Option =
[<CompiledName("ToArray")>]
let toArray option =
match option with
| None -> [| |]
| None -> [||]
| Some x -> [| x |]
[<CompiledName("ToList")>]
let toList option =
match option with
| None -> [ ]
| None -> []
| Some x -> [ x ]
[<CompiledName("ToNullable")>]
......@@ -146,7 +146,7 @@ module Option =
| Some v -> System.Nullable(v)
[<CompiledName("OfNullable")>]
let ofNullable (value:System.Nullable<'T>) =
let ofNullable (value: System.Nullable<'T>) =
if value.HasValue then
Some value.Value
else
......@@ -215,13 +215,13 @@ module ValueOption =
| ValueSome _ -> 1
[<CompiledName("Fold")>]
let fold<'T,'State> folder (state:'State) (voption: voption<'T>) =
let fold<'T, 'State> folder (state: 'State) (voption: voption<'T>) =
match voption with
| ValueNone -> state
| ValueSome x -> folder state x
[<CompiledName("FoldBack")>]
let foldBack<'T,'State> folder (voption: voption<'T>) (state:'State) =
let foldBack<'T, 'State> folder (voption: voption<'T>) (state: 'State) =
match voption with
| ValueNone -> state
| ValueSome x -> folder x state
......@@ -254,18 +254,18 @@ module ValueOption =
let map mapping voption =
match voption with
| ValueNone -> ValueNone
| ValueSome x -> ValueSome (mapping x)
| ValueSome x -> ValueSome(mapping x)
[<CompiledName("Map2")>]
let map2 mapping voption1 voption2 =
match voption1, voption2 with
| ValueSome x, ValueSome y -> ValueSome (mapping x y)
| ValueSome x, ValueSome y -> ValueSome(mapping x y)
| _ -> ValueNone
[<CompiledName("Map3")>]
let map3 mapping voption1 voption2 voption3 =
match voption1, voption2, voption3 with
| ValueSome x, ValueSome y, ValueSome z -> ValueSome (mapping x y z)
| ValueSome x, ValueSome y, ValueSome z -> ValueSome(mapping x y z)
| _ -> ValueNone
[<CompiledName("Bind")>]
......@@ -284,18 +284,22 @@ module ValueOption =
let filter predicate voption =
match voption with
| ValueNone -> ValueNone
| ValueSome x -> if predicate x then ValueSome x else ValueNone
| ValueSome x ->
if predicate x then
ValueSome x
else
ValueNone
[<CompiledName("ToArray")>]
let toArray voption =
match voption with
| ValueNone -> [| |]
| ValueNone -> [||]
| ValueSome x -> [| x |]
[<CompiledName("ToList")>]
let toList voption =
match voption with
| ValueNone -> [ ]
| ValueNone -> []
| ValueSome x -> [ x ]
[<CompiledName("ToNullable")>]
......@@ -305,7 +309,7 @@ module ValueOption =
| ValueSome v -> System.Nullable(v)
[<CompiledName("OfNullable")>]
let ofNullable (value:System.Nullable<'T>) =
let ofNullable (value: System.Nullable<'T>) =
if value.HasValue then
ValueSome value.Value
else
......
src/FSharp.Core/quotations.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/reflect.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/result.fs
浏览文件 @ 05b560d0
......@@ -6,10 +6,19 @@ namespace Microsoft.FSharp.Core
module Result =
[<CompiledName("Map")>]
let map mapping result = match result with Error e -> Error e | Ok x -> Ok (mapping x)
let map mapping result =
match result with
| Error e -> Error e
| Ok x -> Ok(mapping x)
[<CompiledName("MapError")>]
let mapError mapping result = match result with Error e -> Error (mapping e) | Ok x -> Ok x
let mapError mapping result =
match result with
| Error e -> Error(mapping e)
| Ok x -> Ok x
[<CompiledName("Bind")>]
let bind binder result = match result with Error e -> Error e | Ok x -> binder x
let bind binder result =
match result with
| Error e -> Error e
| Ok x -> binder x
src/FSharp.Core/resumable.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/seq.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/set.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/string.fs
浏览文件 @ 05b560d0
此差异已折叠。
src/FSharp.Core/tasks.fs
浏览文件 @ 05b560d0
此差异已折叠。
Markdown is supported
0% 或 .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑！
想要评论请 注册 或