Skip to content
体验新版
项目
组织
正在加载...
登录
切换导航
打开侧边栏
dotNET Platform
fsharp
提交
2afd4fac
F
fsharp
项目概览
dotNET Platform
/
fsharp
11 个月 前同步成功
通知
0
Star
1
Fork
0
代码
文件
提交
分支
Tags
贡献者
分支图
Diff
Issue
0
列表
看板
标记
里程碑
合并请求
0
DevOps
流水线
流水线任务
计划
Wiki
0
Wiki
分析
仓库
DevOps
项目成员
Pages
F
fsharp
项目概览
项目概览
详情
发布
仓库
仓库
文件
提交
分支
标签
贡献者
分支图
比较
Issue
0
Issue
0
列表
看板
标记
里程碑
合并请求
0
合并请求
0
Pages
DevOps
DevOps
流水线
流水线任务
计划
分析
分析
仓库分析
DevOps
Wiki
0
Wiki
成员
成员
收起侧边栏
关闭侧边栏
动态
分支图
创建新Issue
流水线任务
提交
Issue看板
体验新版 GitCode,发现更多精彩内容 >>
提交
2afd4fac
编写于
7月 12, 2022
作者:
D
Don Syme
浏览文件
操作
浏览文件
下载
差异文件
Merge commit '
05b560d0
' into feature/ext
上级
d41c2e0a
05b560d0
变更
25
展开全部
隐藏空白更改
内联
并排
Showing
25 changed file
with
8619 addition
and
5268 deletion
+8619
-5268
.fantomasignore
.fantomasignore
+17
-1
src/FSharp.Core/.editorconfig
src/FSharp.Core/.editorconfig
+2
-0
src/FSharp.Core/MutableTuple.fs
src/FSharp.Core/MutableTuple.fs
+100
-60
src/FSharp.Core/Nullable.fs
src/FSharp.Core/Nullable.fs
+246
-83
src/FSharp.Core/QueryExtensions.fs
src/FSharp.Core/QueryExtensions.fs
+203
-145
src/FSharp.Core/array.fs
src/FSharp.Core/array.fs
+1130
-546
src/FSharp.Core/async.fs
src/FSharp.Core/async.fs
+926
-663
src/FSharp.Core/collections.fs
src/FSharp.Core/collections.fs
+42
-25
src/FSharp.Core/event.fs
src/FSharp.Core/event.fs
+118
-77
src/FSharp.Core/eventmodule.fs
src/FSharp.Core/eventmodule.fs
+53
-34
src/FSharp.Core/fslib-extra-pervasives.fs
src/FSharp.Core/fslib-extra-pervasives.fs
+277
-190
src/FSharp.Core/list.fs
src/FSharp.Core/list.fs
+379
-199
src/FSharp.Core/mailbox.fs
src/FSharp.Core/mailbox.fs
+150
-96
src/FSharp.Core/map.fs
src/FSharp.Core/map.fs
+682
-477
src/FSharp.Core/math/z.fs
src/FSharp.Core/math/z.fs
+59
-55
src/FSharp.Core/observable.fs
src/FSharp.Core/observable.fs
+162
-114
src/FSharp.Core/option.fs
src/FSharp.Core/option.fs
+26
-22
src/FSharp.Core/quotations.fs
src/FSharp.Core/quotations.fs
+1585
-881
src/FSharp.Core/reflect.fs
src/FSharp.Core/reflect.fs
+646
-439
src/FSharp.Core/result.fs
src/FSharp.Core/result.fs
+12
-3
src/FSharp.Core/resumable.fs
src/FSharp.Core/resumable.fs
+138
-87
src/FSharp.Core/seq.fs
src/FSharp.Core/seq.fs
+749
-440
src/FSharp.Core/set.fs
src/FSharp.Core/set.fs
+664
-451
src/FSharp.Core/string.fs
src/FSharp.Core/string.fs
+58
-40
src/FSharp.Core/tasks.fs
src/FSharp.Core/tasks.fs
+195
-140
未找到文件。
.fantomasignore
浏览文件 @
2afd4fac
...
...
@@ -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
浏览文件 @
2afd4fac
[*.fs]
fsharp_max_function_binding_width=1
src/FSharp.Core/MutableTuple.fs
浏览文件 @
2afd4fac
...
...
@@ -7,170 +7,210 @@ open Microsoft.FSharp.Core
// ----------------------------------------------------------------------------
// Mutable Tuples - used when translating queries that use F# tuples
// and records. We replace tuples/records with anonymous types which
// and records. We replace tuples/records with anonymous types which
// are handled correctly by LINQ to SQL/Entities and other providers.
//
// NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
//
// The terminology "mutable tuple" is now incorrect in this code -
// The terminology "mutable tuple" is now incorrect in this code -
// "immutable anonymous tuple-like types" are used instead. The key thing in this
// code is that the anonymous types used conform to the shape and style
// expected by LINQ providers, and we pass the correspondence between constructor
// arguments and properties to the magic "members" argument of the Expression.New
// constructor in Linq.fs.
//
// This terminology mistake also runs all the way through Query.fs.
// This terminology mistake also runs all the way through Query.fs.
// ----------------------------------------------------------------------------
/// <summary>This type shouldn't be used directly from user code.</summary>
/// <exclude />
type
AnonymousObject
<
'
T1
>
=
val
private
item1
:
'
T1
member
x
.
Item1
=
x
.
item1
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
member
x
.
Item1
=
x
.
item1
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
member
x
.
Item1
=
x
.
item1
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
member
x
.
Item1
=
x
.
item1
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
member
x
.
Item1
=
x
.
item1
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
member
x
.
Item1
=
x
.
item1
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
member
x
.
Item1
=
x
.
item1
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
member
x
.
Item1
=
x
.
item1
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
浏览文件 @
2afd4fac
...
...
@@ -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
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/array.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/async.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/collections.fs
浏览文件 @
2afd4fac
...
...
@@ -8,41 +8,58 @@ open Microsoft.FSharp.Core
open
Microsoft
.
FSharp
.
Core
.
Operators
open
System
.
Collections
.
Generic
module
HashIdentity
=
let
inline
Structural
<
'
T
when
'
T
:
equality
>
:
IEqualityComparer
<
'
T
>
=
module
HashIdentity
=
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
}
let
inline
NonStructural
<
'
T
when
'
T
:
equality
and
'
T
:
(
static
member
(=):
'
T
*
'
T
->
bool
)>
=
{
new
IEqualityComparer
<
'
T
>
with
member
_.
GetHashCode
(
x
)
=
LanguagePrimitives
.
PhysicalHash
(
x
)
member
_.
Equals
(
x
,
y
)
=
LanguagePrimitives
.
PhysicalEquality
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
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
)
=
hasher
x
let
inline
FromFunctions
hasher
equality
:
IEqualityComparer
<
'
T
>
=
let
eq
=
OptimizedClosures
.
FSharpFunc
<_,_,_>.
Adapt
(
equality
)
{
new
IEqualityComparer
<
'
T
>
with
member
_.
GetHashCode
(
x
)
=
hasher
x
member
_.
Equals
(
x
,
y
)
=
eq
.
Invoke
(
x
,
y
)
}
member
_.
Equals
(
x
,
y
)
=
eq
.
Invoke
(
x
,
y
)
}
module
ComparisonIdentity
=
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
FromFunction
comparer
=
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
浏览文件 @
2afd4fac
...
...
@@ -17,138 +17,179 @@ 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
[]
)
=
match
multicast
with
type
DelegateEvent
<
'
Delegate
when
'
Delegate
:>
System
.
Delegate
>()
=
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
.
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
=
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
)
=
member
x
.
Invoke
(_
sender
:
obj
,
args
:
'
Args
)
=
observer
.
OnNext
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
)
=
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
static
let
mi
,
argTypes
=
let
instanceBindingFlags
=
BindingFlags
.
Instance
|||
BindingFlags
.
Public
|||
BindingFlags
.
NonPublic
|||
BindingFlags
.
DeclaredOnly
let
mi
=
typeof
<
'
Delegate
>.
GetMethod
(
"Invoke"
,
instanceBindingFlags
)
let
mi
=
typeof
<
'
Delegate
>.
GetMethod
(
"Invoke"
,
instanceBindingFlags
)
let
actualTypes
=
mi
.
GetParameters
()
|>
Array
.
map
(
fun
p
->
p
.
ParameterType
)
mi
,
actualTypes
.[
1
..]
// For the one-argument case, use an optimization that allows a fast call.
// For the one-argument case, use an optimization that allows a fast call.
// 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
>)
static
let
invoker
=
if
argTypes
.
Length
=
1
then
(
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
mi
=
typeof
<
EventDelegee
<
'
Args
>>.
GetMethods
(
instanceBindingFlags
)
|>
Seq
.
filter
(
fun
mi
->
mi
.
Name
=
"Invoke"
&&
mi
.
GetParameters
()
.
Length
=
argTypes
.
Length
+
1
)
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
)
|>
Seq
.
exactlyOne
if
mi
.
IsGenericMethodDefinition
then
mi
.
MakeGenericMethod
argTypes
else
mi
else
mi
member
x
.
Trigger
(
sender
:
obj
,
args
:
'
Args
)
=
// Copy multicast value into local variable to avoid changing during member call.
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
))
match
box
multicast
with
|
null
->
()
|
_
->
match
invoker
with
|
null
->
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.
|
_
->
// For the one-argument case, use an optimization that allows a fast call.
// CreateDelegate creates a delegate that is fast to invoke.
invoker
.
Invoke
(
multicast
,
sender
,
args
)
|>
ignore
member
x
.
Publish
=
{
new
obj
()
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
(
e
:?>
IDelegateEvent
<
'
Delegate
>).
AddHandler
(
h
)
{
new
System
.
IDisposable
with
member
x
.
Dispose
()
=
(
e
:?>
IDelegateEvent
<
'
Delegate
>).
RemoveHandler
(
h
)
}
}
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
(
e
:?>
IDelegateEvent
<
'
Delegate
>).
AddHandler
(
h
)
{
new
System
.
IDisposable
with
member
x
.
Dispose
()
=
(
e
:?>
IDelegateEvent
<
'
Delegate
>).
RemoveHandler
(
h
)
}
}
[<
CompiledName
(
"FSharpEvent`1"
)>]
type
Event
<
'
T
>
=
val
mutable
multicast
:
Handler
<
'
T
>
type
Event
<
'
T
>
=
val
mutable
multicast
:
Handler
<
'
T
>
new
()
=
{
multicast
=
null
}
member
x
.
Trigger
(
arg
:
'
T
)
=
match
x
.
multicast
with
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>"
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
)
{
new
System
.
IDisposable
with
member
x
.
Dispose
()
=
(
e
:?>
IEvent
<_,_>).
RemoveHandler
(
h
)
}
}
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
)
{
new
System
.
IDisposable
with
member
x
.
Dispose
()
=
(
e
:?>
IEvent
<_,
_>).
RemoveHandler
(
h
)
}
}
src/FSharp.Core/eventmodule.fs
浏览文件 @
2afd4fac
...
...
@@ -9,73 +9,92 @@ open Microsoft.FSharp.Control
[<
RequireQualifiedAccess
>]
module
Event
=
[<
CompiledName
(
"Create"
)>]
let
create
<
'
T
>
()
=
let
ev
=
new
Event
<
'
T
>()
let
create
<
'
T
>
()
=
let
ev
=
new
Event
<
'
T
>()
ev
.
Trigger
,
ev
.
Publish
[<
CompiledName
(
"Map"
)>]
let
map
mapping
(
sourceEvent
:
IEvent
<
'
Delegate
,
'
T
>)
=
let
ev
=
new
Event
<_>()
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
ev
=
new
Event
<_>()
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
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
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
[<
CompiledName
(
"Choose"
)>]
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
)
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
)
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
<_>()
let
ev
=
new
Event
<_>()
sourceEvent
.
Add
(
fun
msg
->
let
z
=
state
let
z
=
collector
z
msg
state
<-
z
;
ev
.
Trigger
(
z
))
let
z
=
state
let
z
=
collector
z
msg
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
ev
=
new
Event
<
'
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
))
sourceEvent
.
Add
(
fun
args2
->
(
match
lastArgs
with
|
None
->
()
|
Some
args1
->
ev
.
Trigger
(
args1
,
args2
))
lastArgs
<-
Some
args2
)
ev
.
Publish
[<
CompiledName
(
"Merge"
)>]
let
merge
(
event1
:
IEvent
<
'
Del1
,
'
T
>)
(
event2
:
IEvent
<
'
Del2
,
'
T
>)
=
let
ev
=
new
Event
<_>()
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
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
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
src/FSharp.Core/fslib-extra-pervasives.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/list.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/mailbox.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/map.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/math/z.fs
浏览文件 @
2afd4fac
...
...
@@ -26,60 +26,64 @@ open System.Numerics
[<
AutoOpen
>]
module
NumericLiterals
=
module
NumericLiteralI
=
let
tab64
=
new
System
.
Collections
.
Generic
.
Dictionary
<
int64
,
obj
>()
let
tabParse
=
new
System
.
Collections
.
Generic
.
Dictionary
<
string
,
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
res
<-
BigInteger
(
value
)
tab64
.[
value
]
<-
res
res
)
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
FromZero
()
:
'
T
=
(
get32
0
:?>
'
T
)
when
'
T
:
BigInteger
=
BigInteger
.
Zero
let
FromOne
()
:
'
T
=
(
get32
1
:?>
'
T
)
when
'
T
:
BigInteger
=
BigInteger
.
One
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
getParse
s
=
lock
tabParse
(
fun
()
->
let
mutable
res
=
Unchecked
.
defaultof
<_>
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
)
else
BigInteger
.
Parse
(
s
,
NumberStyles
.
AllowLeadingSign
,
CultureInfo
.
InvariantCulture
)
res
<-
v
tabParse
.[
s
]
<-
res
res
)
let
FromStringDynamic
(
text
:
string
)
:
obj
=
module
NumericLiteralI
=
let
tab64
=
new
System
.
Collections
.
Generic
.
Dictionary
<
int64
,
obj
>()
let
tabParse
=
new
System
.
Collections
.
Generic
.
Dictionary
<
string
,
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
res
<-
BigInteger
(
value
)
tab64
.[
value
]
<-
res
res
)
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
FromZero
()
:
'
T
=
(
get32
0
:?>
'
T
)
when
'
T
:
BigInteger
=
BigInteger
.
Zero
let
FromOne
()
:
'
T
=
(
get32
1
:?>
'
T
)
when
'
T
:
BigInteger
=
BigInteger
.
One
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
getParse
s
=
lock
tabParse
(
fun
()
->
let
mutable
res
=
Unchecked
.
defaultof
<_>
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
)
else
BigInteger
.
Parse
(
s
,
NumberStyles
.
AllowLeadingSign
,
CultureInfo
.
InvariantCulture
)
res
<-
v
tabParse
.[
s
]
<-
res
res
)
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
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/option.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/quotations.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/reflect.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/result.fs
浏览文件 @
2afd4fac
...
...
@@ -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
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/seq.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/set.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/string.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
src/FSharp.Core/tasks.fs
浏览文件 @
2afd4fac
此差异已折叠。
点击以展开。
编辑
预览
Markdown
is supported
0%
请重试
或
添加新附件
.
添加附件
取消
You are about to add
0
people
to the discussion. Proceed with caution.
先完成此消息的编辑!
取消
想要评论请
注册
或
登录