зеркало из https://github.com/dotnet/fsharp.git
Merge main to release/dev17.3 (#13213)
* update fantomas (#13206) * Format most of FSharp.Core (#13150) * modify fantomasignore * fix setting * no single line functions in FSHarp.Core * update fantomas * apply formatting * Format src/Compiler/Driver (#13195) * adjust settings * adjust code * adjust settings * adjust code * fix code before formatting * remove unnecessary yield * manual pre-formatting * preadjust code * preadjust code * preadjust code * preadjust code * adjust settings" * adjust settings" * adjust settings * adjust settings * fix build * adjust settings * adjust code * adjust code * adjust code * update fantomas * apply formatting * apply formatting (fix build) (#13209) * preformat * apply formatting Co-authored-by: Don Syme <dsyme@users.noreply.github.com>
This commit is contained in:
dotnet bot
GitHub
Родитель
ad3e6de201
Коммит
e1e4d6a8b1
|
|
@ -3,7 +3,7 @@
|
|||
"isRoot": true,
|
||||
"tools": {
|
||||
"fantomas": {
|
||||
"version": "5.0.0-alpha-006",
|
||||
"version": "5.0.0-alpha-008",
|
||||
"commands": [
|
||||
"fantomas"
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,8 +1,11 @@
|
|||
root = true
|
||||
|
||||
# max_line_length is set to 140. At some point we will reduce it to 120 for as many files as reasonable.
|
||||
[*.fs]
|
||||
max_line_length=140
|
||||
fsharp_newline_between_type_definition_and_members=true
|
||||
fsharp_max_function_binding_width=40
|
||||
fsharp_max_if_then_else_short_width=60
|
||||
fsharp_max_infix_operator_expression=80
|
||||
fsharp_max_array_or_list_width=80
|
||||
fsharp_max_array_or_list_number_of_items=5
|
||||
|
|
@ -13,3 +16,13 @@ fsharp_keep_max_number_of_blank_lines=1
|
|||
[*.fsi]
|
||||
fsharp_newline_between_type_definition_and_members=true
|
||||
fsharp_keep_max_number_of_blank_lines=1
|
||||
|
||||
# These files contains many imperative if-then expressions which are not clearer on one line
|
||||
# Reducing fsharp_max_if_then_else_short_width back to its default formats these over multiple lines.
|
||||
[src/FSharp.Build/*.fs]
|
||||
fsharp_max_if_then_else_short_width=40
|
||||
|
||||
# This file contains a long list of one-line function definitions. Increasing
|
||||
# fsharp_max_function_binding_width formats these over a single line.
|
||||
[src/Compiler/Driver/CompilerDiagnostics.fs]
|
||||
fsharp_max_function_binding_width=70
|
||||
|
|
|
|||
|
|
@ -13,11 +13,9 @@ artifacts/
|
|||
|
||||
# Explicitly unformatted implementation files
|
||||
|
||||
src/FSharp.Core/**/*.fs
|
||||
src/Compiler/Checking/**/*.fs
|
||||
src/Compiler/CodeGen/**/*.fs
|
||||
src/Compiler/DependencyManager/**/*.fs
|
||||
src/Compiler/Driver/**/*.fs
|
||||
src/Compiler/Facilities/**/*.fs
|
||||
src/Compiler/Interactive/**/*.fs
|
||||
src/Compiler/Legacy/**/*.fs
|
||||
|
|
@ -28,6 +26,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
|
||||
|
|
|
|||
|
|
@ -25,9 +25,7 @@ open Internal.Utilities
|
|||
|
||||
let logging = false
|
||||
|
||||
let _ =
|
||||
if logging then
|
||||
dprintn "* warning: Il.logging is on"
|
||||
let _ = if logging then dprintn "* warning: Il.logging is on"
|
||||
|
||||
let int_order = LanguagePrimitives.FastGenericComparer<int>
|
||||
|
||||
|
|
@ -70,19 +68,13 @@ let memoizeNamespaceRightTable =
|
|||
let memoizeNamespacePartTable = ConcurrentDictionary<string, string>()
|
||||
|
||||
let splitNameAt (nm: string) idx =
|
||||
if idx < 0 then
|
||||
failwith "splitNameAt: idx < 0"
|
||||
if idx < 0 then failwith "splitNameAt: idx < 0"
|
||||
|
||||
let last = nm.Length - 1
|
||||
|
||||
if idx > last then
|
||||
failwith "splitNameAt: idx > last"
|
||||
if idx > last then failwith "splitNameAt: idx > last"
|
||||
|
||||
(nm.Substring(0, idx)),
|
||||
(if idx < last then
|
||||
nm.Substring(idx + 1, last - idx)
|
||||
else
|
||||
"")
|
||||
(nm.Substring(0, idx)), (if idx < last then nm.Substring(idx + 1, last - idx) else "")
|
||||
|
||||
let rec splitNamespaceAux (nm: string) =
|
||||
match nm.IndexOf '.' with
|
||||
|
|
@ -218,14 +210,10 @@ module SHA1 =
|
|||
let inline (>>>&) (x: int) (y: int) = int32 (uint32 x >>> y)
|
||||
|
||||
let f (t, b, c, d) =
|
||||
if t < 20 then
|
||||
(b &&& c) ||| ((~~~b) &&& d)
|
||||
elif t < 40 then
|
||||
b ^^^ c ^^^ d
|
||||
elif t < 60 then
|
||||
(b &&& c) ||| (b &&& d) ||| (c &&& d)
|
||||
else
|
||||
b ^^^ c ^^^ d
|
||||
if t < 20 then (b &&& c) ||| ((~~~b) &&& d)
|
||||
elif t < 40 then b ^^^ c ^^^ d
|
||||
elif t < 60 then (b &&& c) ||| (b &&& d) ||| (c &&& d)
|
||||
else b ^^^ c ^^^ d
|
||||
|
||||
[<Literal>]
|
||||
let k0to19 = 0x5A827999
|
||||
|
|
@ -563,8 +551,7 @@ type ILAssemblyRef(data) =
|
|||
addC (convDigit (int32 v / 16))
|
||||
addC (convDigit (int32 v % 16))
|
||||
// retargetable can be true only for system assemblies that definitely have Version
|
||||
if aref.Retargetable then
|
||||
add ", Retargetable=Yes"
|
||||
if aref.Retargetable then add ", Retargetable=Yes"
|
||||
|
||||
b.ToString()
|
||||
|
||||
|
|
@ -773,17 +760,9 @@ type ILTypeRef =
|
|||
else
|
||||
y.ApproxId
|
||||
|
||||
let xScope =
|
||||
if isPrimaryX then
|
||||
primaryScopeRef
|
||||
else
|
||||
x.Scope
|
||||
let xScope = if isPrimaryX then primaryScopeRef else x.Scope
|
||||
|
||||
let yScope =
|
||||
if isPrimaryY then
|
||||
primaryScopeRef
|
||||
else
|
||||
y.Scope
|
||||
let yScope = if isPrimaryY then primaryScopeRef else y.Scope
|
||||
|
||||
(xApproxId = yApproxId)
|
||||
&& (xScope = yScope)
|
||||
|
|
@ -806,10 +785,7 @@ type ILTypeRef =
|
|||
else
|
||||
let c = compare x.Name y.Name
|
||||
|
||||
if c <> 0 then
|
||||
c
|
||||
else
|
||||
compare x.Enclosing y.Enclosing
|
||||
if c <> 0 then c else compare x.Enclosing y.Enclosing
|
||||
|
||||
member tref.FullName = String.concat "." (tref.Enclosing @ [ tref.Name ])
|
||||
|
||||
|
|
@ -883,11 +859,7 @@ and [<StructuralEquality; StructuralComparison; StructuredFormatDisplay("{DebugT
|
|||
&& (x.GenericArgs = y.GenericArgs)
|
||||
|
||||
override x.ToString() =
|
||||
x.TypeRef.ToString()
|
||||
+ if isNil x.GenericArgs then
|
||||
""
|
||||
else
|
||||
"<...>"
|
||||
x.TypeRef.ToString() + if isNil x.GenericArgs then "" else "<...>"
|
||||
|
||||
and [<RequireQualifiedAccess; StructuralEquality; StructuralComparison; StructuredFormatDisplay("{DebugText}")>] ILType =
|
||||
| Void
|
||||
|
|
@ -1859,20 +1831,13 @@ type ILGenericParameterDefs = ILGenericParameterDef list
|
|||
let memberAccessOfFlags flags =
|
||||
let f = (flags &&& 0x00000007)
|
||||
|
||||
if f = 0x00000001 then
|
||||
ILMemberAccess.Private
|
||||
elif f = 0x00000006 then
|
||||
ILMemberAccess.Public
|
||||
elif f = 0x00000004 then
|
||||
ILMemberAccess.Family
|
||||
elif f = 0x00000002 then
|
||||
ILMemberAccess.FamilyAndAssembly
|
||||
elif f = 0x00000005 then
|
||||
ILMemberAccess.FamilyOrAssembly
|
||||
elif f = 0x00000003 then
|
||||
ILMemberAccess.Assembly
|
||||
else
|
||||
ILMemberAccess.CompilerControlled
|
||||
if f = 0x00000001 then ILMemberAccess.Private
|
||||
elif f = 0x00000006 then ILMemberAccess.Public
|
||||
elif f = 0x00000004 then ILMemberAccess.Family
|
||||
elif f = 0x00000002 then ILMemberAccess.FamilyAndAssembly
|
||||
elif f = 0x00000005 then ILMemberAccess.FamilyOrAssembly
|
||||
elif f = 0x00000003 then ILMemberAccess.Assembly
|
||||
else ILMemberAccess.CompilerControlled
|
||||
|
||||
let convertMemberAccess (ilMemberAccess: ILMemberAccess) =
|
||||
match ilMemberAccess with
|
||||
|
|
@ -2509,12 +2474,9 @@ let typeAccessOfFlags flags =
|
|||
let typeEncodingOfFlags flags =
|
||||
let f = (flags &&& 0x00030000)
|
||||
|
||||
if f = 0x00020000 then
|
||||
ILDefaultPInvokeEncoding.Auto
|
||||
elif f = 0x00010000 then
|
||||
ILDefaultPInvokeEncoding.Unicode
|
||||
else
|
||||
ILDefaultPInvokeEncoding.Ansi
|
||||
if f = 0x00020000 then ILDefaultPInvokeEncoding.Auto
|
||||
elif f = 0x00010000 then ILDefaultPInvokeEncoding.Unicode
|
||||
else ILDefaultPInvokeEncoding.Ansi
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
type ILTypeDefKind =
|
||||
|
|
@ -3613,32 +3575,20 @@ and rescopeILType scoref ty =
|
|||
| ILType.Boxed cr1 ->
|
||||
let cr2 = rescopeILTypeSpec scoref cr1
|
||||
|
||||
if cr1 === cr2 then
|
||||
ty
|
||||
else
|
||||
mkILBoxedType cr2
|
||||
if cr1 === cr2 then ty else mkILBoxedType cr2
|
||||
| ILType.Array (s, ety1) ->
|
||||
let ety2 = rescopeILType scoref ety1
|
||||
|
||||
if ety1 === ety2 then
|
||||
ty
|
||||
else
|
||||
ILType.Array(s, ety2)
|
||||
if ety1 === ety2 then ty else ILType.Array(s, ety2)
|
||||
| ILType.Value cr1 ->
|
||||
let cr2 = rescopeILTypeSpec scoref cr1
|
||||
|
||||
if cr1 === cr2 then
|
||||
ty
|
||||
else
|
||||
ILType.Value cr2
|
||||
if cr1 === cr2 then ty else ILType.Value cr2
|
||||
| ILType.Modified (b, tref, ty) -> ILType.Modified(b, rescopeILTypeRef scoref tref, rescopeILType scoref ty)
|
||||
| x -> x
|
||||
|
||||
and rescopeILTypes scoref i =
|
||||
if isNil i then
|
||||
i
|
||||
else
|
||||
List.mapq (rescopeILType scoref) i
|
||||
if isNil i then i else List.mapq (rescopeILType scoref) i
|
||||
|
||||
and rescopeILCallSig scoref csig =
|
||||
mkILCallSig (csig.CallingConv, rescopeILTypes scoref csig.ArgTypes, rescopeILType scoref csig.ReturnType)
|
||||
|
|
@ -3933,13 +3883,7 @@ let prependInstrsToCode (instrs: ILInstr list) (c2: ILCode) =
|
|||
let dict = Dictionary.newWithSize c2.Labels.Count
|
||||
|
||||
for kvp in c2.Labels do
|
||||
dict.Add(
|
||||
kvp.Key,
|
||||
if kvp.Value = 0 then
|
||||
0
|
||||
else
|
||||
kvp.Value + n
|
||||
)
|
||||
dict.Add(kvp.Key, (if kvp.Value = 0 then 0 else kvp.Value + n))
|
||||
|
||||
dict
|
||||
|
||||
|
|
@ -4013,22 +3957,10 @@ let mkILField (isStatic, nm, ty, init: ILFieldInit option, at: byte[] option, ac
|
|||
fieldType = ty,
|
||||
attributes =
|
||||
(convertFieldAccess access
|
||||
||| (if isStatic then
|
||||
FieldAttributes.Static
|
||||
else
|
||||
enum 0)
|
||||
||| (if isLiteral then
|
||||
FieldAttributes.Literal
|
||||
else
|
||||
enum 0)
|
||||
||| (if init.IsSome then
|
||||
FieldAttributes.HasDefault
|
||||
else
|
||||
enum 0)
|
||||
||| (if at.IsSome then
|
||||
FieldAttributes.HasFieldRVA
|
||||
else
|
||||
enum 0)),
|
||||
||| (if isStatic then FieldAttributes.Static else enum 0)
|
||||
||| (if isLiteral then FieldAttributes.Literal else enum 0)
|
||||
||| (if init.IsSome then FieldAttributes.HasDefault else enum 0)
|
||||
||| (if at.IsSome then FieldAttributes.HasFieldRVA else enum 0)),
|
||||
literalValue = init,
|
||||
data = at,
|
||||
offset = None,
|
||||
|
|
@ -4362,12 +4294,7 @@ let mkCtorMethSpecForDelegate (ilg: ILGlobals) (ty: ILType, useUIntPtr) =
|
|||
let argTys =
|
||||
[
|
||||
rescopeILType scoref ilg.typ_Object
|
||||
rescopeILType
|
||||
scoref
|
||||
(if useUIntPtr then
|
||||
ilg.typ_UIntPtr
|
||||
else
|
||||
ilg.typ_IntPtr)
|
||||
rescopeILType scoref (if useUIntPtr then ilg.typ_UIntPtr else ilg.typ_IntPtr)
|
||||
]
|
||||
|
||||
mkILInstanceMethSpecInTy (ty, ".ctor", argTys, ILType.Void, emptyILGenericArgsList)
|
||||
|
|
@ -5143,8 +5070,8 @@ let decodeILAttribData (ca: ILAttribute) =
|
|||
try
|
||||
let parser = ILTypeSigParser n
|
||||
parser.ParseTypeSpec(), sigptr
|
||||
with
|
||||
| exn -> failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" exn.Message)
|
||||
with exn ->
|
||||
failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" exn.Message)
|
||||
| ILType.Boxed tspec when tspec.Name = "System.Object" ->
|
||||
let et, sigptr = sigptr_get_u8 bytes sigptr
|
||||
|
||||
|
|
@ -5605,10 +5532,7 @@ and unscopeILType ty =
|
|||
| x -> x
|
||||
|
||||
and unscopeILTypes i =
|
||||
if List.isEmpty i then
|
||||
i
|
||||
else
|
||||
List.map unscopeILType i
|
||||
if List.isEmpty i then i else List.map unscopeILType i
|
||||
|
||||
and unscopeILCallSig csig =
|
||||
mkILCallSig (csig.CallingConv, unscopeILTypes csig.ArgTypes, unscopeILType csig.ReturnType)
|
||||
|
|
|
|||
|
|
@ -184,8 +184,8 @@ let cattr_ty2ty f (c: ILAttribute) =
|
|||
let elems = elems |> List.map (celem_ty2ty f)
|
||||
let namedArgs = namedArgs |> List.map (cnamedarg_ty2ty f)
|
||||
mkILCustomAttribMethRef (meth, elems, namedArgs)
|
||||
with
|
||||
| _ -> c.WithMethod(meth)
|
||||
with _ ->
|
||||
c.WithMethod(meth)
|
||||
else
|
||||
c.WithMethod(meth)
|
||||
|
||||
|
|
|
|||
|
|
@ -253,8 +253,8 @@ type COFFResourceReader() =
|
|||
|
||||
if int64 relocLastAddress > stream.Length then
|
||||
raise <| ResourceException "CoffResourceInvalidRelocation"
|
||||
with
|
||||
| :? OverflowException -> (raise <| ResourceException("CoffResourceInvalidRelocation"))
|
||||
with :? OverflowException ->
|
||||
(raise <| ResourceException("CoffResourceInvalidRelocation"))
|
||||
|
||||
let mutable relocationOffsets = Array.zeroCreate (int rsrc1.NumberOfRelocations)
|
||||
|
||||
|
|
@ -284,8 +284,8 @@ type COFFResourceReader() =
|
|||
|
||||
if lastSymAddress > stream.Length then
|
||||
raise <| ResourceException "CoffResourceInvalidSymbol"
|
||||
with
|
||||
| :? OverflowException -> (raise <| ResourceException("CoffResourceInvalidSymbol"))
|
||||
with :? OverflowException ->
|
||||
(raise <| ResourceException("CoffResourceInvalidSymbol"))
|
||||
|
||||
let mutable outputStream = new MemoryStream(imageResourceSectionBytes)
|
||||
let mutable writer = new BinaryWriter(outputStream)
|
||||
|
|
@ -400,10 +400,7 @@ type VersionHelper() =
|
|||
let mutable (values: uint16[]) = Array.zeroCreate 4
|
||||
|
||||
let mutable (lastExplicitValue: int) =
|
||||
if hasWildcard then
|
||||
elements.Length - 1
|
||||
else
|
||||
elements.Length
|
||||
if hasWildcard then elements.Length - 1 else elements.Length
|
||||
|
||||
let mutable (parseError: bool) = false
|
||||
let mutable earlyReturn = None
|
||||
|
|
@ -1147,19 +1144,12 @@ type NativeResourceWriter() =
|
|||
dataWriter.WriteByte 0uy
|
||||
|
||||
false
|
||||
| e ->
|
||||
failwithf
|
||||
"Unknown entry %s"
|
||||
(if isNull e then
|
||||
"<NULL>"
|
||||
else
|
||||
e.GetType().FullName)
|
||||
| e -> failwithf "Unknown entry %s" (if isNull e then "<NULL>" else e.GetType().FullName)
|
||||
|
||||
if id >= 0 then
|
||||
writer.WriteInt32 id
|
||||
else
|
||||
if name = Unchecked.defaultof<_> then
|
||||
name <- String.Empty
|
||||
if name = Unchecked.defaultof<_> then name <- String.Empty
|
||||
|
||||
writer.WriteUInt32(nameOffset ||| 0x80000000u)
|
||||
dataWriter.WriteUInt16(uint16 name.Length)
|
||||
|
|
|
|||
|
|
@ -661,20 +661,16 @@ let goutput_fdef _tref env os (fd: ILFieldDef) =
|
|||
output_member_access os fd.Access
|
||||
output_string os " "
|
||||
|
||||
if fd.IsStatic then
|
||||
output_string os " static "
|
||||
if fd.IsStatic then output_string os " static "
|
||||
|
||||
if fd.IsLiteral then
|
||||
output_string os " literal "
|
||||
if fd.IsLiteral then output_string os " literal "
|
||||
|
||||
if fd.IsSpecialName then
|
||||
output_string os " specialname rtspecialname "
|
||||
|
||||
if fd.IsInitOnly then
|
||||
output_string os " initonly "
|
||||
if fd.IsInitOnly then output_string os " initonly "
|
||||
|
||||
if fd.NotSerialized then
|
||||
output_string os " notserialized "
|
||||
if fd.NotSerialized then output_string os " notserialized "
|
||||
|
||||
goutput_typ env os fd.FieldType
|
||||
output_string os " "
|
||||
|
|
@ -744,8 +740,7 @@ let output_code_label os lab = output_string os (formatCodeLabel lab)
|
|||
let goutput_local env os (l: ILLocal) =
|
||||
goutput_typ env os l.Type
|
||||
|
||||
if l.IsPinned then
|
||||
output_string os " pinned"
|
||||
if l.IsPinned then output_string os " pinned"
|
||||
|
||||
let goutput_param env os (l: ILParameter) =
|
||||
match l.Name with
|
||||
|
|
@ -990,8 +985,7 @@ let rec goutput_instr env os inst =
|
|||
let rank = shape.Rank
|
||||
output_parens (output_array ", " (goutput_typ env)) os (Array.create rank PrimaryAssemblyILGlobals.typ_Int32)
|
||||
| I_ldelema (ro, _, shape, tok) ->
|
||||
if ro = ReadonlyAddress then
|
||||
output_string os "readonly. "
|
||||
if ro = ReadonlyAddress then output_string os "readonly. "
|
||||
|
||||
if shape = ILArrayShape.SingleDimensional then
|
||||
output_string os "ldelema "
|
||||
|
|
@ -1040,8 +1034,7 @@ let rec goutput_instr env os inst =
|
|||
| _ -> output_string os "<printing for this instruction is not implemented>"
|
||||
|
||||
let goutput_ilmbody env os (il: ILMethodBody) =
|
||||
if il.IsZeroInit then
|
||||
output_string os " .zeroinit\n"
|
||||
if il.IsZeroInit then output_string os " .zeroinit\n"
|
||||
|
||||
output_string os " .maxstack "
|
||||
output_i32 os il.MaxStack
|
||||
|
|
@ -1060,21 +1053,11 @@ let goutput_mbody is_entrypoint env os (md: ILMethodDef) =
|
|||
else
|
||||
output_string os "runtime "
|
||||
|
||||
output_string
|
||||
os
|
||||
(if md.IsInternalCall then
|
||||
"internalcall "
|
||||
else
|
||||
" ")
|
||||
output_string os (if md.IsInternalCall then "internalcall " else " ")
|
||||
|
||||
output_string os (if md.IsManaged then "managed " else " ")
|
||||
|
||||
output_string
|
||||
os
|
||||
(if md.IsForwardRef then
|
||||
"forwardref "
|
||||
else
|
||||
" ")
|
||||
output_string os (if md.IsForwardRef then "forwardref " else " ")
|
||||
|
||||
output_string os " \n{ \n"
|
||||
goutput_security_decls env os md.SecurityDecls
|
||||
|
|
@ -1084,8 +1067,7 @@ let goutput_mbody is_entrypoint env os (md: ILMethodDef) =
|
|||
| MethodBody.IL il -> goutput_ilmbody env os il.Value
|
||||
| _ -> ()
|
||||
|
||||
if is_entrypoint then
|
||||
output_string os " .entrypoint"
|
||||
if is_entrypoint then output_string os " .entrypoint"
|
||||
|
||||
output_string os "\n"
|
||||
output_string os "}\n"
|
||||
|
|
@ -1096,14 +1078,8 @@ let goutput_mdef env os (md: ILMethodDef) =
|
|||
"virtual "
|
||||
+ (if md.IsFinal then "final " else "")
|
||||
+ (if md.IsNewSlot then "newslot " else "")
|
||||
+ (if md.IsCheckAccessOnOverride then
|
||||
" strict "
|
||||
else
|
||||
"")
|
||||
+ (if md.IsAbstract then
|
||||
" abstract "
|
||||
else
|
||||
"")
|
||||
+ (if md.IsCheckAccessOnOverride then " strict " else "")
|
||||
+ (if md.IsAbstract then " abstract " else "")
|
||||
+ " "
|
||||
elif md.IsNonVirtualInstance then
|
||||
""
|
||||
|
|
@ -1136,14 +1112,8 @@ let goutput_mdef env os (md: ILMethodDef) =
|
|||
| PInvokeCharEncoding.Auto -> " autochar")
|
||||
+
|
||||
|
||||
(if attr.NoMangle then
|
||||
" nomangle"
|
||||
else
|
||||
"")
|
||||
+ (if attr.LastError then
|
||||
" lasterr"
|
||||
else
|
||||
"")
|
||||
(if attr.NoMangle then " nomangle" else "")
|
||||
+ (if attr.LastError then " lasterr" else "")
|
||||
+ ")"
|
||||
| _ -> "")
|
||||
elif md.IsClassInitializer then
|
||||
|
|
@ -1155,14 +1125,11 @@ let goutput_mdef env os (md: ILMethodDef) =
|
|||
let menv = ppenv_enter_method (List.length md.GenericParams) env
|
||||
output_string os " .method "
|
||||
|
||||
if md.IsHideBySig then
|
||||
output_string os "hidebysig "
|
||||
if md.IsHideBySig then output_string os "hidebysig "
|
||||
|
||||
if md.IsReqSecObj then
|
||||
output_string os "reqsecobj "
|
||||
if md.IsReqSecObj then output_string os "reqsecobj "
|
||||
|
||||
if md.IsSpecialName then
|
||||
output_string os "specialname "
|
||||
if md.IsSpecialName then output_string os "specialname "
|
||||
|
||||
if md.IsUnmanagedExport then
|
||||
output_string os "unmanagedexp "
|
||||
|
|
@ -1182,17 +1149,13 @@ let goutput_mdef env os (md: ILMethodDef) =
|
|||
(goutput_params menv) os md.Parameters
|
||||
output_string os " "
|
||||
|
||||
if md.IsSynchronized then
|
||||
output_string os "synchronized "
|
||||
if md.IsSynchronized then output_string os "synchronized "
|
||||
|
||||
if md.IsMustRun then
|
||||
output_string os "/* mustrun */ "
|
||||
if md.IsMustRun then output_string os "/* mustrun */ "
|
||||
|
||||
if md.IsPreserveSig then
|
||||
output_string os "preservesig "
|
||||
if md.IsPreserveSig then output_string os "preservesig "
|
||||
|
||||
if md.IsNoInline then
|
||||
output_string os "noinlining "
|
||||
if md.IsNoInline then output_string os "noinlining "
|
||||
|
||||
if md.IsAggressiveInline then
|
||||
output_string os "aggressiveinlining "
|
||||
|
|
@ -1292,17 +1255,13 @@ let rec goutput_tdef enc env contents os (cd: ILTypeDef) =
|
|||
output_string os layout_attr
|
||||
output_string os " "
|
||||
|
||||
if cd.IsSealed then
|
||||
output_string os "sealed "
|
||||
if cd.IsSealed then output_string os "sealed "
|
||||
|
||||
if cd.IsAbstract then
|
||||
output_string os "abstract "
|
||||
if cd.IsAbstract then output_string os "abstract "
|
||||
|
||||
if cd.IsSerializable then
|
||||
output_string os "serializable "
|
||||
if cd.IsSerializable then output_string os "serializable "
|
||||
|
||||
if cd.IsComInterop then
|
||||
output_string os "import "
|
||||
if cd.IsComInterop then output_string os "import "
|
||||
|
||||
output_sqstring os cd.Name
|
||||
goutput_gparams env os cd.GenericParams
|
||||
|
|
@ -1380,8 +1339,7 @@ let output_assemblyRef os (aref: ILAssemblyRef) =
|
|||
output_string os " .assembly extern "
|
||||
output_sqstring os aref.Name
|
||||
|
||||
if aref.Retargetable then
|
||||
output_string os " retargetable "
|
||||
if aref.Retargetable then output_string os " retargetable "
|
||||
|
||||
output_string os " { "
|
||||
output_option output_hash os aref.Hash
|
||||
|
|
@ -1470,10 +1428,7 @@ let goutput_module_manifest env os modul =
|
|||
os
|
||||
((if modul.IsILOnly then 0x0001 else 0)
|
||||
||| (if modul.Is32Bit then 0x0002 else 0)
|
||||
||| (if modul.Is32BitPreferred then
|
||||
0x00020003
|
||||
else
|
||||
0))
|
||||
||| (if modul.Is32BitPreferred then 0x00020003 else 0))
|
||||
|
||||
List.iter (fun r -> goutput_resource env os r) (modul.Resources.AsList())
|
||||
output_string os "\n"
|
||||
|
|
|
|||
|
|
@ -41,15 +41,15 @@ let _ =
|
|||
let noStableFileHeuristic =
|
||||
try
|
||||
(Environment.GetEnvironmentVariable("FSharp_NoStableFileHeuristic") <> null)
|
||||
with
|
||||
| _ -> false
|
||||
with _ ->
|
||||
false
|
||||
|
||||
let alwaysMemoryMapFSC =
|
||||
try
|
||||
(Environment.GetEnvironmentVariable("FSharp_AlwaysMemoryMapCommandLineCompiler")
|
||||
<> null)
|
||||
with
|
||||
| _ -> false
|
||||
with _ ->
|
||||
false
|
||||
|
||||
let stronglyHeldReaderCacheSizeDefault = 30
|
||||
|
||||
|
|
@ -58,8 +58,8 @@ let stronglyHeldReaderCacheSize =
|
|||
(match Environment.GetEnvironmentVariable("FSharp_StronglyHeldBinaryReaderCacheSize") with
|
||||
| null -> stronglyHeldReaderCacheSizeDefault
|
||||
| s -> int32 s)
|
||||
with
|
||||
| _ -> stronglyHeldReaderCacheSizeDefault
|
||||
with _ ->
|
||||
stronglyHeldReaderCacheSizeDefault
|
||||
|
||||
let singleOfBits (x: int32) =
|
||||
BitConverter.ToSingle(BitConverter.GetBytes x, 0)
|
||||
|
|
@ -101,12 +101,9 @@ let uncodedTokenToTypeDefOrRefOrSpec (tab, tok) =
|
|||
|
||||
let uncodedTokenToMethodDefOrRef (tab, tok) =
|
||||
let tag =
|
||||
if tab = TableNames.Method then
|
||||
mdor_MethodDef
|
||||
elif tab = TableNames.MemberRef then
|
||||
mdor_MemberRef
|
||||
else
|
||||
failwith "bad table in uncodedTokenToMethodDefOrRef"
|
||||
if tab = TableNames.Method then mdor_MethodDef
|
||||
elif tab = TableNames.MemberRef then mdor_MemberRef
|
||||
else failwith "bad table in uncodedTokenToMethodDefOrRef"
|
||||
|
||||
TaggedIndex(tag, tok)
|
||||
|
||||
|
|
@ -1382,8 +1379,7 @@ let seekReadGuidIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadId
|
|||
let seekReadBlobIdx (ctxt: ILMetadataReader) mdv (addr: byref<int>) = seekReadIdx ctxt.blobsBigness mdv &addr
|
||||
|
||||
let seekReadModuleRow (ctxt: ILMetadataReader) mdv idx =
|
||||
if idx = 0 then
|
||||
failwith "cannot read Module table row 0"
|
||||
if idx = 0 then failwith "cannot read Module table row 0"
|
||||
|
||||
let mutable addr = ctxt.rowAddr TableNames.Module idx
|
||||
let generation = seekReadUInt16Adv mdv &addr
|
||||
|
|
@ -1695,10 +1691,7 @@ let readStringHeapUncached ctxtH idx =
|
|||
let readStringHeap (ctxt: ILMetadataReader) idx = ctxt.readStringHeap idx
|
||||
|
||||
let readStringHeapOption (ctxt: ILMetadataReader) idx =
|
||||
if idx = 0 then
|
||||
None
|
||||
else
|
||||
Some(readStringHeap ctxt idx)
|
||||
if idx = 0 then None else Some(readStringHeap ctxt idx)
|
||||
|
||||
let readBlobHeapUncached ctxtH idx =
|
||||
let (ctxt: ILMetadataReader) = getHole ctxtH
|
||||
|
|
@ -1713,10 +1706,7 @@ let readBlobHeapUncached ctxtH idx =
|
|||
let readBlobHeap (ctxt: ILMetadataReader) idx = ctxt.readBlobHeap idx
|
||||
|
||||
let readBlobHeapOption ctxt idx =
|
||||
if idx = 0 then
|
||||
None
|
||||
else
|
||||
Some(readBlobHeap ctxt idx)
|
||||
if idx = 0 then None else Some(readBlobHeap ctxt idx)
|
||||
|
||||
//let readGuidHeap ctxt idx = seekReadGuid ctxt.mdv (ctxt.guidsStreamPhysicalLoc + idx)
|
||||
|
||||
|
|
@ -2210,14 +2200,10 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx (numTypars, a, b)) =
|
|||
let variance_flags = flags &&& 0x0003
|
||||
|
||||
let variance =
|
||||
if variance_flags = 0x0000 then
|
||||
NonVariant
|
||||
elif variance_flags = 0x0001 then
|
||||
CoVariant
|
||||
elif variance_flags = 0x0002 then
|
||||
ContraVariant
|
||||
else
|
||||
NonVariant
|
||||
if variance_flags = 0x0000 then NonVariant
|
||||
elif variance_flags = 0x0001 then CoVariant
|
||||
elif variance_flags = 0x0002 then ContraVariant
|
||||
else NonVariant
|
||||
|
||||
let constraints = seekReadGenericParamConstraints ctxt mdv numTypars gpidx
|
||||
|
||||
|
|
@ -2522,16 +2508,7 @@ and sigptrGetTy (ctxt: ILMetadataReader) numTypars bytes sigptr =
|
|||
let struct (n, sigptr) = sigptrGetZInt32 bytes sigptr
|
||||
let argTys, sigptr = sigptrFold (sigptrGetTy ctxt numTypars) n bytes sigptr
|
||||
|
||||
seekReadTypeDefOrRef
|
||||
ctxt
|
||||
numTypars
|
||||
(if b0 = et_CLASS then
|
||||
AsObject
|
||||
else
|
||||
AsValue)
|
||||
argTys
|
||||
tdorIdx,
|
||||
sigptr
|
||||
seekReadTypeDefOrRef ctxt numTypars (if b0 = et_CLASS then AsObject else AsValue) argTys tdorIdx, sigptr
|
||||
|
||||
elif b0 = et_CLASS then
|
||||
let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr
|
||||
|
|
@ -2570,10 +2547,7 @@ and sigptrGetTy (ctxt: ILMetadataReader) numTypars bytes sigptr =
|
|||
Some(List.item i lobounds)
|
||||
else
|
||||
None),
|
||||
(if i < numSized then
|
||||
Some(List.item i sizes)
|
||||
else
|
||||
None)
|
||||
(if i < numSized then Some(List.item i sizes) else None)
|
||||
|
||||
ILArrayShape(List.init rank dim)
|
||||
|
||||
|
|
@ -2591,8 +2565,7 @@ and sigptrGetTy (ctxt: ILMetadataReader) numTypars bytes sigptr =
|
|||
let ccByte, sigptr = sigptrGetByte bytes sigptr
|
||||
let generic, cc = byteAsCallConv ccByte
|
||||
|
||||
if generic then
|
||||
failwith "fptr sig may not be generic"
|
||||
if generic then failwith "fptr sig may not be generic"
|
||||
|
||||
let struct (numparams, sigptr) = sigptrGetZInt32 bytes sigptr
|
||||
let retTy, sigptr = sigptrGetTy ctxt numTypars bytes sigptr
|
||||
|
|
@ -2632,10 +2605,7 @@ and sigptrGetLocal (ctxt: ILMetadataReader) numTypars bytes sigptr =
|
|||
let pinned, sigptr =
|
||||
let b0, sigptr' = sigptrGetByte bytes sigptr
|
||||
|
||||
if b0 = et_PINNED then
|
||||
true, sigptr'
|
||||
else
|
||||
false, sigptr
|
||||
if b0 = et_PINNED then true, sigptr' else false, sigptr
|
||||
|
||||
let ty, sigptr = sigptrGetTy ctxt numTypars bytes sigptr
|
||||
|
||||
|
|
@ -2844,12 +2814,9 @@ and seekReadMethodDefAsMethodDataUncached ctxtH idx =
|
|||
(fun i -> i, seekReadTypeDefRowWithExtents ctxt i),
|
||||
(fun r -> r),
|
||||
(fun (_, ((_, _, _, _, _, methodsIdx), (_, endMethodsIdx))) ->
|
||||
if endMethodsIdx <= idx then
|
||||
1
|
||||
elif methodsIdx <= idx && idx < endMethodsIdx then
|
||||
0
|
||||
else
|
||||
-1),
|
||||
if endMethodsIdx <= idx then 1
|
||||
elif methodsIdx <= idx && idx < endMethodsIdx then 0
|
||||
else -1),
|
||||
true,
|
||||
fst
|
||||
)
|
||||
|
|
@ -2895,12 +2862,9 @@ and seekReadFieldDefAsFieldSpecUncached ctxtH idx =
|
|||
(fun i -> i, seekReadTypeDefRowWithExtents ctxt i),
|
||||
(fun r -> r),
|
||||
(fun (_, ((_, _, _, _, fieldsIdx, _), (endFieldsIdx, _))) ->
|
||||
if endFieldsIdx <= idx then
|
||||
1
|
||||
elif fieldsIdx <= idx && idx < endFieldsIdx then
|
||||
0
|
||||
else
|
||||
-1),
|
||||
if endFieldsIdx <= idx then 1
|
||||
elif fieldsIdx <= idx && idx < endFieldsIdx then 0
|
||||
else -1),
|
||||
true,
|
||||
fst
|
||||
)
|
||||
|
|
@ -3619,10 +3583,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numTypars (sz: int) start s
|
|||
dprintn (
|
||||
"invalid instruction: "
|
||||
+ string lastb
|
||||
+ (if lastb = 0xfe then
|
||||
", " + string lastb2
|
||||
else
|
||||
"")
|
||||
+ (if lastb = 0xfe then ", " + string lastb2 else "")
|
||||
)
|
||||
|
||||
I_ret
|
||||
|
|
@ -3719,8 +3680,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int
|
|||
let isFatFormat = (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_FatFormat
|
||||
|
||||
if not isTinyFormat && not isFatFormat then
|
||||
if logging then
|
||||
failwith "unknown format"
|
||||
if logging then failwith "unknown format"
|
||||
|
||||
MethodBody.Abstract
|
||||
else
|
||||
|
|
@ -3804,8 +3764,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int
|
|||
[] (* <REVIEW> scopes fail for mscorlib </REVIEW> scopes rootScope *)
|
||||
// REVIEW: look through sps to get ranges? Use GetRanges?? Change AbsIL??
|
||||
(localPdbInfos, None, seqpoints)
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
// "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message
|
||||
[], None, []
|
||||
#endif
|
||||
|
|
@ -3965,8 +3924,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int
|
|||
nextSectionBase <- sectionBase + sectionSize
|
||||
|
||||
// Convert the linear code format to the nested code format
|
||||
if logging then
|
||||
dprintn "doing localPdbInfos2"
|
||||
if logging then dprintn "doing localPdbInfos2"
|
||||
|
||||
let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos
|
||||
|
||||
|
|
@ -3975,8 +3933,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (idx, nm, _int
|
|||
|
||||
let code = buildILCode nm lab2pc instrs seh localPdbInfos2
|
||||
|
||||
if logging then
|
||||
dprintn "done checking code."
|
||||
if logging then dprintn "done checking code."
|
||||
|
||||
{
|
||||
IsZeroInit = initlocals
|
||||
|
|
@ -4222,8 +4179,7 @@ let getPdbReader pdbDirPath fileName =
|
|||
| _ -> failwith ("Document with URL " + url + " not found in list of documents in the PDB file")
|
||||
|
||||
Some(pdbr, docfun)
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
dprintn ("* Warning: PDB file could not be read and will be ignored: " + e.Message)
|
||||
None
|
||||
#endif
|
||||
|
|
@ -5111,8 +5067,8 @@ let stableFileHeuristicApplies fileName =
|
|||
not noStableFileHeuristic
|
||||
&& try
|
||||
FileSystem.IsStableFileHeuristic fileName
|
||||
with
|
||||
| _ -> false
|
||||
with _ ->
|
||||
false
|
||||
|
||||
let createByteFileChunk opts fileName chunk =
|
||||
// If we're trying to reduce memory usage then we are willing to go back and re-read the binary, so we can use
|
||||
|
|
@ -5184,8 +5140,7 @@ let OpenILModuleReader fileName opts =
|
|||
ILModuleReaderCacheKey(fullPath, writeTime, opts.pdbDirPath.IsSome, opts.reduceMemoryUsage, opts.metadataOnly)
|
||||
|
||||
key, true
|
||||
with
|
||||
| exn ->
|
||||
with exn ->
|
||||
Debug.Assert(
|
||||
false,
|
||||
sprintf
|
||||
|
|
|
|||
|
|
@ -646,8 +646,8 @@ let envUpdateCreatedTypeRef emEnv (tref: ILTypeRef) =
|
|||
try
|
||||
System.Runtime.Serialization.FormatterServices.GetUninitializedObject ty
|
||||
|> ignore
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
#endif
|
||||
{ emEnv with
|
||||
emTypMap = Zmap.add tref (typT, typB, typeDef, Some ty) emEnv.emTypMap
|
||||
|
|
@ -1101,11 +1101,7 @@ let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) : MethodInfo =
|
|||
|
||||
let stat = mref.CallingConv.IsStatic
|
||||
|
||||
let cconv =
|
||||
(if stat then
|
||||
BindingFlags.Static
|
||||
else
|
||||
BindingFlags.Instance)
|
||||
let cconv = (if stat then BindingFlags.Static else BindingFlags.Instance)
|
||||
|
||||
let methInfo =
|
||||
try
|
||||
|
|
@ -1117,8 +1113,8 @@ let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) : MethodInfo =
|
|||
(null: ParameterModifier[])
|
||||
)
|
||||
// This can fail if there is an ambiguity w.r.t. return type
|
||||
with
|
||||
| _ -> null
|
||||
with _ ->
|
||||
null
|
||||
|
||||
if (isNotNull methInfo && equalTypes resT methInfo.ReturnType) then
|
||||
methInfo
|
||||
|
|
@ -2568,8 +2564,7 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t
|
|||
|
||||
match emEnv.emTypMap.TryFind typeRef with
|
||||
| Some (_, tb, _, _) ->
|
||||
if not (tb.IsCreated()) then
|
||||
tb.CreateTypeAndLog() |> ignore
|
||||
if not (tb.IsCreated()) then tb.CreateTypeAndLog() |> ignore
|
||||
|
||||
tb.Assembly
|
||||
| None -> null)
|
||||
|
|
@ -2595,8 +2590,7 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t
|
|||
traverseTypeRef tref
|
||||
|
||||
let rec buildTypeDefPass4 (visited, created) nesting emEnv (tdef: ILTypeDef) =
|
||||
if verbose2 then
|
||||
dprintf "buildTypeDefPass4 %s\n" tdef.Name
|
||||
if verbose2 then dprintf "buildTypeDefPass4 %s\n" tdef.Name
|
||||
|
||||
let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef)
|
||||
createTypeRef (visited, created) emEnv tref
|
||||
|
|
@ -2759,8 +2753,8 @@ let EmitDynamicAssemblyFragment
|
|||
try
|
||||
ignore (typB.InvokeMemberAndLog(methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static, [||]))
|
||||
None
|
||||
with
|
||||
| :? TargetInvocationException as exn -> Some exn.InnerException
|
||||
with :? TargetInvocationException as exn ->
|
||||
Some exn.InnerException
|
||||
|
||||
let emEnv, entryPts = envPopEntryPts emEnv
|
||||
let execs = List.map execEntryPtFun entryPts
|
||||
|
|
|
|||
|
|
@ -221,28 +221,14 @@ let toCLRKeyBlob (rsaParameters: RSAParameters) (algId: int) : byte[] =
|
|||
bw.Write(int (modulusLength + BLOBHEADER_LENGTH)) // CLRHeader.KeyLength
|
||||
|
||||
// Write out the BLOBHEADER
|
||||
bw.Write(
|
||||
byte (
|
||||
if isPrivate = true then
|
||||
PRIVATEKEYBLOB
|
||||
else
|
||||
PUBLICKEYBLOB
|
||||
)
|
||||
) // BLOBHEADER.bType
|
||||
bw.Write(byte (if isPrivate = true then PRIVATEKEYBLOB else PUBLICKEYBLOB)) // BLOBHEADER.bType
|
||||
|
||||
bw.Write(byte BLOBHEADER_CURRENT_BVERSION) // BLOBHEADER.bVersion
|
||||
bw.Write(int16 0) // BLOBHEADER.wReserved
|
||||
bw.Write(int CALG_RSA_SIGN) // BLOBHEADER.aiKeyAlg
|
||||
|
||||
// Write the RSAPubKey header
|
||||
bw.Write(
|
||||
int (
|
||||
if isPrivate then
|
||||
RSA_PRIV_MAGIC
|
||||
else
|
||||
RSA_PUB_MAGIC
|
||||
)
|
||||
) // RSAPubKey.magic
|
||||
bw.Write(int (if isPrivate then RSA_PRIV_MAGIC else RSA_PUB_MAGIC)) // RSAPubKey.magic
|
||||
|
||||
bw.Write(int (modulusLength * 8)) // RSAPubKey.bitLen
|
||||
|
||||
|
|
@ -580,10 +566,7 @@ let legacySignerCloseKeyContainer kc =
|
|||
|
||||
let legacySignerSignatureSize (pk: byte[]) =
|
||||
if runningOnMono then
|
||||
if pk.Length > 32 then
|
||||
pk.Length - 32
|
||||
else
|
||||
128
|
||||
if pk.Length > 32 then pk.Length - 32 else 128
|
||||
else
|
||||
let mutable pSize = 0u
|
||||
let iclrSN = getICLRStrongName ()
|
||||
|
|
@ -704,8 +687,7 @@ type ILStrongNameSigner =
|
|||
let pkSignatureSize pk =
|
||||
try
|
||||
signerSignatureSize pk
|
||||
with
|
||||
| exn ->
|
||||
with exn ->
|
||||
failwith ("A call to StrongNameSignatureSize failed (" + exn.Message + ")")
|
||||
0x80
|
||||
|
||||
|
|
|
|||
|
|
@ -611,8 +611,7 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink
|
|||
let bNil = Bytes.zeroCreate 3
|
||||
|
||||
// Align remaining fields on DWORD (nb. poor bit twiddling code taken from ildasm's dres.cpp)
|
||||
if (dwFiller &&& 0x1) <> 0 then
|
||||
SaveChunk(bNil, 2)
|
||||
if (dwFiller &&& 0x1) <> 0 then SaveChunk(bNil, 2)
|
||||
|
||||
//---- Constant part of the header: DWORD, WORD, WORD, DWORD, DWORD
|
||||
SaveChunk(dwToBytes resHdr.DataVersion)
|
||||
|
|
@ -628,8 +627,7 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink
|
|||
|
||||
dwFiller <- dataEntry.Size &&& 0x3
|
||||
|
||||
if dwFiller <> 0 then
|
||||
SaveChunk(bNil, 4 - dwFiller)
|
||||
if dwFiller <> 0 then SaveChunk(bNil, 4 - dwFiller)
|
||||
|
||||
size
|
||||
|
||||
|
|
@ -1039,8 +1037,8 @@ let pdbClose (writer: PdbWriter) dllFilename pdbFilename =
|
|||
FileSystem.OpenFileForWriteShim(fileName, FileMode.Open, FileAccess.ReadWrite, FileShare.None)
|
||||
|
||||
false
|
||||
with
|
||||
| _ -> true
|
||||
with _ ->
|
||||
true
|
||||
|
||||
let mutable attempts = 0
|
||||
|
||||
|
|
@ -1072,8 +1070,8 @@ let internal setCheckSum (url: string, writer: ISymUnmanagedDocumentWriter) =
|
|||
|
||||
if (checkSum.Length = hashSizeOfMD5) then
|
||||
writer.SetCheckSum(guidSourceHashMD5, hashSizeOfMD5, checkSum)
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
let pdbDefineDocument (writer: PdbWriter) (url: string) =
|
||||
//3F5162F8-07C6-11D3-9053-00C04FA302A1
|
||||
|
|
@ -1204,8 +1202,8 @@ let pdbReadOpen (moduleName: string) (path: string) : PdbReader =
|
|||
)
|
||||
|
||||
{ symReader = reader :?> ISymbolReader }
|
||||
with
|
||||
| _ -> { symReader = null }
|
||||
with _ ->
|
||||
{ symReader = null }
|
||||
#else
|
||||
let symbolBinder = new System.Diagnostics.SymbolStore.SymBinder()
|
||||
|
||||
|
|
|
|||
|
|
@ -768,17 +768,16 @@ and GetTypeDescAsTypeRefIdx cenv (scoref, enc, n) =
|
|||
GetTypeRefAsTypeRefIdx cenv (mkILNestedTyRef (scoref, enc, n))
|
||||
|
||||
and GetResolutionScopeAsElem cenv (scoref, enc) =
|
||||
if isNil enc then
|
||||
match List.tryFrontAndBack enc with
|
||||
| None ->
|
||||
match scoref with
|
||||
| ILScopeRef.Local -> (rs_Module, 1)
|
||||
| ILScopeRef.Assembly aref -> (rs_AssemblyRef, GetAssemblyRefAsIdx cenv aref)
|
||||
| ILScopeRef.Module mref -> (rs_ModuleRef, GetModuleRefAsIdx cenv mref)
|
||||
| ILScopeRef.PrimaryAssembly -> (rs_AssemblyRef, GetAssemblyRefAsIdx cenv cenv.ilg.primaryAssemblyRef)
|
||||
else
|
||||
let enc2, n2 = List.frontAndBack enc
|
||||
| Some (enc2, n2) ->
|
||||
(rs_TypeRef, GetTypeDescAsTypeRefIdx cenv (scoref, enc2, n2))
|
||||
|
||||
|
||||
let getTypeInfoAsTypeDefOrRefEncoded cenv (scoref, enc, nm) =
|
||||
if isScopeRefLocal scoref then
|
||||
let idx = GetIdxForTypeDef cenv (TdKey(enc, nm))
|
||||
|
|
|
|||
|
|
@ -130,10 +130,7 @@ module SequencePoint =
|
|||
else
|
||||
let c1 = compare sp1.Line sp2.Line
|
||||
|
||||
if c1 <> 0 then
|
||||
c1
|
||||
else
|
||||
compare sp1.Column sp2.Column
|
||||
if c1 <> 0 then c1 else compare sp1.Column sp2.Column
|
||||
|
||||
let orderByOffset sp1 sp2 = compare sp1.Offset sp2.Offset
|
||||
|
||||
|
|
@ -184,8 +181,8 @@ let checkSum (url: string) (checksumAlgorithm: HashAlgorithm) =
|
|||
|
||||
let checkSum = alg.ComputeHash file
|
||||
Some(guid, checkSum)
|
||||
with
|
||||
| _ -> None
|
||||
with _ ->
|
||||
None
|
||||
|
||||
//---------------------------------------------------------------------
|
||||
// Portable PDB Writer
|
||||
|
|
@ -377,11 +374,7 @@ type PortablePdbGenerator
|
|||
|
||||
let s1, s2 = '/', '\\'
|
||||
|
||||
let separator =
|
||||
if (count name s1) >= (count name s2) then
|
||||
s1
|
||||
else
|
||||
s2
|
||||
let separator = if (count name s1) >= (count name s2) then s1 else s2
|
||||
|
||||
let writer = BlobBuilder()
|
||||
writer.WriteByte(byte separator)
|
||||
|
|
@ -445,12 +438,7 @@ type PortablePdbGenerator
|
|||
let documentIndex =
|
||||
let mutable index = Dictionary<string, DocumentHandle>(docs.Length)
|
||||
|
||||
let docLength =
|
||||
docs.Length
|
||||
+ if String.IsNullOrEmpty sourceLink then
|
||||
1
|
||||
else
|
||||
0
|
||||
let docLength = docs.Length + if String.IsNullOrEmpty sourceLink then 1 else 0
|
||||
|
||||
metadata.SetCapacity(TableIndex.Document, docLength)
|
||||
|
||||
|
|
@ -935,14 +923,14 @@ let writePdbInfo showTimes outfile pdbfile info cvChunk =
|
|||
|
||||
try
|
||||
FileSystem.FileDeleteShim pdbfile
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
let pdbw =
|
||||
try
|
||||
pdbInitialize outfile pdbfile
|
||||
with
|
||||
| _ -> error (Error(FSComp.SR.ilwriteErrorCreatingPdb pdbfile, rangeCmdArgs))
|
||||
with _ ->
|
||||
error (Error(FSComp.SR.ilwriteErrorCreatingPdb pdbfile, rangeCmdArgs))
|
||||
|
||||
match info.EntryPoint with
|
||||
| None -> ()
|
||||
|
|
@ -1020,16 +1008,14 @@ let writePdbInfo showTimes outfile pdbfile info cvChunk =
|
|||
| Some p -> sco.StartOffset <> p.StartOffset || sco.EndOffset <> p.EndOffset
|
||||
| None -> true
|
||||
|
||||
if nested then
|
||||
pdbOpenScope pdbw sco.StartOffset
|
||||
if nested then pdbOpenScope pdbw sco.StartOffset
|
||||
|
||||
sco.Locals
|
||||
|> Array.iter (fun v -> pdbDefineLocalVariable pdbw v.Name v.Signature v.Index)
|
||||
|
||||
sco.Children |> Array.iter (writePdbScope (if nested then Some sco else parent))
|
||||
|
||||
if nested then
|
||||
pdbCloseScope pdbw sco.EndOffset)
|
||||
if nested then pdbCloseScope pdbw sco.EndOffset)
|
||||
|
||||
match minfo.RootScope with
|
||||
| None -> ()
|
||||
|
|
@ -1119,16 +1105,16 @@ let writeMdbInfo fmdb f info =
|
|||
// Note, if we can't delete it code will fail later
|
||||
try
|
||||
FileSystem.FileDeleteShim fmdb
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
// Try loading the MDB symbol writer from an assembly available on Mono dynamically
|
||||
// Report an error if the assembly is not available.
|
||||
let wr =
|
||||
try
|
||||
createWriter f
|
||||
with
|
||||
| _ -> error (Error(FSComp.SR.ilwriteErrorCreatingMdb (), rangeCmdArgs))
|
||||
with _ ->
|
||||
error (Error(FSComp.SR.ilwriteErrorCreatingMdb (), rangeCmdArgs))
|
||||
|
||||
// NOTE: MonoSymbolWriter doesn't need information about entrypoints, so 'info.EntryPoint' is unused here.
|
||||
// Write information about Documents. Returns '(SourceFileEntry*CompileUnitEntry)[]'
|
||||
|
|
|
|||
|
|
@ -10,10 +10,7 @@ let mkLowerName (nm: string) =
|
|||
// Use the lower case name of a field or constructor as the field/parameter name if it differs from the uppercase name
|
||||
let lowerName = String.uncapitalize nm
|
||||
|
||||
if lowerName = nm then
|
||||
"_" + nm
|
||||
else
|
||||
lowerName
|
||||
if lowerName = nm then "_" + nm else lowerName
|
||||
|
||||
[<Sealed>]
|
||||
type IlxUnionCaseField(fd: ILFieldDef) =
|
||||
|
|
|
|||
|
|
@ -150,11 +150,9 @@ let mkDerefThis g m (thisv: Val) thise =
|
|||
else thise
|
||||
|
||||
let mkCompareTestConjuncts g m exprs =
|
||||
match exprs with
|
||||
| [] -> mkZero g m
|
||||
| [h] -> h
|
||||
| l ->
|
||||
let a, b = List.frontAndBack l
|
||||
match List.tryFrontAndBack exprs with
|
||||
| None -> mkZero g m
|
||||
| Some (a,b) ->
|
||||
(a, b) ||> List.foldBack (fun e acc ->
|
||||
let nv, ne = mkCompGenLocal m "n" g.int_ty
|
||||
mkCompGenLet m nv e
|
||||
|
|
@ -167,11 +165,9 @@ let mkCompareTestConjuncts g m exprs =
|
|||
acc)))
|
||||
|
||||
let mkEqualsTestConjuncts g m exprs =
|
||||
match exprs with
|
||||
| [] -> mkOne g m
|
||||
| [h] -> h
|
||||
| l ->
|
||||
let a, b = List.frontAndBack l
|
||||
match List.tryFrontAndBack exprs with
|
||||
| None -> mkOne g m
|
||||
| Some (a,b) ->
|
||||
List.foldBack (fun e acc -> mkCond DebugPointAtBinding.NoneAtSticky m g.bool_ty e acc (mkFalse g m)) a b
|
||||
|
||||
let mkMinimalTy (g: TcGlobals) (tcref: TyconRef) =
|
||||
|
|
|
|||
|
|
@ -5816,16 +5816,17 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env
|
|||
warning(Error(FSComp.SR.tcAttributeAutoOpenWasIgnored(p, ccu.AssemblyName), scopem))
|
||||
[], env
|
||||
let p = splitNamespace p
|
||||
if isNil p then warn() else
|
||||
let h, t = List.frontAndBack p
|
||||
let modref = mkNonLocalTyconRef (mkNonLocalEntityRef ccu (Array.ofList h)) t
|
||||
match modref.TryDeref with
|
||||
| ValueNone -> warn()
|
||||
| ValueSome _ ->
|
||||
let openTarget = SynOpenDeclTarget.ModuleOrNamespace([], scopem)
|
||||
let openDecl = OpenDeclaration.Create (openTarget, [modref], [], scopem, false)
|
||||
let envinner = OpenModuleOrNamespaceRefs TcResultsSink.NoSink g amap scopem root env [modref] openDecl
|
||||
[openDecl], envinner
|
||||
match List.tryFrontAndBack p with
|
||||
| None -> warn()
|
||||
| Some (h, t) ->
|
||||
let modref = mkNonLocalTyconRef (mkNonLocalEntityRef ccu (Array.ofList h)) t
|
||||
match modref.TryDeref with
|
||||
| ValueNone -> warn()
|
||||
| ValueSome _ ->
|
||||
let openTarget = SynOpenDeclTarget.ModuleOrNamespace([], scopem)
|
||||
let openDecl = OpenDeclaration.Create (openTarget, [modref], [], scopem, false)
|
||||
let envinner = OpenModuleOrNamespaceRefs TcResultsSink.NoSink g amap scopem root env [modref] openDecl
|
||||
[openDecl], envinner
|
||||
|
||||
// Add the CCU and apply the "AutoOpen" attributes
|
||||
let AddCcuToTcEnv (g, amap, scopem, env, assemblyName, ccu, autoOpens, internalsVisibleToAttributes) =
|
||||
|
|
|
|||
|
|
@ -8571,10 +8571,11 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) =
|
|||
|
||||
|
||||
let CodegenAssembly cenv eenv mgbuf implFiles =
|
||||
if not (isNil implFiles) then
|
||||
let a, b = List.frontAndBack implFiles
|
||||
let eenv = List.fold (GenImplFile cenv mgbuf None) eenv a
|
||||
let eenv = GenImplFile cenv mgbuf cenv.options.mainMethodInfo eenv b
|
||||
match List.tryFrontAndBack implFiles with
|
||||
| None -> ()
|
||||
| Some (firstImplFiles, lastImplFile) ->
|
||||
let eenv = List.fold (GenImplFile cenv mgbuf None) eenv firstImplFiles
|
||||
let eenv = GenImplFile cenv mgbuf cenv.options.mainMethodInfo eenv lastImplFile
|
||||
|
||||
// Some constructs generate residue types and bindings. Generate these now. They don't result in any
|
||||
// top-level initialization code.
|
||||
|
|
|
|||
|
|
@ -8,37 +8,41 @@ open FSharp.Compiler.AbstractIL.IL
|
|||
// Helpers for generating binary blobs
|
||||
module BinaryGenerationUtilities =
|
||||
// Little-endian encoding of int32
|
||||
let b0 n = byte (n &&& 0xFF)
|
||||
let b1 n = byte ((n >>> 8) &&& 0xFF)
|
||||
let b2 n = byte ((n >>> 16) &&& 0xFF)
|
||||
let b3 n = byte ((n >>> 24) &&& 0xFF)
|
||||
let b0 n = byte (n &&& 0xFF)
|
||||
let b1 n = byte ((n >>> 8) &&& 0xFF)
|
||||
let b2 n = byte ((n >>> 16) &&& 0xFF)
|
||||
let b3 n = byte ((n >>> 24) &&& 0xFF)
|
||||
|
||||
let i16 (i: int32) = [| b0 i; b1 i |]
|
||||
let i32 (i: int32) = [| b0 i; b1 i; b2 i; b3 i |]
|
||||
|
||||
// Emit the bytes and pad to a 32-bit alignment
|
||||
let Padded initialAlignment (v: byte[]) =
|
||||
[| yield! v
|
||||
for _ in 1..(4 - (initialAlignment + v.Length) % 4) % 4 do
|
||||
yield 0x0uy |]
|
||||
[|
|
||||
yield! v
|
||||
for _ in 1 .. (4 - (initialAlignment + v.Length) % 4) % 4 do
|
||||
0x0uy
|
||||
|]
|
||||
|
||||
// Generate nodes in a .res file format. These are then linked by Abstract IL using linkNativeResources
|
||||
module ResFileFormat =
|
||||
open BinaryGenerationUtilities
|
||||
|
||||
let ResFileNode(dwTypeID, dwNameID, wMemFlags, wLangID, data: byte[]) =
|
||||
[| yield! i32 data.Length // DWORD ResHdr.dwDataSize
|
||||
yield! i32 0x00000020 // dwHeaderSize
|
||||
yield! i32 ((dwTypeID <<< 16) ||| 0x0000FFFF) // dwTypeID, sizeof(DWORD)
|
||||
yield! i32 ((dwNameID <<< 16) ||| 0x0000FFFF) // dwNameID, sizeof(DWORD)
|
||||
yield! i32 0x00000000 // DWORD dwDataVersion
|
||||
yield! i16 wMemFlags // WORD wMemFlags
|
||||
yield! i16 wLangID // WORD wLangID
|
||||
yield! i32 0x00000000 // DWORD dwVersion
|
||||
yield! i32 0x00000000 // DWORD dwCharacteristics
|
||||
yield! Padded 0 data |]
|
||||
let ResFileNode (dwTypeID, dwNameID, wMemFlags, wLangID, data: byte[]) =
|
||||
[|
|
||||
yield! i32 data.Length // DWORD ResHdr.dwDataSize
|
||||
yield! i32 0x00000020 // dwHeaderSize
|
||||
yield! i32 ((dwTypeID <<< 16) ||| 0x0000FFFF) // dwTypeID, sizeof(DWORD)
|
||||
yield! i32 ((dwNameID <<< 16) ||| 0x0000FFFF) // dwNameID, sizeof(DWORD)
|
||||
yield! i32 0x00000000 // DWORD dwDataVersion
|
||||
yield! i16 wMemFlags // WORD wMemFlags
|
||||
yield! i16 wLangID // WORD wLangID
|
||||
yield! i32 0x00000000 // DWORD dwVersion
|
||||
yield! i32 0x00000000 // DWORD dwCharacteristics
|
||||
yield! Padded 0 data
|
||||
|]
|
||||
|
||||
let ResFileHeader() = ResFileNode(0x0, 0x0, 0x0, 0x0, [| |])
|
||||
let ResFileHeader () = ResFileNode(0x0, 0x0, 0x0, 0x0, [||])
|
||||
|
||||
// Generate the VS_VERSION_INFO structure held in a Win32 Version Resource in a PE file
|
||||
//
|
||||
|
|
@ -46,172 +50,191 @@ module ResFileFormat =
|
|||
module VersionResourceFormat =
|
||||
open BinaryGenerationUtilities
|
||||
|
||||
let VersionInfoNode(data: byte[]) =
|
||||
[| yield! i16 (data.Length + 2) // wLength : int16 // Specifies the length, in bytes, of the VS_VERSION_INFO structure.
|
||||
yield! data |]
|
||||
|
||||
let VersionInfoElement(wType, szKey, valueOpt: byte[] option, children: byte[][], isString) =
|
||||
// for String structs, wValueLength represents the word count, not the byte count
|
||||
let wValueLength = (match valueOpt with None -> 0 | Some value -> (if isString then value.Length / 2 else value.Length))
|
||||
VersionInfoNode
|
||||
[| yield! i16 wValueLength // wValueLength: int16. Specifies the length, in words, of the Value member.
|
||||
yield! i16 wType // wType : int16 Specifies the type of data in the version resource.
|
||||
yield! Padded 2 szKey
|
||||
match valueOpt with
|
||||
| None -> yield! []
|
||||
| Some value -> yield! Padded 0 value
|
||||
for child in children do
|
||||
yield! child |]
|
||||
|
||||
let Version(version: ILVersionInfo) =
|
||||
[| // DWORD dwFileVersionMS
|
||||
// Specifies the most significant 32 bits of the file's binary
|
||||
// version number. This member is used with dwFileVersionLS to form a 64-bit value used
|
||||
// for numeric comparisons.
|
||||
yield! i32 (int32 version.Major <<< 16 ||| int32 version.Minor)
|
||||
|
||||
// DWORD dwFileVersionLS
|
||||
// Specifies the least significant 32 bits of the file's binary
|
||||
// version number. This member is used with dwFileVersionMS to form a 64-bit value used
|
||||
// for numeric comparisons.
|
||||
yield! i32 (int32 version.Build <<< 16 ||| int32 version.Revision)
|
||||
let VersionInfoNode (data: byte[]) =
|
||||
[|
|
||||
yield! i16 (data.Length + 2) // wLength : int16 // Specifies the length, in bytes, of the VS_VERSION_INFO structure.
|
||||
yield! data
|
||||
|]
|
||||
|
||||
let String(string, value) =
|
||||
let VersionInfoElement (wType, szKey, valueOpt: byte[] option, children: byte[][], isString) =
|
||||
// for String structs, wValueLength represents the word count, not the byte count
|
||||
let wValueLength =
|
||||
(match valueOpt with
|
||||
| None -> 0
|
||||
| Some value -> (if isString then value.Length / 2 else value.Length))
|
||||
|
||||
VersionInfoNode
|
||||
[|
|
||||
yield! i16 wValueLength // wValueLength: int16. Specifies the length, in words, of the Value member.
|
||||
yield! i16 wType // wType : int16 Specifies the type of data in the version resource.
|
||||
yield! Padded 2 szKey
|
||||
match valueOpt with
|
||||
| None -> yield! []
|
||||
| Some value -> yield! Padded 0 value
|
||||
for child in children do
|
||||
yield! child
|
||||
|]
|
||||
|
||||
let Version (version: ILVersionInfo) =
|
||||
[| // DWORD dwFileVersionMS
|
||||
// Specifies the most significant 32 bits of the file's binary
|
||||
// version number. This member is used with dwFileVersionLS to form a 64-bit value used
|
||||
// for numeric comparisons.
|
||||
yield! i32 (int32 version.Major <<< 16 ||| int32 version.Minor)
|
||||
|
||||
// DWORD dwFileVersionLS
|
||||
// Specifies the least significant 32 bits of the file's binary
|
||||
// version number. This member is used with dwFileVersionMS to form a 64-bit value used
|
||||
// for numeric comparisons.
|
||||
yield! i32 (int32 version.Build <<< 16 ||| int32 version.Revision)
|
||||
|]
|
||||
|
||||
let String (string, value) =
|
||||
let wType = 0x1 // Specifies the type of data in the version resource.
|
||||
let szKey = Bytes.stringAsUnicodeNullTerminated string
|
||||
VersionInfoElement(wType, szKey, Some (Bytes.stringAsUnicodeNullTerminated value), [| |], true)
|
||||
VersionInfoElement(wType, szKey, Some(Bytes.stringAsUnicodeNullTerminated value), [||], true)
|
||||
|
||||
let StringTable(language, strings) =
|
||||
let StringTable (language, strings) =
|
||||
let wType = 0x1 // Specifies the type of data in the version resource.
|
||||
let szKey = Bytes.stringAsUnicodeNullTerminated language
|
||||
// Specifies an 8-digit hexadecimal number stored as a Unicode string.
|
||||
// Specifies an 8-digit hexadecimal number stored as a Unicode string.
|
||||
|
||||
let children =
|
||||
[| for string in strings do
|
||||
yield String string |]
|
||||
[|
|
||||
for string in strings do
|
||||
String string
|
||||
|]
|
||||
|
||||
VersionInfoElement(wType, szKey, None, children, false)
|
||||
|
||||
let StringFileInfo(stringTables: #seq<string * #seq<string * string> >) =
|
||||
let StringFileInfo (stringTables: #seq<string * #seq<string * string>>) =
|
||||
let wType = 0x1 // Specifies the type of data in the version resource.
|
||||
let szKey = Bytes.stringAsUnicodeNullTerminated "StringFileInfo" // Contains the Unicode string StringFileInfo
|
||||
// Contains an array of one or more StringTable structures.
|
||||
let children =
|
||||
[| for stringTable in stringTables do
|
||||
yield StringTable stringTable |]
|
||||
[|
|
||||
for stringTable in stringTables do
|
||||
StringTable stringTable
|
||||
|]
|
||||
|
||||
VersionInfoElement(wType, szKey, None, children, false)
|
||||
|
||||
let VarFileInfo(vars: #seq<int32 * int32>) =
|
||||
let VarFileInfo (vars: #seq<int32 * int32>) =
|
||||
let wType = 0x1 // Specifies the type of data in the version resource.
|
||||
let szKey = Bytes.stringAsUnicodeNullTerminated "VarFileInfo" // Contains the Unicode string StringFileInfo
|
||||
// Contains an array of one or more StringTable structures.
|
||||
let children =
|
||||
[| for lang, codePage in vars do
|
||||
let szKey = Bytes.stringAsUnicodeNullTerminated "Translation"
|
||||
yield VersionInfoElement(0x0, szKey, Some([| yield! i16 lang
|
||||
yield! i16 codePage |]), [| |], false) |]
|
||||
[|
|
||||
for lang, codePage in vars do
|
||||
let szKey = Bytes.stringAsUnicodeNullTerminated "Translation"
|
||||
VersionInfoElement(0x0, szKey, Some([| yield! i16 lang; yield! i16 codePage |]), [||], false)
|
||||
|]
|
||||
|
||||
VersionInfoElement(wType, szKey, None, children, false)
|
||||
|
||||
let VS_FIXEDFILEINFO(fileVersion: ILVersionInfo,
|
||||
productVersion: ILVersionInfo,
|
||||
dwFileFlagsMask,
|
||||
dwFileFlags, dwFileOS,
|
||||
dwFileType, dwFileSubtype,
|
||||
lwFileDate: int64) =
|
||||
let VS_FIXEDFILEINFO
|
||||
(
|
||||
fileVersion: ILVersionInfo,
|
||||
productVersion: ILVersionInfo,
|
||||
dwFileFlagsMask,
|
||||
dwFileFlags,
|
||||
dwFileOS,
|
||||
dwFileType,
|
||||
dwFileSubtype,
|
||||
lwFileDate: int64
|
||||
) =
|
||||
let dwStrucVersion = 0x00010000
|
||||
|
||||
[| // DWORD dwSignature // Contains the value 0xFEEFO4BD.
|
||||
yield! i32 0xFEEF04BD
|
||||
yield! i32 0xFEEF04BD
|
||||
|
||||
// DWORD dwStrucVersion // Specifies the binary version number of this structure.
|
||||
yield! i32 dwStrucVersion
|
||||
// DWORD dwStrucVersion // Specifies the binary version number of this structure.
|
||||
yield! i32 dwStrucVersion
|
||||
|
||||
// DWORD dwFileVersionMS, dwFileVersionLS // Specifies the most/least significant 32 bits of the file's binary version number.
|
||||
yield! Version fileVersion
|
||||
// DWORD dwFileVersionMS, dwFileVersionLS // Specifies the most/least significant 32 bits of the file's binary version number.
|
||||
yield! Version fileVersion
|
||||
|
||||
// DWORD dwProductVersionMS, dwProductVersionLS // Specifies the most/least significant 32 bits of the file's binary version number.
|
||||
yield! Version productVersion
|
||||
// DWORD dwProductVersionMS, dwProductVersionLS // Specifies the most/least significant 32 bits of the file's binary version number.
|
||||
yield! Version productVersion
|
||||
|
||||
// DWORD dwFileFlagsMask // Contains a bitmask that specifies the valid bits in dwFileFlags.
|
||||
yield! i32 dwFileFlagsMask
|
||||
// DWORD dwFileFlagsMask // Contains a bitmask that specifies the valid bits in dwFileFlags.
|
||||
yield! i32 dwFileFlagsMask
|
||||
|
||||
// DWORD dwFileFlags // Contains a bitmask that specifies the Boolean attributes of the file.
|
||||
yield! i32 dwFileFlags
|
||||
// VS_FF_DEBUG 0x1L The file contains debugging information or is compiled with debugging features enabled.
|
||||
// VS_FF_INFOINFERRED The file's version structure was created dynamically; therefore, some of the members
|
||||
// in this structure may be empty or incorrect. This flag should never be set in a file's
|
||||
// VS_VERSION_INFO data.
|
||||
// VS_FF_PATCHED The file has been modified and is not identical to the original shipping file of
|
||||
// the same version number.
|
||||
// VS_FF_PRERELEASE The file is a development version, not a commercially released product.
|
||||
// VS_FF_PRIVATEBUILD The file was not built using standard release procedures. If this flag is
|
||||
// set, the StringFileInfo structure should contain a PrivateBuild entry.
|
||||
// VS_FF_SPECIALBUILD The file was built by the original company using standard release procedures
|
||||
// but is a variation of the normal file of the same version number. If this
|
||||
// flag is set, the StringFileInfo structure should contain a SpecialBuild entry.
|
||||
// DWORD dwFileFlags // Contains a bitmask that specifies the Boolean attributes of the file.
|
||||
yield! i32 dwFileFlags
|
||||
// VS_FF_DEBUG 0x1L The file contains debugging information or is compiled with debugging features enabled.
|
||||
// VS_FF_INFOINFERRED The file's version structure was created dynamically; therefore, some of the members
|
||||
// in this structure may be empty or incorrect. This flag should never be set in a file's
|
||||
// VS_VERSION_INFO data.
|
||||
// VS_FF_PATCHED The file has been modified and is not identical to the original shipping file of
|
||||
// the same version number.
|
||||
// VS_FF_PRERELEASE The file is a development version, not a commercially released product.
|
||||
// VS_FF_PRIVATEBUILD The file was not built using standard release procedures. If this flag is
|
||||
// set, the StringFileInfo structure should contain a PrivateBuild entry.
|
||||
// VS_FF_SPECIALBUILD The file was built by the original company using standard release procedures
|
||||
// but is a variation of the normal file of the same version number. If this
|
||||
// flag is set, the StringFileInfo structure should contain a SpecialBuild entry.
|
||||
|
||||
//Specifies the operating system for which this file was designed. This member can be one of the following values: Flag
|
||||
yield! i32 dwFileOS
|
||||
//VOS_DOS 0x0001L The file was designed for MS-DOS.
|
||||
//VOS_NT 0x0004L The file was designed for Windows NT.
|
||||
//VOS__WINDOWS16 The file was designed for 16-bit Windows.
|
||||
//VOS__WINDOWS32 The file was designed for the Win32 API.
|
||||
//VOS_OS216 0x00020000L The file was designed for 16-bit OS/2.
|
||||
//VOS_OS232 0x00030000L The file was designed for 32-bit OS/2.
|
||||
//VOS__PM16 The file was designed for 16-bit Presentation Manager.
|
||||
//VOS__PM32 The file was designed for 32-bit Presentation Manager.
|
||||
//VOS_UNKNOWN The operating system for which the file was designed is unknown to Windows.
|
||||
//Specifies the operating system for which this file was designed. This member can be one of the following values: Flag
|
||||
yield! i32 dwFileOS
|
||||
//VOS_DOS 0x0001L The file was designed for MS-DOS.
|
||||
//VOS_NT 0x0004L The file was designed for Windows NT.
|
||||
//VOS__WINDOWS16 The file was designed for 16-bit Windows.
|
||||
//VOS__WINDOWS32 The file was designed for the Win32 API.
|
||||
//VOS_OS216 0x00020000L The file was designed for 16-bit OS/2.
|
||||
//VOS_OS232 0x00030000L The file was designed for 32-bit OS/2.
|
||||
//VOS__PM16 The file was designed for 16-bit Presentation Manager.
|
||||
//VOS__PM32 The file was designed for 32-bit Presentation Manager.
|
||||
//VOS_UNKNOWN The operating system for which the file was designed is unknown to Windows.
|
||||
|
||||
// Specifies the general type of file. This member can be one of the following values:
|
||||
yield! i32 dwFileType
|
||||
// Specifies the general type of file. This member can be one of the following values:
|
||||
yield! i32 dwFileType
|
||||
|
||||
//VFT_UNKNOWN The file type is unknown to Windows.
|
||||
//VFT_APP The file contains an application.
|
||||
//VFT_DLL The file contains a dynamic-link library (DLL).
|
||||
//VFT_DRV The file contains a device driver. If dwFileType is VFT_DRV, dwFileSubtype contains a more specific description of the driver.
|
||||
//VFT_FONT The file contains a font. If dwFileType is VFT_FONT, dwFileSubtype contains a more specific description of the font file.
|
||||
//VFT_VXD The file contains a virtual device.
|
||||
//VFT_STATIC_LIB The file contains a static-link library.
|
||||
//VFT_UNKNOWN The file type is unknown to Windows.
|
||||
//VFT_APP The file contains an application.
|
||||
//VFT_DLL The file contains a dynamic-link library (DLL).
|
||||
//VFT_DRV The file contains a device driver. If dwFileType is VFT_DRV, dwFileSubtype contains a more specific description of the driver.
|
||||
//VFT_FONT The file contains a font. If dwFileType is VFT_FONT, dwFileSubtype contains a more specific description of the font file.
|
||||
//VFT_VXD The file contains a virtual device.
|
||||
//VFT_STATIC_LIB The file contains a static-link library.
|
||||
|
||||
// Specifies the function of the file. The possible values depend on the value of
|
||||
// dwFileType. For all values of dwFileType not described in the following list,
|
||||
// dwFileSubtype is zero. If dwFileType is VFT_DRV, dwFileSubtype can be one of the following values:
|
||||
yield! i32 dwFileSubtype
|
||||
//VFT2_UNKNOWN The driver type is unknown by Windows.
|
||||
//VFT2_DRV_COMM The file contains a communications driver.
|
||||
//VFT2_DRV_PRINTER The file contains a printer driver.
|
||||
//VFT2_DRV_KEYBOARD The file contains a keyboard driver.
|
||||
//VFT2_DRV_LANGUAGE The file contains a language driver.
|
||||
//VFT2_DRV_DISPLAY The file contains a display driver.
|
||||
//VFT2_DRV_MOUSE The file contains a mouse driver.
|
||||
//VFT2_DRV_NETWORK The file contains a network driver.
|
||||
//VFT2_DRV_SYSTEM The file contains a system driver.
|
||||
//VFT2_DRV_INSTALLABLE The file contains an installable driver.
|
||||
//VFT2_DRV_SOUND The file contains a sound driver.
|
||||
//
|
||||
//If dwFileType is VFT_FONT, dwFileSubtype can be one of the following values:
|
||||
//
|
||||
//VFT2_UNKNOWN The font type is unknown by Windows.
|
||||
//VFT2_FONT_RASTER The file contains a raster font.
|
||||
//VFT2_FONT_VECTOR The file contains a vector font.
|
||||
//VFT2_FONT_TRUETYPE The file contains a TrueType font.
|
||||
//
|
||||
//If dwFileType is VFT_VXD, dwFileSubtype contains the virtual device identifier included in the virtual device control block.
|
||||
// Specifies the function of the file. The possible values depend on the value of
|
||||
// dwFileType. For all values of dwFileType not described in the following list,
|
||||
// dwFileSubtype is zero. If dwFileType is VFT_DRV, dwFileSubtype can be one of the following values:
|
||||
yield! i32 dwFileSubtype
|
||||
//VFT2_UNKNOWN The driver type is unknown by Windows.
|
||||
//VFT2_DRV_COMM The file contains a communications driver.
|
||||
//VFT2_DRV_PRINTER The file contains a printer driver.
|
||||
//VFT2_DRV_KEYBOARD The file contains a keyboard driver.
|
||||
//VFT2_DRV_LANGUAGE The file contains a language driver.
|
||||
//VFT2_DRV_DISPLAY The file contains a display driver.
|
||||
//VFT2_DRV_MOUSE The file contains a mouse driver.
|
||||
//VFT2_DRV_NETWORK The file contains a network driver.
|
||||
//VFT2_DRV_SYSTEM The file contains a system driver.
|
||||
//VFT2_DRV_INSTALLABLE The file contains an installable driver.
|
||||
//VFT2_DRV_SOUND The file contains a sound driver.
|
||||
//
|
||||
//If dwFileType is VFT_FONT, dwFileSubtype can be one of the following values:
|
||||
//
|
||||
//VFT2_UNKNOWN The font type is unknown by Windows.
|
||||
//VFT2_FONT_RASTER The file contains a raster font.
|
||||
//VFT2_FONT_VECTOR The file contains a vector font.
|
||||
//VFT2_FONT_TRUETYPE The file contains a TrueType font.
|
||||
//
|
||||
//If dwFileType is VFT_VXD, dwFileSubtype contains the virtual device identifier included in the virtual device control block.
|
||||
|
||||
// Specifies the most significant 32 bits of the file's 64-bit binary creation date and time stamp.
|
||||
yield! i32 (int32 (lwFileDate >>> 32))
|
||||
// Specifies the most significant 32 bits of the file's 64-bit binary creation date and time stamp.
|
||||
yield! i32 (int32 (lwFileDate >>> 32))
|
||||
|
||||
//Specifies the least significant 32 bits of the file's 64-bit binary creation date and time stamp.
|
||||
yield! i32 (int32 lwFileDate)
|
||||
|]
|
||||
//Specifies the least significant 32 bits of the file's 64-bit binary creation date and time stamp.
|
||||
yield! i32 (int32 lwFileDate)
|
||||
|]
|
||||
|
||||
let VS_VERSION_INFO(fixedFileInfo, stringFileInfo, varFileInfo) =
|
||||
let VS_VERSION_INFO (fixedFileInfo, stringFileInfo, varFileInfo) =
|
||||
let wType = 0x0
|
||||
let szKey = Bytes.stringAsUnicodeNullTerminated "VS_VERSION_INFO" // Contains the Unicode string VS_VERSION_INFO
|
||||
let value = VS_FIXEDFILEINFO fixedFileInfo
|
||||
let children =
|
||||
[| yield StringFileInfo stringFileInfo
|
||||
yield VarFileInfo varFileInfo
|
||||
|]
|
||||
let children = [| StringFileInfo stringFileInfo; VarFileInfo varFileInfo |]
|
||||
VersionInfoElement(wType, szKey, Some value, children, false)
|
||||
|
||||
let VS_VERSION_INFO_RESOURCE data =
|
||||
|
|
@ -223,7 +246,7 @@ module VersionResourceFormat =
|
|||
|
||||
module ManifestResourceFormat =
|
||||
|
||||
let VS_MANIFEST_RESOURCE(data, isLibrary) =
|
||||
let VS_MANIFEST_RESOURCE (data, isLibrary) =
|
||||
let dwTypeID = 0x0018
|
||||
let dwNameID = if isLibrary then 0x2 else 0x1
|
||||
let wMemFlags = 0x0
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -99,7 +99,7 @@ and IProjectReference =
|
|||
abstract TryGetLogicalTimeStamp: cache: TimeStampCache -> DateTime option
|
||||
|
||||
type AssemblyReference =
|
||||
| AssemblyReference of range * string * IProjectReference option
|
||||
| AssemblyReference of range: range * text: string * projectReference: IProjectReference option
|
||||
|
||||
member Range: range
|
||||
|
||||
|
|
@ -854,6 +854,4 @@ val FSharpScriptFileSuffixes: string list
|
|||
/// File suffixes where #light is the default
|
||||
val FSharpIndentationAwareSyntaxFileSuffixes: string list
|
||||
|
||||
val doNotRequireNamespaceOrModuleSuffixes: string list
|
||||
|
||||
val mlCompatSuffixes: string list
|
||||
val FSharpMLCompatFileSuffixes: string list
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -31,31 +31,32 @@ module AttributeHelpers =
|
|||
|
||||
/// Try to find an attribute that takes a string argument
|
||||
let TryFindStringAttribute (g: TcGlobals) attrib attribs =
|
||||
match g.TryFindSysAttrib attrib with
|
||||
| None -> None
|
||||
| Some attribRef ->
|
||||
match TryFindFSharpAttribute g attribRef attribs with
|
||||
| Some (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s
|
||||
| _ -> None
|
||||
match g.TryFindSysAttrib attrib with
|
||||
| None -> None
|
||||
| Some attribRef ->
|
||||
match TryFindFSharpAttribute g attribRef attribs with
|
||||
| Some (Attrib (_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s
|
||||
| _ -> None
|
||||
|
||||
let TryFindIntAttribute (g: TcGlobals) attrib attribs =
|
||||
match g.TryFindSysAttrib attrib with
|
||||
| None -> None
|
||||
| Some attribRef ->
|
||||
match TryFindFSharpAttribute g attribRef attribs with
|
||||
| Some (Attrib(_, _, [ AttribInt32Arg i ], _, _, _, _)) -> Some i
|
||||
| _ -> None
|
||||
match g.TryFindSysAttrib attrib with
|
||||
| None -> None
|
||||
| Some attribRef ->
|
||||
match TryFindFSharpAttribute g attribRef attribs with
|
||||
| Some (Attrib (_, _, [ AttribInt32Arg i ], _, _, _, _)) -> Some i
|
||||
| _ -> None
|
||||
|
||||
let TryFindBoolAttribute (g: TcGlobals) attrib attribs =
|
||||
match g.TryFindSysAttrib attrib with
|
||||
| None -> None
|
||||
| Some attribRef ->
|
||||
match TryFindFSharpAttribute g attribRef attribs with
|
||||
| Some (Attrib(_, _, [ AttribBoolArg p ], _, _, _, _)) -> Some p
|
||||
| _ -> None
|
||||
match g.TryFindSysAttrib attrib with
|
||||
| None -> None
|
||||
| Some attribRef ->
|
||||
match TryFindFSharpAttribute g attribRef attribs with
|
||||
| Some (Attrib (_, _, [ AttribBoolArg p ], _, _, _, _)) -> Some p
|
||||
| _ -> None
|
||||
|
||||
let (|ILVersion|_|) (versionString: string) =
|
||||
try Some (parseILVersion versionString)
|
||||
try
|
||||
Some(parseILVersion versionString)
|
||||
with e ->
|
||||
None
|
||||
|
||||
|
|
@ -67,20 +68,25 @@ module AttributeHelpers =
|
|||
type StrongNameSigningInfo = StrongNameSigningInfo of delaysign: bool * publicsign: bool * signer: string option * container: string option
|
||||
|
||||
/// Validate the attributes and configuration settings used to perform strong-name signing
|
||||
let ValidateKeySigningAttributes (tcConfig : TcConfig, tcGlobals, topAttrs) =
|
||||
let delaySignAttrib = AttributeHelpers.TryFindBoolAttribute tcGlobals "System.Reflection.AssemblyDelaySignAttribute" topAttrs.assemblyAttrs
|
||||
let signerAttrib = AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyKeyFileAttribute" topAttrs.assemblyAttrs
|
||||
let containerAttrib = AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyKeyNameAttribute" topAttrs.assemblyAttrs
|
||||
let ValidateKeySigningAttributes (tcConfig: TcConfig, tcGlobals, topAttrs) =
|
||||
let delaySignAttrib =
|
||||
AttributeHelpers.TryFindBoolAttribute tcGlobals "System.Reflection.AssemblyDelaySignAttribute" topAttrs.assemblyAttrs
|
||||
|
||||
let signerAttrib =
|
||||
AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyKeyFileAttribute" topAttrs.assemblyAttrs
|
||||
|
||||
let containerAttrib =
|
||||
AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyKeyNameAttribute" topAttrs.assemblyAttrs
|
||||
|
||||
// if delaySign is set via an attribute, validate that it wasn't set via an option
|
||||
let delaysign =
|
||||
match delaySignAttrib with
|
||||
| Some delaysign ->
|
||||
if tcConfig.delaysign then
|
||||
warning(Error(FSComp.SR.fscDelaySignWarning(), rangeCmdArgs))
|
||||
tcConfig.delaysign
|
||||
else
|
||||
delaysign
|
||||
if tcConfig.delaysign then
|
||||
warning (Error(FSComp.SR.fscDelaySignWarning (), rangeCmdArgs))
|
||||
tcConfig.delaysign
|
||||
else
|
||||
delaysign
|
||||
| _ -> tcConfig.delaysign
|
||||
|
||||
// if signer is set via an attribute, validate that it wasn't set via an option
|
||||
|
|
@ -88,7 +94,7 @@ let ValidateKeySigningAttributes (tcConfig : TcConfig, tcGlobals, topAttrs) =
|
|||
match signerAttrib with
|
||||
| Some signer ->
|
||||
if tcConfig.signer.IsSome && tcConfig.signer <> Some signer then
|
||||
warning(Error(FSComp.SR.fscKeyFileWarning(), rangeCmdArgs))
|
||||
warning (Error(FSComp.SR.fscKeyFileWarning (), rangeCmdArgs))
|
||||
tcConfig.signer
|
||||
else
|
||||
Some signer
|
||||
|
|
@ -101,35 +107,35 @@ let ValidateKeySigningAttributes (tcConfig : TcConfig, tcGlobals, topAttrs) =
|
|||
match containerAttrib with
|
||||
| Some container ->
|
||||
if not FSharpEnvironment.isRunningOnCoreClr then
|
||||
warning(Error(FSComp.SR.containerDeprecated(), rangeCmdArgs))
|
||||
warning (Error(FSComp.SR.containerDeprecated (), rangeCmdArgs))
|
||||
|
||||
if tcConfig.container.IsSome && tcConfig.container <> Some container then
|
||||
warning(Error(FSComp.SR.fscKeyNameWarning(), rangeCmdArgs))
|
||||
tcConfig.container
|
||||
warning (Error(FSComp.SR.fscKeyNameWarning (), rangeCmdArgs))
|
||||
tcConfig.container
|
||||
else
|
||||
Some container
|
||||
Some container
|
||||
| None -> tcConfig.container
|
||||
|
||||
StrongNameSigningInfo (delaysign, tcConfig.publicsign, signer, container)
|
||||
StrongNameSigningInfo(delaysign, tcConfig.publicsign, signer, container)
|
||||
|
||||
/// Get the object used to perform strong-name signing
|
||||
let GetStrongNameSigner signingInfo =
|
||||
let (StrongNameSigningInfo(delaysign, publicsign, signer, container)) = signingInfo
|
||||
let (StrongNameSigningInfo (delaysign, publicsign, signer, container)) = signingInfo
|
||||
// REVIEW: favor the container over the key file - C# appears to do this
|
||||
match container with
|
||||
| Some container ->
|
||||
Some (ILStrongNameSigner.OpenKeyContainer container)
|
||||
| Some container -> Some(ILStrongNameSigner.OpenKeyContainer container)
|
||||
| None ->
|
||||
match signer with
|
||||
| None -> None
|
||||
| Some s ->
|
||||
try
|
||||
if publicsign || delaysign then
|
||||
Some (ILStrongNameSigner.OpenPublicKeyOptions s publicsign)
|
||||
Some(ILStrongNameSigner.OpenPublicKeyOptions s publicsign)
|
||||
else
|
||||
Some (ILStrongNameSigner.OpenKeyPairFile s)
|
||||
Some(ILStrongNameSigner.OpenKeyPairFile s)
|
||||
with _ ->
|
||||
// Note :: don't use errorR here since we really want to fail and not produce a binary
|
||||
error(Error(FSComp.SR.fscKeyFileCouldNotBeOpened s, rangeCmdArgs))
|
||||
error (Error(FSComp.SR.fscKeyFileCouldNotBeOpened s, rangeCmdArgs))
|
||||
|
||||
//----------------------------------------------------------------------------
|
||||
// Building the contents of the finalized IL module
|
||||
|
|
@ -138,65 +144,87 @@ let GetStrongNameSigner signingInfo =
|
|||
module MainModuleBuilder =
|
||||
|
||||
let injectedCompatTypes =
|
||||
set [ "System.Tuple`1"
|
||||
"System.Tuple`2"
|
||||
"System.Tuple`3"
|
||||
"System.Tuple`4"
|
||||
"System.Tuple`5"
|
||||
"System.Tuple`6"
|
||||
"System.Tuple`7"
|
||||
"System.Tuple`8"
|
||||
"System.ITuple"
|
||||
"System.Tuple"
|
||||
"System.Collections.IStructuralComparable"
|
||||
"System.Collections.IStructuralEquatable" ]
|
||||
set
|
||||
[
|
||||
"System.Tuple`1"
|
||||
"System.Tuple`2"
|
||||
"System.Tuple`3"
|
||||
"System.Tuple`4"
|
||||
"System.Tuple`5"
|
||||
"System.Tuple`6"
|
||||
"System.Tuple`7"
|
||||
"System.Tuple`8"
|
||||
"System.ITuple"
|
||||
"System.Tuple"
|
||||
"System.Collections.IStructuralComparable"
|
||||
"System.Collections.IStructuralEquatable"
|
||||
]
|
||||
|
||||
let typesForwardedToMscorlib =
|
||||
set [ "System.AggregateException"
|
||||
"System.Threading.CancellationTokenRegistration"
|
||||
"System.Threading.CancellationToken"
|
||||
"System.Threading.CancellationTokenSource"
|
||||
"System.Lazy`1"
|
||||
"System.IObservable`1"
|
||||
"System.IObserver`1" ]
|
||||
set
|
||||
[
|
||||
"System.AggregateException"
|
||||
"System.Threading.CancellationTokenRegistration"
|
||||
"System.Threading.CancellationToken"
|
||||
"System.Threading.CancellationTokenSource"
|
||||
"System.Lazy`1"
|
||||
"System.IObservable`1"
|
||||
"System.IObserver`1"
|
||||
]
|
||||
|
||||
let typesForwardedToSystemNumerics =
|
||||
set [ "System.Numerics.BigInteger" ]
|
||||
let typesForwardedToSystemNumerics = set [ "System.Numerics.BigInteger" ]
|
||||
|
||||
let createMscorlibExportList (tcGlobals: TcGlobals) =
|
||||
// We want to write forwarders out for all injected types except for System.ITuple, which is internal
|
||||
// Forwarding System.ITuple will cause FxCop failures on 4.0
|
||||
Set.union (Set.filter (fun t -> t <> "System.ITuple") injectedCompatTypes) typesForwardedToMscorlib |>
|
||||
Seq.map (fun t -> mkTypeForwarder tcGlobals.ilg.primaryAssemblyScopeRef t (mkILNestedExportedTypes List.empty<ILNestedExportedType>) (mkILCustomAttrs List.empty<ILAttribute>) ILTypeDefAccess.Public )
|
||||
|> Seq.toList
|
||||
// We want to write forwarders out for all injected types except for System.ITuple, which is internal
|
||||
// Forwarding System.ITuple will cause FxCop failures on 4.0
|
||||
Set.union (Set.filter (fun t -> t <> "System.ITuple") injectedCompatTypes) typesForwardedToMscorlib
|
||||
|> Seq.map (fun t ->
|
||||
mkTypeForwarder
|
||||
tcGlobals.ilg.primaryAssemblyScopeRef
|
||||
t
|
||||
(mkILNestedExportedTypes List.empty<ILNestedExportedType>)
|
||||
(mkILCustomAttrs List.empty<ILAttribute>)
|
||||
ILTypeDefAccess.Public)
|
||||
|> Seq.toList
|
||||
|
||||
let createSystemNumericsExportList (tcConfig: TcConfig) (tcImports: TcImports) =
|
||||
let refNumericsDllName =
|
||||
if (tcConfig.primaryAssembly.Name = "mscorlib") then "System.Numerics"
|
||||
else "System.Runtime.Numerics"
|
||||
if (tcConfig.primaryAssembly.Name = "mscorlib") then
|
||||
"System.Numerics"
|
||||
else
|
||||
"System.Runtime.Numerics"
|
||||
|
||||
let numericsAssemblyRef =
|
||||
match tcImports.GetImportedAssemblies() |> List.tryFind<ImportedAssembly>(fun a -> a.FSharpViewOfMetadata.AssemblyName = refNumericsDllName) with
|
||||
match tcImports.GetImportedAssemblies()
|
||||
|> List.tryFind<ImportedAssembly> (fun a -> a.FSharpViewOfMetadata.AssemblyName = refNumericsDllName)
|
||||
with
|
||||
| Some asm ->
|
||||
match asm.ILScopeRef with
|
||||
| ILScopeRef.Assembly aref -> Some aref
|
||||
| _ -> None
|
||||
| None -> None
|
||||
|
||||
match numericsAssemblyRef with
|
||||
| Some aref ->
|
||||
let systemNumericsAssemblyRef = ILAssemblyRef.Create(refNumericsDllName, aref.Hash, aref.PublicKey, aref.Retargetable, aref.Version, aref.Locale)
|
||||
typesForwardedToSystemNumerics |>
|
||||
Seq.map (fun t ->
|
||||
{ ScopeRef = ILScopeRef.Assembly systemNumericsAssemblyRef
|
||||
Name = t
|
||||
Attributes = enum<TypeAttributes>(0x00200000) ||| TypeAttributes.Public
|
||||
Nested = mkILNestedExportedTypes []
|
||||
CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
|
||||
MetadataIndex = NoMetadataIdx }) |>
|
||||
Seq.toList
|
||||
let systemNumericsAssemblyRef =
|
||||
ILAssemblyRef.Create(refNumericsDllName, aref.Hash, aref.PublicKey, aref.Retargetable, aref.Version, aref.Locale)
|
||||
|
||||
typesForwardedToSystemNumerics
|
||||
|> Seq.map (fun t ->
|
||||
{
|
||||
ScopeRef = ILScopeRef.Assembly systemNumericsAssemblyRef
|
||||
Name = t
|
||||
Attributes = enum<TypeAttributes> (0x00200000) ||| TypeAttributes.Public
|
||||
Nested = mkILNestedExportedTypes []
|
||||
CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
|
||||
MetadataIndex = NoMetadataIdx
|
||||
})
|
||||
|> Seq.toList
|
||||
| None -> []
|
||||
|
||||
let ComputeILFileVersion findStringAttr (assemblyVersion: ILVersionInfo) =
|
||||
let attrName = "System.Reflection.AssemblyFileVersionAttribute"
|
||||
|
||||
match findStringAttr attrName with
|
||||
| None -> assemblyVersion
|
||||
| Some (AttributeHelpers.ILVersion v) -> v
|
||||
|
|
@ -206,69 +234,108 @@ module MainModuleBuilder =
|
|||
|
||||
let ComputeProductVersion findStringAttr (fileVersion: ILVersionInfo) =
|
||||
let attrName = "System.Reflection.AssemblyInformationalVersionAttribute"
|
||||
let toDotted (version: ILVersionInfo) = sprintf "%d.%d.%d.%d" version.Major version.Minor version.Build version.Revision
|
||||
|
||||
let toDotted (version: ILVersionInfo) =
|
||||
sprintf "%d.%d.%d.%d" version.Major version.Minor version.Build version.Revision
|
||||
|
||||
match findStringAttr attrName with
|
||||
| None | Some "" -> fileVersion |> toDotted
|
||||
| None
|
||||
| Some "" -> fileVersion |> toDotted
|
||||
| Some (AttributeHelpers.ILVersion v) -> v |> toDotted
|
||||
| Some v ->
|
||||
// Warning will be reported by CheckExpressions.fs
|
||||
v
|
||||
|
||||
let ConvertProductVersionToILVersionInfo (version: string) : ILVersionInfo =
|
||||
let parseOrZero i (v:string) =
|
||||
let parseOrZero i (v: string) =
|
||||
let v =
|
||||
// When i = 3 then this is the 4th part of the version. The last part of the version can be trailed by any characters so we trim them off
|
||||
if i <> 3 then
|
||||
v
|
||||
else
|
||||
((false, ""), v)
|
||||
||> Seq.fold(fun (finished, v) c ->
|
||||
||> Seq.fold (fun (finished, v) c ->
|
||||
match finished with
|
||||
| false when Char.IsDigit(c) -> false, v + c.ToString()
|
||||
| _ -> true, v)
|
||||
|> snd
|
||||
|
||||
match UInt16.TryParse v with
|
||||
| true, i -> i
|
||||
| false, _ -> 0us
|
||||
|
||||
let validParts =
|
||||
version.Split('.')
|
||||
|> Array.mapi(fun i v -> parseOrZero i v)
|
||||
|> Seq.toList
|
||||
match validParts @ [0us; 0us; 0us; 0us] with
|
||||
version.Split('.') |> Array.mapi (fun i v -> parseOrZero i v) |> Seq.toList
|
||||
|
||||
match validParts @ [ 0us; 0us; 0us; 0us ] with
|
||||
| major :: minor :: build :: rev :: _ -> ILVersionInfo(major, minor, build, rev)
|
||||
| x -> failwithf "error converting product version '%s' to binary, tried '%A' " version x
|
||||
|
||||
|
||||
let CreateMainModule
|
||||
(ctok, tcConfig: TcConfig, tcGlobals, tcImports: TcImports,
|
||||
pdbfile, assemblyName, outfile, topAttrs,
|
||||
sigDataAttributes: ILAttribute list, sigDataResources: ILResource list, optDataResources: ILResource list,
|
||||
codegenResults, assemVerFromAttrib, metadataVersion, secDecls) =
|
||||
(
|
||||
ctok,
|
||||
tcConfig: TcConfig,
|
||||
tcGlobals,
|
||||
tcImports: TcImports,
|
||||
pdbfile,
|
||||
assemblyName,
|
||||
outfile,
|
||||
topAttrs,
|
||||
sigDataAttributes: ILAttribute list,
|
||||
sigDataResources: ILResource list,
|
||||
optDataResources: ILResource list,
|
||||
codegenResults,
|
||||
assemVerFromAttrib,
|
||||
metadataVersion,
|
||||
secDecls
|
||||
) =
|
||||
|
||||
RequireCompilationThread ctok
|
||||
|
||||
let ilTypeDefs =
|
||||
//let topTypeDef = mkILTypeDefForGlobalFunctions tcGlobals.ilg (mkILMethods [], emptyILFields)
|
||||
mkILTypeDefs codegenResults.ilTypeDefs
|
||||
|
||||
let mainModule =
|
||||
let hashAlg = AttributeHelpers.TryFindIntAttribute tcGlobals "System.Reflection.AssemblyAlgorithmIdAttribute" topAttrs.assemblyAttrs
|
||||
let locale = AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyCultureAttribute" topAttrs.assemblyAttrs
|
||||
let flags = match AttributeHelpers.TryFindIntAttribute tcGlobals "System.Reflection.AssemblyFlagsAttribute" topAttrs.assemblyAttrs with | Some f -> f | _ -> 0x0
|
||||
let hashAlg =
|
||||
AttributeHelpers.TryFindIntAttribute tcGlobals "System.Reflection.AssemblyAlgorithmIdAttribute" topAttrs.assemblyAttrs
|
||||
|
||||
let locale =
|
||||
AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyCultureAttribute" topAttrs.assemblyAttrs
|
||||
|
||||
let flags =
|
||||
match AttributeHelpers.TryFindIntAttribute tcGlobals "System.Reflection.AssemblyFlagsAttribute" topAttrs.assemblyAttrs with
|
||||
| Some f -> f
|
||||
| _ -> 0x0
|
||||
|
||||
// You're only allowed to set a locale if the assembly is a library
|
||||
if (locale <> None && locale.Value <> "") && tcConfig.target <> CompilerTarget.Dll then
|
||||
error(Error(FSComp.SR.fscAssemblyCultureAttributeError(), rangeCmdArgs))
|
||||
error (Error(FSComp.SR.fscAssemblyCultureAttributeError (), rangeCmdArgs))
|
||||
|
||||
// Add the type forwarders to any .NET DLL post-.NET-2.0, to give binary compatibility
|
||||
let exportedTypesList =
|
||||
if tcConfig.compilingFSharpCore then
|
||||
List.append (createMscorlibExportList tcGlobals) (createSystemNumericsExportList tcConfig tcImports)
|
||||
List.append (createMscorlibExportList tcGlobals) (createSystemNumericsExportList tcConfig tcImports)
|
||||
else
|
||||
[]
|
||||
|
||||
let ilModuleName = GetGeneratedILModuleName tcConfig.target assemblyName
|
||||
let isDLL = (tcConfig.target = CompilerTarget.Dll || tcConfig.target = CompilerTarget.Module)
|
||||
mkILSimpleModule assemblyName ilModuleName isDLL tcConfig.subsystemVersion tcConfig.useHighEntropyVA ilTypeDefs hashAlg locale flags (mkILExportedTypes exportedTypesList) metadataVersion
|
||||
|
||||
let isDLL =
|
||||
(tcConfig.target = CompilerTarget.Dll || tcConfig.target = CompilerTarget.Module)
|
||||
|
||||
mkILSimpleModule
|
||||
assemblyName
|
||||
ilModuleName
|
||||
isDLL
|
||||
tcConfig.subsystemVersion
|
||||
tcConfig.useHighEntropyVA
|
||||
ilTypeDefs
|
||||
hashAlg
|
||||
locale
|
||||
flags
|
||||
(mkILExportedTypes exportedTypesList)
|
||||
metadataVersion
|
||||
|
||||
let disableJitOptimizations = not tcConfig.optSettings.JitOptimizationsEnabled
|
||||
|
||||
|
|
@ -277,74 +344,130 @@ module MainModuleBuilder =
|
|||
let reflectedDefinitionAttrs, reflectedDefinitionResources =
|
||||
codegenResults.quotationResourceInfo
|
||||
|> List.map (fun (referencedTypeDefs, reflectedDefinitionBytes) ->
|
||||
let reflectedDefinitionResourceName = QuotationPickler.SerializedReflectedDefinitionsResourceNameBase+"-"+assemblyName+"-"+string(newUnique())+"-"+string(hash reflectedDefinitionBytes)
|
||||
let reflectedDefinitionResourceName =
|
||||
QuotationPickler.SerializedReflectedDefinitionsResourceNameBase
|
||||
+ "-"
|
||||
+ assemblyName
|
||||
+ "-"
|
||||
+ string (newUnique ())
|
||||
+ "-"
|
||||
+ string (hash reflectedDefinitionBytes)
|
||||
|
||||
let reflectedDefinitionAttrs =
|
||||
let qf = QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat tcGlobals
|
||||
let qf =
|
||||
QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat tcGlobals
|
||||
|
||||
if qf.SupportsDeserializeEx then
|
||||
[ mkCompilationMappingAttrForQuotationResource tcGlobals (reflectedDefinitionResourceName, referencedTypeDefs) ]
|
||||
[
|
||||
mkCompilationMappingAttrForQuotationResource tcGlobals (reflectedDefinitionResourceName, referencedTypeDefs)
|
||||
]
|
||||
else
|
||||
[ ]
|
||||
[]
|
||||
|
||||
let reflectedDefinitionResource =
|
||||
{ Name=reflectedDefinitionResourceName
|
||||
Location = ILResourceLocation.Local(ByteStorage.FromByteArray(reflectedDefinitionBytes))
|
||||
Access= ILResourceAccess.Public
|
||||
CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
|
||||
MetadataIndex = NoMetadataIdx }
|
||||
{
|
||||
Name = reflectedDefinitionResourceName
|
||||
Location = ILResourceLocation.Local(ByteStorage.FromByteArray(reflectedDefinitionBytes))
|
||||
Access = ILResourceAccess.Public
|
||||
CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
|
||||
MetadataIndex = NoMetadataIdx
|
||||
}
|
||||
|
||||
reflectedDefinitionAttrs, reflectedDefinitionResource)
|
||||
|> List.unzip
|
||||
|> (fun (attrs, resource) -> List.concat attrs, resource)
|
||||
|
||||
let manifestAttrs =
|
||||
mkILCustomAttrs
|
||||
[ if not tcConfig.internConstantStrings then
|
||||
yield mkILCustomAttribute (tcGlobals.FindSysILTypeRef "System.Runtime.CompilerServices.CompilationRelaxationsAttribute", [tcGlobals.ilg.typ_Int32], [ILAttribElem.Int32( 8)], [])
|
||||
yield! sigDataAttributes
|
||||
yield! codegenResults.ilAssemAttrs
|
||||
[
|
||||
if not tcConfig.internConstantStrings then
|
||||
mkILCustomAttribute (
|
||||
tcGlobals.FindSysILTypeRef "System.Runtime.CompilerServices.CompilationRelaxationsAttribute",
|
||||
[ tcGlobals.ilg.typ_Int32 ],
|
||||
[ ILAttribElem.Int32(8) ],
|
||||
[]
|
||||
)
|
||||
yield! sigDataAttributes
|
||||
yield! codegenResults.ilAssemAttrs
|
||||
|
||||
if Option.isSome pdbfile then
|
||||
yield (tcGlobals.mkDebuggableAttributeV2 (tcConfig.jitTracking, tcConfig.ignoreSymbolStoreSequencePoints, disableJitOptimizations, false (* enableEnC *) ))
|
||||
yield! reflectedDefinitionAttrs ]
|
||||
if Option.isSome pdbfile then
|
||||
tcGlobals.mkDebuggableAttributeV2 (
|
||||
tcConfig.jitTracking,
|
||||
tcConfig.ignoreSymbolStoreSequencePoints,
|
||||
disableJitOptimizations,
|
||||
false (* enableEnC *)
|
||||
)
|
||||
yield! reflectedDefinitionAttrs
|
||||
]
|
||||
|
||||
// Make the manifest of the assembly
|
||||
let manifest =
|
||||
if tcConfig.target = CompilerTarget.Module then None else
|
||||
let man = mainModule.ManifestOfAssembly
|
||||
let ver =
|
||||
match assemVerFromAttrib with
|
||||
| None -> tcVersion
|
||||
| Some v -> v
|
||||
Some { man with Version= Some ver
|
||||
CustomAttrsStored = storeILCustomAttrs manifestAttrs
|
||||
DisableJitOptimizations=disableJitOptimizations
|
||||
JitTracking= tcConfig.jitTracking
|
||||
IgnoreSymbolStoreSequencePoints = tcConfig.ignoreSymbolStoreSequencePoints
|
||||
SecurityDeclsStored=storeILSecurityDecls secDecls }
|
||||
if tcConfig.target = CompilerTarget.Module then
|
||||
None
|
||||
else
|
||||
let man = mainModule.ManifestOfAssembly
|
||||
|
||||
let ver =
|
||||
match assemVerFromAttrib with
|
||||
| None -> tcVersion
|
||||
| Some v -> v
|
||||
|
||||
Some
|
||||
{ man with
|
||||
Version = Some ver
|
||||
CustomAttrsStored = storeILCustomAttrs manifestAttrs
|
||||
DisableJitOptimizations = disableJitOptimizations
|
||||
JitTracking = tcConfig.jitTracking
|
||||
IgnoreSymbolStoreSequencePoints = tcConfig.ignoreSymbolStoreSequencePoints
|
||||
SecurityDeclsStored = storeILSecurityDecls secDecls
|
||||
}
|
||||
|
||||
let resources =
|
||||
mkILResources
|
||||
[ for file in tcConfig.embedResources do
|
||||
let name, bytes, pub =
|
||||
let file, name, pub = TcConfigBuilder.SplitCommandLineResourceInfo file
|
||||
let file = tcConfig.ResolveSourceFile(rangeStartup, file, tcConfig.implicitIncludeDir)
|
||||
let bytes = FileSystem.OpenFileForReadShim(file).ReadAllBytes()
|
||||
name, bytes, pub
|
||||
yield { Name=name
|
||||
// TODO: We probably can directly convert ByteMemory to ByteStorage, without reading all bytes.
|
||||
Location=ILResourceLocation.Local(ByteStorage.FromByteArray(bytes))
|
||||
Access=pub
|
||||
CustomAttrsStored=storeILCustomAttrs emptyILCustomAttrs
|
||||
MetadataIndex = NoMetadataIdx }
|
||||
mkILResources
|
||||
[
|
||||
for file in tcConfig.embedResources do
|
||||
let name, bytes, pub =
|
||||
let file, name, pub = TcConfigBuilder.SplitCommandLineResourceInfo file
|
||||
|
||||
yield! reflectedDefinitionResources
|
||||
yield! sigDataResources
|
||||
yield! optDataResources
|
||||
for ri in tcConfig.linkResources do
|
||||
let file, name, pub = TcConfigBuilder.SplitCommandLineResourceInfo ri
|
||||
yield { Name=name
|
||||
Location=ILResourceLocation.File(ILModuleRef.Create(name=file, hasMetadata=false, hash=Some (sha1HashBytes (FileSystem.OpenFileForReadShim(file).ReadAllBytes()))), 0)
|
||||
Access=pub
|
||||
CustomAttrsStored=storeILCustomAttrs emptyILCustomAttrs
|
||||
MetadataIndex = NoMetadataIdx } ]
|
||||
let file =
|
||||
tcConfig.ResolveSourceFile(rangeStartup, file, tcConfig.implicitIncludeDir)
|
||||
|
||||
let bytes = FileSystem.OpenFileForReadShim(file).ReadAllBytes()
|
||||
name, bytes, pub
|
||||
|
||||
{
|
||||
Name = name
|
||||
// TODO: We probably can directly convert ByteMemory to ByteStorage, without reading all bytes.
|
||||
Location = ILResourceLocation.Local(ByteStorage.FromByteArray(bytes))
|
||||
Access = pub
|
||||
CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
|
||||
MetadataIndex = NoMetadataIdx
|
||||
}
|
||||
|
||||
yield! reflectedDefinitionResources
|
||||
yield! sigDataResources
|
||||
yield! optDataResources
|
||||
for ri in tcConfig.linkResources do
|
||||
let file, name, pub = TcConfigBuilder.SplitCommandLineResourceInfo ri
|
||||
|
||||
let location =
|
||||
ILResourceLocation.File(
|
||||
ILModuleRef.Create(
|
||||
name = file,
|
||||
hasMetadata = false,
|
||||
hash = Some(sha1HashBytes (FileSystem.OpenFileForReadShim(file).ReadAllBytes()))
|
||||
),
|
||||
0
|
||||
)
|
||||
|
||||
{
|
||||
Name = name
|
||||
Location = location
|
||||
Access = pub
|
||||
CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
|
||||
MetadataIndex = NoMetadataIdx
|
||||
}
|
||||
]
|
||||
|
||||
let assemblyVersion =
|
||||
match tcConfig.version with
|
||||
|
|
@ -362,7 +485,7 @@ module MainModuleBuilder =
|
|||
| Some assemblyVersion ->
|
||||
let FindAttribute key attrib =
|
||||
match findAttribute attrib with
|
||||
| Some text -> [(key, text)]
|
||||
| Some text -> [ (key, text) ]
|
||||
| _ -> []
|
||||
|
||||
let fileVersionInfo = ComputeILFileVersion findAttribute assemblyVersion
|
||||
|
|
@ -370,26 +493,33 @@ module MainModuleBuilder =
|
|||
let productVersionString = ComputeProductVersion findAttribute fileVersionInfo
|
||||
|
||||
let stringFileInfo =
|
||||
// 000004b0:
|
||||
// Specifies an 8-digit hexadecimal number stored as a Unicode string. The
|
||||
// four most significant digits represent the language identifier. The four least
|
||||
// significant digits represent the code page for which the data is formatted.
|
||||
// Each Microsoft Standard Language identifier contains two parts: the low-order 10 bits
|
||||
// specify the major language, and the high-order 6 bits specify the sublanguage.
|
||||
// For a table of valid identifiers see Language Identifiers. //
|
||||
// see e.g. http://msdn.microsoft.com/en-us/library/aa912040.aspx 0000 is neutral and 04b0(hex)=1252(dec) is the code page.
|
||||
[ ("000004b0", [ yield ("Assembly Version", (sprintf "%d.%d.%d.%d" assemblyVersion.Major assemblyVersion.Minor assemblyVersion.Build assemblyVersion.Revision))
|
||||
yield ("FileVersion", (sprintf "%d.%d.%d.%d" fileVersionInfo.Major fileVersionInfo.Minor fileVersionInfo.Build fileVersionInfo.Revision))
|
||||
yield ("ProductVersion", productVersionString)
|
||||
match tcConfig.outputFile with
|
||||
| Some f -> yield ("OriginalFilename", Path.GetFileName f)
|
||||
| None -> ()
|
||||
yield! FindAttribute "Comments" "System.Reflection.AssemblyDescriptionAttribute"
|
||||
yield! FindAttribute "FileDescription" "System.Reflection.AssemblyTitleAttribute"
|
||||
yield! FindAttribute "ProductName" "System.Reflection.AssemblyProductAttribute"
|
||||
yield! FindAttribute "CompanyName" "System.Reflection.AssemblyCompanyAttribute"
|
||||
yield! FindAttribute "LegalCopyright" "System.Reflection.AssemblyCopyrightAttribute"
|
||||
yield! FindAttribute "LegalTrademarks" "System.Reflection.AssemblyTrademarkAttribute" ]) ]
|
||||
// 000004b0:
|
||||
// Specifies an 8-digit hexadecimal number stored as a Unicode string. The
|
||||
// four most significant digits represent the language identifier. The four least
|
||||
// significant digits represent the code page for which the data is formatted.
|
||||
// Each Microsoft Standard Language identifier contains two parts: the low-order 10 bits
|
||||
// specify the major language, and the high-order 6 bits specify the sublanguage.
|
||||
// For a table of valid identifiers see Language Identifiers. //
|
||||
// see e.g. http://msdn.microsoft.com/en-us/library/aa912040.aspx 0000 is neutral and 04b0(hex)=1252(dec) is the code page.
|
||||
[
|
||||
("000004b0",
|
||||
[
|
||||
("Assembly Version",
|
||||
$"%d{assemblyVersion.Major}.%d{assemblyVersion.Minor}.%d{assemblyVersion.Build}.%d{assemblyVersion.Revision}")
|
||||
("FileVersion",
|
||||
$"%d{fileVersionInfo.Major}.%d{fileVersionInfo.Minor}.%d{fileVersionInfo.Build}.%d{fileVersionInfo.Revision}")
|
||||
("ProductVersion", productVersionString)
|
||||
match tcConfig.outputFile with
|
||||
| Some f -> ("OriginalFilename", Path.GetFileName f)
|
||||
| None -> ()
|
||||
yield! FindAttribute "Comments" "System.Reflection.AssemblyDescriptionAttribute"
|
||||
yield! FindAttribute "FileDescription" "System.Reflection.AssemblyTitleAttribute"
|
||||
yield! FindAttribute "ProductName" "System.Reflection.AssemblyProductAttribute"
|
||||
yield! FindAttribute "CompanyName" "System.Reflection.AssemblyCompanyAttribute"
|
||||
yield! FindAttribute "LegalCopyright" "System.Reflection.AssemblyCopyrightAttribute"
|
||||
yield! FindAttribute "LegalTrademarks" "System.Reflection.AssemblyTrademarkAttribute"
|
||||
])
|
||||
]
|
||||
|
||||
// These entries listed in the MSDN documentation as "standard" string entries are not yet settable
|
||||
|
||||
|
|
@ -421,7 +551,7 @@ module MainModuleBuilder =
|
|||
// Either high-order or low-order word can be zero, indicating that
|
||||
// the file is language or code page independent. If the Var structure is
|
||||
// omitted, the file will be interpreted as both language and code page independent. "
|
||||
let varFileInfo = [ (0x0, 0x04b0) ]
|
||||
let varFileInfo = [ (0x0, 0x04b0) ]
|
||||
|
||||
let fixedFileInfo =
|
||||
let dwFileFlagsMask = 0x3f // REVIEW: HARDWIRED
|
||||
|
|
@ -430,71 +560,127 @@ module MainModuleBuilder =
|
|||
let dwFileType = 0x01 // REVIEW: HARDWIRED
|
||||
let dwFileSubtype = 0x00 // REVIEW: HARDWIRED
|
||||
let lwFileDate = 0x00L // REVIEW: HARDWIRED
|
||||
(fileVersionInfo, productVersionString |> ConvertProductVersionToILVersionInfo, dwFileFlagsMask, dwFileFlags, dwFileOS, dwFileType, dwFileSubtype, lwFileDate)
|
||||
let ilProductVersion = productVersionString |> ConvertProductVersionToILVersionInfo
|
||||
(fileVersionInfo, ilProductVersion, dwFileFlagsMask, dwFileFlags, dwFileOS, dwFileType, dwFileSubtype, lwFileDate)
|
||||
|
||||
let vsVersionInfoResource =
|
||||
VersionResourceFormat.VS_VERSION_INFO_RESOURCE(fixedFileInfo, stringFileInfo, varFileInfo)
|
||||
|
||||
let resource =
|
||||
[| yield! ResFileFormat.ResFileHeader()
|
||||
yield! vsVersionInfoResource |]
|
||||
[| yield! ResFileFormat.ResFileHeader(); yield! vsVersionInfoResource |]
|
||||
|
||||
[ resource ]
|
||||
|
||||
// a user cannot specify both win32res and win32manifest
|
||||
if not(tcConfig.win32manifest = "") && not(tcConfig.win32res = "") then
|
||||
error(Error(FSComp.SR.fscTwoResourceManifests(), rangeCmdArgs))
|
||||
if not (tcConfig.win32manifest = "") && not (tcConfig.win32res = "") then
|
||||
error (Error(FSComp.SR.fscTwoResourceManifests (), rangeCmdArgs))
|
||||
|
||||
let win32Manifest =
|
||||
// use custom manifest if provided
|
||||
if not(tcConfig.win32manifest = "") then tcConfig.win32manifest
|
||||
if not (tcConfig.win32manifest = "") then
|
||||
tcConfig.win32manifest
|
||||
|
||||
// don't embed a manifest if target is not an exe, if manifest is specifically excluded, if another native resource is being included, or if running on mono
|
||||
elif not(tcConfig.target.IsExe) || not(tcConfig.includewin32manifest) || not(tcConfig.win32res = "") || runningOnMono then ""
|
||||
elif not (tcConfig.target.IsExe)
|
||||
|| not (tcConfig.includewin32manifest)
|
||||
|| not (tcConfig.win32res = "")
|
||||
|| runningOnMono then
|
||||
""
|
||||
// otherwise, include the default manifest
|
||||
else
|
||||
let path=Path.Combine(FSharpEnvironment.getFSharpCompilerLocation(), @"default.win32manifest")
|
||||
let path =
|
||||
Path.Combine(FSharpEnvironment.getFSharpCompilerLocation (), @"default.win32manifest")
|
||||
|
||||
if FileSystem.FileExistsShim(path) then
|
||||
path
|
||||
else
|
||||
let path = Path.Combine(AppContext.BaseDirectory, @"default.win32manifest")
|
||||
|
||||
if FileSystem.FileExistsShim(path) then
|
||||
path
|
||||
else
|
||||
Path.Combine(System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(), @"default.win32manifest")
|
||||
|
||||
let nativeResources =
|
||||
[ for av in assemblyVersionResources assemblyVersion do
|
||||
yield ILNativeResource.Out av
|
||||
if not(tcConfig.win32res = "") then
|
||||
yield ILNativeResource.Out (FileSystem.OpenFileForReadShim(tcConfig.win32res).ReadAllBytes())
|
||||
if tcConfig.includewin32manifest && not(win32Manifest = "") && not runningOnMono then
|
||||
yield ILNativeResource.Out [| yield! ResFileFormat.ResFileHeader()
|
||||
yield! (ManifestResourceFormat.VS_MANIFEST_RESOURCE((FileSystem.OpenFileForReadShim(win32Manifest).ReadAllBytes()), tcConfig.target = CompilerTarget.Dll)) |]
|
||||
if tcConfig.win32res = "" && tcConfig.win32icon <> "" && tcConfig.target <> CompilerTarget.Dll then
|
||||
use ms = new MemoryStream()
|
||||
use iconStream = FileSystem.OpenFileForReadShim(tcConfig.win32icon)
|
||||
Win32ResourceConversions.AppendIconToResourceStream(ms, iconStream)
|
||||
yield ILNativeResource.Out [| yield! ResFileFormat.ResFileHeader()
|
||||
yield! ms.ToArray() |] ]
|
||||
[
|
||||
for av in assemblyVersionResources assemblyVersion do
|
||||
ILNativeResource.Out av
|
||||
if not (tcConfig.win32res = "") then
|
||||
ILNativeResource.Out(FileSystem.OpenFileForReadShim(tcConfig.win32res).ReadAllBytes())
|
||||
if tcConfig.includewin32manifest && not (win32Manifest = "") && not runningOnMono then
|
||||
ILNativeResource.Out
|
||||
[|
|
||||
yield! ResFileFormat.ResFileHeader()
|
||||
yield!
|
||||
(ManifestResourceFormat.VS_MANIFEST_RESOURCE(
|
||||
(FileSystem.OpenFileForReadShim(win32Manifest).ReadAllBytes()),
|
||||
tcConfig.target = CompilerTarget.Dll
|
||||
))
|
||||
|]
|
||||
if tcConfig.win32res = ""
|
||||
&& tcConfig.win32icon <> ""
|
||||
&& tcConfig.target <> CompilerTarget.Dll then
|
||||
use ms = new MemoryStream()
|
||||
use iconStream = FileSystem.OpenFileForReadShim(tcConfig.win32icon)
|
||||
Win32ResourceConversions.AppendIconToResourceStream(ms, iconStream)
|
||||
ILNativeResource.Out [| yield! ResFileFormat.ResFileHeader(); yield! ms.ToArray() |]
|
||||
]
|
||||
|
||||
let name =
|
||||
if tcConfig.target = CompilerTarget.Module then
|
||||
FileSystemUtils.fileNameOfPath outfile
|
||||
else
|
||||
mainModule.Name
|
||||
|
||||
let imageBase =
|
||||
match tcConfig.baseAddress with
|
||||
| None -> 0x00400000l
|
||||
| Some b -> b
|
||||
|
||||
let isDLL =
|
||||
(tcConfig.target = CompilerTarget.Dll || tcConfig.target = CompilerTarget.Module)
|
||||
|
||||
let is32bit =
|
||||
match tcConfig.platform with
|
||||
| Some X86
|
||||
| Some ARM -> true
|
||||
| _ -> false
|
||||
|
||||
let is64bit =
|
||||
match tcConfig.platform with
|
||||
| Some AMD64
|
||||
| Some IA64
|
||||
| Some ARM64 -> true
|
||||
| _ -> false
|
||||
|
||||
let is32BitPreferred =
|
||||
if tcConfig.prefer32Bit && not tcConfig.target.IsExe then
|
||||
(error (Error(FSComp.SR.invalidPlatformTarget (), rangeCmdArgs)))
|
||||
else
|
||||
tcConfig.prefer32Bit
|
||||
|
||||
let attribs =
|
||||
storeILCustomAttrs (
|
||||
mkILCustomAttrs
|
||||
[
|
||||
if tcConfig.target = CompilerTarget.Module then
|
||||
yield! sigDataAttributes
|
||||
yield! codegenResults.ilNetModuleAttrs
|
||||
]
|
||||
)
|
||||
// Add attributes, version number, resources etc.
|
||||
{mainModule with
|
||||
StackReserveSize = tcConfig.stackReserveSize
|
||||
Name = (if tcConfig.target = CompilerTarget.Module then FileSystemUtils.fileNameOfPath outfile else mainModule.Name)
|
||||
SubSystemFlags = (if tcConfig.target = CompilerTarget.WinExe then 2 else 3)
|
||||
Resources= resources
|
||||
ImageBase = (match tcConfig.baseAddress with None -> 0x00400000l | Some b -> b)
|
||||
IsDLL=(tcConfig.target = CompilerTarget.Dll || tcConfig.target=CompilerTarget.Module)
|
||||
Platform = tcConfig.platform
|
||||
Is32Bit=(match tcConfig.platform with Some X86 | Some ARM -> true | _ -> false)
|
||||
Is64Bit=(match tcConfig.platform with Some AMD64 | Some IA64 | Some ARM64 -> true | _ -> false)
|
||||
Is32BitPreferred = if tcConfig.prefer32Bit && not tcConfig.target.IsExe then (error(Error(FSComp.SR.invalidPlatformTarget(), rangeCmdArgs))) else tcConfig.prefer32Bit
|
||||
CustomAttrsStored=
|
||||
storeILCustomAttrs
|
||||
(mkILCustomAttrs
|
||||
[ if tcConfig.target = CompilerTarget.Module then
|
||||
yield! sigDataAttributes
|
||||
yield! codegenResults.ilNetModuleAttrs ])
|
||||
NativeResources=nativeResources
|
||||
Manifest = manifest }
|
||||
{ mainModule with
|
||||
StackReserveSize = tcConfig.stackReserveSize
|
||||
Name = name
|
||||
SubSystemFlags = (if tcConfig.target = CompilerTarget.WinExe then 2 else 3)
|
||||
Resources = resources
|
||||
ImageBase = imageBase
|
||||
IsDLL = isDLL
|
||||
Platform = tcConfig.platform
|
||||
Is32Bit = is32bit
|
||||
Is64Bit = is64bit
|
||||
Is32BitPreferred = is32BitPreferred
|
||||
CustomAttrsStored = attribs
|
||||
NativeResources = nativeResources
|
||||
Manifest = manifest
|
||||
}
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -20,11 +20,16 @@ open FSharp.Compiler.TypedTreeOps
|
|||
|
||||
let mutable showTermFileCount = 0
|
||||
|
||||
let PrintWholeAssemblyImplementation g (tcConfig:TcConfig) outfile header expr =
|
||||
let PrintWholeAssemblyImplementation g (tcConfig: TcConfig) outfile header expr =
|
||||
if tcConfig.showTerms then
|
||||
if tcConfig.writeTermsToFiles then
|
||||
let fileName = outfile + ".terms"
|
||||
use f = FileSystem.OpenFileForWriteShim(fileName + "-" + string showTermFileCount + "-" + header, FileMode.Create).GetWriter()
|
||||
|
||||
use f =
|
||||
FileSystem
|
||||
.OpenFileForWriteShim(fileName + "-" + string showTermFileCount + "-" + header, FileMode.Create)
|
||||
.GetWriter()
|
||||
|
||||
showTermFileCount <- showTermFileCount + 1
|
||||
LayoutRender.outL f (Display.squashTo 192 (DebugPrint.implFilesL g expr))
|
||||
else
|
||||
|
|
@ -37,13 +42,24 @@ let AddExternalCcuToOptimizationEnv tcGlobals optEnv (ccuinfo: ImportedAssembly)
|
|||
| None -> optEnv
|
||||
| Some data -> Optimizer.BindCcu ccuinfo.FSharpViewOfMetadata data optEnv tcGlobals
|
||||
|
||||
let GetInitialOptimizationEnv (tcImports:TcImports, tcGlobals:TcGlobals) =
|
||||
let GetInitialOptimizationEnv (tcImports: TcImports, tcGlobals: TcGlobals) =
|
||||
let ccuinfos = tcImports.GetImportedAssemblies()
|
||||
let optEnv = Optimizer.IncrementalOptimizationEnv.Empty
|
||||
let optEnv = List.fold (AddExternalCcuToOptimizationEnv tcGlobals) optEnv ccuinfos
|
||||
optEnv
|
||||
|
||||
let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importMap, isIncrementalFragment, optEnv, ccu:CcuThunk, implFiles) =
|
||||
let ApplyAllOptimizations
|
||||
(
|
||||
tcConfig: TcConfig,
|
||||
tcGlobals,
|
||||
tcVal,
|
||||
outfile,
|
||||
importMap,
|
||||
isIncrementalFragment,
|
||||
optEnv,
|
||||
ccu: CcuThunk,
|
||||
implFiles
|
||||
) =
|
||||
// NOTE: optEnv - threads through
|
||||
//
|
||||
// Always optimize once - the results of this step give the x-module optimization
|
||||
|
|
@ -52,7 +68,9 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
|
|||
PrintWholeAssemblyImplementation tcGlobals tcConfig outfile "pass-start" implFiles
|
||||
#if DEBUG
|
||||
if tcConfig.showOptimizationData then
|
||||
dprintf "Expression prior to optimization:\n%s\n" (LayoutRender.showL (Display.squashTo 192 (DebugPrint.implFilesL tcGlobals implFiles)))
|
||||
dprintf
|
||||
"Expression prior to optimization:\n%s\n"
|
||||
(LayoutRender.showL (Display.squashTo 192 (DebugPrint.implFilesL tcGlobals implFiles)))
|
||||
|
||||
if tcConfig.showOptimizationData then
|
||||
dprintf "CCU prior to optimization:\n%s\n" (LayoutRender.showL (Display.squashTo 192 (DebugPrint.entityL tcGlobals ccu.Contents)))
|
||||
|
|
@ -63,8 +81,16 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
|
|||
|
||||
// Only do abstract_big_targets on the first pass! Only do it when TLR is on!
|
||||
let optSettings = tcConfig.optSettings
|
||||
let optSettings = { optSettings with abstractBigTargets = tcConfig.doTLR }
|
||||
let optSettings = { optSettings with reportingPhase = true }
|
||||
|
||||
let optSettings =
|
||||
{ optSettings with
|
||||
abstractBigTargets = tcConfig.doTLR
|
||||
}
|
||||
|
||||
let optSettings =
|
||||
{ optSettings with
|
||||
reportingPhase = true
|
||||
}
|
||||
|
||||
let results, (optEnvFirstLoop, _, _, _) =
|
||||
((optEnv0, optEnv0, optEnv0, SignatureHidingInfo.Empty), implFiles)
|
||||
|
|
@ -73,18 +99,33 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
|
|||
|
||||
//ReportTime tcConfig ("Initial simplify")
|
||||
let (optEnvFirstLoop, implFile, implFileOptData, hidden), optimizeDuringCodeGen =
|
||||
Optimizer.OptimizeImplFile
|
||||
(optSettings, ccu, tcGlobals, tcVal, importMap,
|
||||
optEnvFirstLoop, isIncrementalFragment, tcConfig.fsiMultiAssemblyEmit,
|
||||
tcConfig.emitTailcalls, hidden, implFile)
|
||||
Optimizer.OptimizeImplFile(
|
||||
optSettings,
|
||||
ccu,
|
||||
tcGlobals,
|
||||
tcVal,
|
||||
importMap,
|
||||
optEnvFirstLoop,
|
||||
isIncrementalFragment,
|
||||
tcConfig.fsiMultiAssemblyEmit,
|
||||
tcConfig.emitTailcalls,
|
||||
hidden,
|
||||
implFile
|
||||
)
|
||||
|
||||
let implFile = LowerLocalMutables.TransformImplFile tcGlobals importMap implFile
|
||||
|
||||
// Only do this on the first pass!
|
||||
let optSettings = { optSettings with abstractBigTargets = false; reportingPhase = false }
|
||||
let optSettings =
|
||||
{ optSettings with
|
||||
abstractBigTargets = false
|
||||
reportingPhase = false
|
||||
}
|
||||
#if DEBUG
|
||||
if tcConfig.showOptimizationData then
|
||||
dprintf "Optimization implFileOptData:\n%s\n" (LayoutRender.showL (Display.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData)))
|
||||
dprintf
|
||||
"Optimization implFileOptData:\n%s\n"
|
||||
(LayoutRender.showL (Display.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData)))
|
||||
#endif
|
||||
|
||||
let implFile, optEnvExtraLoop =
|
||||
|
|
@ -92,10 +133,19 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
|
|||
|
||||
//ReportTime tcConfig ("Extra simplification loop")
|
||||
let (optEnvExtraLoop, implFile, _, _), _ =
|
||||
Optimizer.OptimizeImplFile
|
||||
(optSettings, ccu, tcGlobals, tcVal, importMap,
|
||||
optEnvExtraLoop, isIncrementalFragment, tcConfig.fsiMultiAssemblyEmit,
|
||||
tcConfig.emitTailcalls, hidden, implFile)
|
||||
Optimizer.OptimizeImplFile(
|
||||
optSettings,
|
||||
ccu,
|
||||
tcGlobals,
|
||||
tcVal,
|
||||
importMap,
|
||||
optEnvExtraLoop,
|
||||
isIncrementalFragment,
|
||||
tcConfig.fsiMultiAssemblyEmit,
|
||||
tcConfig.emitTailcalls,
|
||||
hidden,
|
||||
implFile
|
||||
)
|
||||
|
||||
//PrintWholeAssemblyImplementation tcConfig outfile (sprintf "extra-loop-%d" n) implFile
|
||||
implFile, optEnvExtraLoop
|
||||
|
|
@ -108,24 +158,36 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
|
|||
let implFile = implFile |> Detuple.DetupleImplFile ccu tcGlobals
|
||||
//PrintWholeAssemblyImplementation tcConfig outfile "post-detuple" implFile
|
||||
implFile
|
||||
else implFile
|
||||
else
|
||||
implFile
|
||||
|
||||
let implFile =
|
||||
if tcConfig.doTLR then
|
||||
implFile |> InnerLambdasToTopLevelFuncs.MakeTopLevelRepresentationDecisions ccu tcGlobals
|
||||
else implFile
|
||||
implFile
|
||||
|> InnerLambdasToTopLevelFuncs.MakeTopLevelRepresentationDecisions ccu tcGlobals
|
||||
else
|
||||
implFile
|
||||
|
||||
let implFile =
|
||||
LowerCalls.LowerImplFile tcGlobals implFile
|
||||
let implFile = LowerCalls.LowerImplFile tcGlobals implFile
|
||||
|
||||
let implFile, optEnvFinalSimplify =
|
||||
if tcConfig.doFinalSimplify then
|
||||
|
||||
//ReportTime tcConfig ("Final simplify pass")
|
||||
let (optEnvFinalSimplify, implFile, _, _), _ =
|
||||
Optimizer.OptimizeImplFile
|
||||
(optSettings, ccu, tcGlobals, tcVal, importMap, optEnvFinalSimplify,
|
||||
isIncrementalFragment, tcConfig.fsiMultiAssemblyEmit, tcConfig.emitTailcalls, hidden, implFile)
|
||||
Optimizer.OptimizeImplFile(
|
||||
optSettings,
|
||||
ccu,
|
||||
tcGlobals,
|
||||
tcVal,
|
||||
importMap,
|
||||
optEnvFinalSimplify,
|
||||
isIncrementalFragment,
|
||||
tcConfig.fsiMultiAssemblyEmit,
|
||||
tcConfig.emitTailcalls,
|
||||
hidden,
|
||||
implFile
|
||||
)
|
||||
|
||||
//PrintWholeAssemblyImplementation tcConfig outfile "post-rec-opt" implFile
|
||||
implFile, optEnvFinalSimplify
|
||||
|
|
@ -133,8 +195,10 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
|
|||
implFile, optEnvFinalSimplify
|
||||
|
||||
let implFile =
|
||||
{ ImplFile = implFile
|
||||
OptimizeDuringCodeGen = optimizeDuringCodeGen }
|
||||
{
|
||||
ImplFile = implFile
|
||||
OptimizeDuringCodeGen = optimizeDuringCodeGen
|
||||
}
|
||||
|
||||
(implFile, implFileOptData), (optEnvFirstLoop, optEnvExtraLoop, optEnvFinalSimplify, hidden))
|
||||
|
||||
|
|
@ -149,17 +213,20 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
|
|||
// ILX generation
|
||||
//----------------------------------------------------------------------------
|
||||
|
||||
let CreateIlxAssemblyGenerator (_tcConfig:TcConfig, tcImports:TcImports, tcGlobals, tcVal, generatedCcu) =
|
||||
let ilxGenerator = IlxAssemblyGenerator(tcImports.GetImportMap(), tcGlobals, tcVal, generatedCcu)
|
||||
let CreateIlxAssemblyGenerator (_tcConfig: TcConfig, tcImports: TcImports, tcGlobals, tcVal, generatedCcu) =
|
||||
let ilxGenerator =
|
||||
IlxAssemblyGenerator(tcImports.GetImportMap(), tcGlobals, tcVal, generatedCcu)
|
||||
|
||||
let ccus = tcImports.GetCcusInDeclOrder()
|
||||
ilxGenerator.AddExternalCcus ccus
|
||||
ilxGenerator
|
||||
|
||||
let GenerateIlxCode (
|
||||
let GenerateIlxCode
|
||||
(
|
||||
ilxBackend,
|
||||
isInteractiveItExpr,
|
||||
isInteractiveOnMono,
|
||||
tcConfig:TcConfig,
|
||||
tcConfig: TcConfig,
|
||||
topAttrs: TopAttribs,
|
||||
optimizedImpls,
|
||||
fragName,
|
||||
|
|
@ -167,35 +234,39 @@ let GenerateIlxCode (
|
|||
) =
|
||||
|
||||
let mainMethodInfo =
|
||||
if (tcConfig.target = CompilerTarget.Dll) || (tcConfig.target = CompilerTarget.Module) then
|
||||
None
|
||||
else Some topAttrs.mainMethodAttrs
|
||||
if (tcConfig.target = CompilerTarget.Dll)
|
||||
|| (tcConfig.target = CompilerTarget.Module) then
|
||||
None
|
||||
else
|
||||
Some topAttrs.mainMethodAttrs
|
||||
|
||||
let ilxGenOpts: IlxGenOptions =
|
||||
{ generateFilterBlocks = tcConfig.generateFilterBlocks
|
||||
emitConstantArraysUsingStaticDataBlobs = not isInteractiveOnMono
|
||||
workAroundReflectionEmitBugs = tcConfig.isInteractive
|
||||
generateDebugSymbols = tcConfig.debuginfo
|
||||
fragName = fragName
|
||||
localOptimizationsEnabled= tcConfig.optSettings.LocalOptimizationsEnabled
|
||||
testFlagEmitFeeFeeAs100001 = tcConfig.testFlagEmitFeeFeeAs100001
|
||||
mainMethodInfo= mainMethodInfo
|
||||
ilxBackend = ilxBackend
|
||||
fsiMultiAssemblyEmit = tcConfig.fsiMultiAssemblyEmit
|
||||
isInteractive = tcConfig.isInteractive
|
||||
isInteractiveItExpr = isInteractiveItExpr
|
||||
alwaysCallVirt = tcConfig.alwaysCallVirt }
|
||||
{
|
||||
generateFilterBlocks = tcConfig.generateFilterBlocks
|
||||
emitConstantArraysUsingStaticDataBlobs = not isInteractiveOnMono
|
||||
workAroundReflectionEmitBugs = tcConfig.isInteractive
|
||||
generateDebugSymbols = tcConfig.debuginfo
|
||||
fragName = fragName
|
||||
localOptimizationsEnabled = tcConfig.optSettings.LocalOptimizationsEnabled
|
||||
testFlagEmitFeeFeeAs100001 = tcConfig.testFlagEmitFeeFeeAs100001
|
||||
mainMethodInfo = mainMethodInfo
|
||||
ilxBackend = ilxBackend
|
||||
fsiMultiAssemblyEmit = tcConfig.fsiMultiAssemblyEmit
|
||||
isInteractive = tcConfig.isInteractive
|
||||
isInteractiveItExpr = isInteractiveItExpr
|
||||
alwaysCallVirt = tcConfig.alwaysCallVirt
|
||||
}
|
||||
|
||||
ilxGenerator.GenerateCode (ilxGenOpts, optimizedImpls, topAttrs.assemblyAttrs, topAttrs.netModuleAttrs)
|
||||
ilxGenerator.GenerateCode(ilxGenOpts, optimizedImpls, topAttrs.assemblyAttrs, topAttrs.netModuleAttrs)
|
||||
|
||||
//----------------------------------------------------------------------------
|
||||
// Assembly ref normalization: make sure all assemblies are referred to
|
||||
// by the same references. Only used for static linking.
|
||||
//----------------------------------------------------------------------------
|
||||
|
||||
let NormalizeAssemblyRefs (ctok, ilGlobals: ILGlobals, tcImports:TcImports) scoref =
|
||||
let NormalizeAssemblyRefs (ctok, ilGlobals: ILGlobals, tcImports: TcImports) scoref =
|
||||
let normalizeAssemblyRefByName nm =
|
||||
match tcImports.TryFindDllInfo (ctok, Range.rangeStartup, nm, lookupOnly=false) with
|
||||
match tcImports.TryFindDllInfo(ctok, Range.rangeStartup, nm, lookupOnly = false) with
|
||||
| Some dllInfo -> dllInfo.ILScopeRef
|
||||
| None -> scoref
|
||||
|
||||
|
|
@ -205,7 +276,12 @@ let NormalizeAssemblyRefs (ctok, ilGlobals: ILGlobals, tcImports:TcImports) scor
|
|||
| ILScopeRef.PrimaryAssembly -> normalizeAssemblyRefByName ilGlobals.primaryAssemblyName
|
||||
| ILScopeRef.Assembly aref -> normalizeAssemblyRefByName aref.Name
|
||||
|
||||
let GetGeneratedILModuleName (t:CompilerTarget) (s:string) =
|
||||
let GetGeneratedILModuleName (t: CompilerTarget) (s: string) =
|
||||
// return the name of the file as a module name
|
||||
let ext = match t with CompilerTarget.Dll -> "dll" | CompilerTarget.Module -> "netmodule" | _ -> "exe"
|
||||
let ext =
|
||||
match t with
|
||||
| CompilerTarget.Dll -> "dll"
|
||||
| CompilerTarget.Module -> "netmodule"
|
||||
| _ -> "exe"
|
||||
|
||||
s + "." + ext
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -73,26 +73,20 @@ type LoadClosure =
|
|||
LoadClosureRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list
|
||||
}
|
||||
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
type CodeContext =
|
||||
| CompilationAndEvaluation // in fsi.exe
|
||||
| Compilation // in fsc.exe
|
||||
| Compilation // in fsc.exe
|
||||
| Editing // in VS
|
||||
|
||||
module ScriptPreprocessClosure =
|
||||
|
||||
/// Represents an input to the closure finding process
|
||||
type ClosureSource =
|
||||
ClosureSource of
|
||||
fileName: string *
|
||||
referenceRange: range *
|
||||
sourceText: ISourceText *
|
||||
parseRequired: bool
|
||||
type ClosureSource = ClosureSource of fileName: string * referenceRange: range * sourceText: ISourceText * parseRequired: bool
|
||||
|
||||
/// Represents an output of the closure finding process
|
||||
type ClosureFile =
|
||||
ClosureFile of
|
||||
| ClosureFile of
|
||||
fileName: string *
|
||||
range: range *
|
||||
parsedInput: ParsedInput option *
|
||||
|
|
@ -102,12 +96,11 @@ module ScriptPreprocessClosure =
|
|||
|
||||
type Observed() =
|
||||
let seen = Dictionary<_, bool>()
|
||||
member _.SetSeen check =
|
||||
if not(seen.ContainsKey check) then
|
||||
seen.Add(check, true)
|
||||
|
||||
member _.HaveSeen check =
|
||||
seen.ContainsKey check
|
||||
member _.SetSeen check =
|
||||
if not (seen.ContainsKey check) then seen.Add(check, true)
|
||||
|
||||
member _.HaveSeen check = seen.ContainsKey check
|
||||
|
||||
/// Parse a script file (or any input file referenced by '#load')
|
||||
let ParseScriptClosureInput
|
||||
|
|
@ -127,19 +120,25 @@ module ScriptPreprocessClosure =
|
|||
// .fsx -- EDITING + !COMPILED\INTERACTIVE
|
||||
let defines =
|
||||
match codeContext with
|
||||
| CodeContext.CompilationAndEvaluation -> ["INTERACTIVE"]
|
||||
| CodeContext.Compilation -> ["COMPILED"]
|
||||
| CodeContext.Editing -> "EDITING" :: (if IsScript fileName then ["INTERACTIVE"] else ["COMPILED"])
|
||||
| CodeContext.CompilationAndEvaluation -> [ "INTERACTIVE" ]
|
||||
| CodeContext.Compilation -> [ "COMPILED" ]
|
||||
| CodeContext.Editing ->
|
||||
"EDITING"
|
||||
:: (if IsScript fileName then
|
||||
[ "INTERACTIVE" ]
|
||||
else
|
||||
[ "COMPILED" ])
|
||||
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
tcConfigB.conditionalDefines <- defines @ tcConfig.conditionalDefines
|
||||
let tcConfig = TcConfig.Create(tcConfigB, false)
|
||||
|
||||
let lexbuf = UnicodeLexing.SourceTextAsLexbuf(true, tcConfig.langVersion, sourceText)
|
||||
|
||||
let lexbuf =
|
||||
UnicodeLexing.SourceTextAsLexbuf(true, tcConfig.langVersion, sourceText)
|
||||
|
||||
// The root compiland is last in the list of compilands.
|
||||
let isLastCompiland = (IsScript fileName, tcConfig.target.IsExe)
|
||||
ParseOneInputLexbuf (tcConfig, lexResourceManager, lexbuf, fileName, isLastCompiland, diagnosticsLogger)
|
||||
ParseOneInputLexbuf(tcConfig, lexResourceManager, lexbuf, fileName, isLastCompiland, diagnosticsLogger)
|
||||
|
||||
/// Create a TcConfig for load closure starting from a single .fsx file
|
||||
let CreateScriptTextTcConfig
|
||||
|
|
@ -164,8 +163,10 @@ module ScriptPreprocessClosure =
|
|||
let isInvalidationSupported = (codeContext = CodeContext.Editing)
|
||||
|
||||
let rangeForErrors = mkFirstLineOfFile fileName
|
||||
|
||||
let tcConfigB =
|
||||
TcConfigBuilder.CreateNew(legacyReferenceResolver,
|
||||
TcConfigBuilder.CreateNew(
|
||||
legacyReferenceResolver,
|
||||
defaultFSharpBinariesDir,
|
||||
reduceMemoryUsage,
|
||||
projectDir,
|
||||
|
|
@ -174,8 +175,16 @@ module ScriptPreprocessClosure =
|
|||
CopyFSharpCoreFlag.No,
|
||||
tryGetMetadataSnapshot,
|
||||
sdkDirOverride,
|
||||
rangeForErrors)
|
||||
tcConfigB.SetPrimaryAssembly (if assumeDotNetFramework then PrimaryAssembly.Mscorlib else PrimaryAssembly.System_Runtime)
|
||||
rangeForErrors
|
||||
)
|
||||
|
||||
let primaryAssembly =
|
||||
if assumeDotNetFramework then
|
||||
PrimaryAssembly.Mscorlib
|
||||
else
|
||||
PrimaryAssembly.System_Runtime
|
||||
|
||||
tcConfigB.SetPrimaryAssembly primaryAssembly
|
||||
tcConfigB.SetUseSdkRefs useSdkRefs
|
||||
|
||||
applyCommandLineArgs tcConfigB
|
||||
|
|
@ -186,13 +195,21 @@ module ScriptPreprocessClosure =
|
|||
match basicReferences with
|
||||
| None ->
|
||||
let diagnosticsLogger = CapturingDiagnosticsLogger("ScriptDefaultReferences")
|
||||
use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> diagnosticsLogger)
|
||||
let references, useDotNetFramework = tcConfigB.FxResolver.GetDefaultReferences useFsiAuxLib
|
||||
use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger)
|
||||
|
||||
let references, useDotNetFramework =
|
||||
tcConfigB.FxResolver.GetDefaultReferences useFsiAuxLib
|
||||
|
||||
// If the user requested .NET Core scripting but something went wrong and we reverted to
|
||||
// .NET Framework scripting then we must adjust both the primaryAssembly and fxResolver
|
||||
if useDotNetFramework <> assumeDotNetFramework then
|
||||
tcConfigB.SetPrimaryAssembly (if useDotNetFramework then PrimaryAssembly.Mscorlib else PrimaryAssembly.System_Runtime)
|
||||
let primaryAssembly =
|
||||
if useDotNetFramework then
|
||||
PrimaryAssembly.Mscorlib
|
||||
else
|
||||
PrimaryAssembly.System_Runtime
|
||||
|
||||
tcConfigB.SetPrimaryAssembly primaryAssembly
|
||||
|
||||
// Add script references
|
||||
for reference in references do
|
||||
|
|
@ -203,6 +220,7 @@ module ScriptPreprocessClosure =
|
|||
| Some (rs, diagnostics) ->
|
||||
for m, reference in rs do
|
||||
tcConfigB.AddReferencedAssemblyByPath(m, reference)
|
||||
|
||||
diagnostics
|
||||
|
||||
tcConfigB.resolutionEnvironment <-
|
||||
|
|
@ -221,18 +239,20 @@ module ScriptPreprocessClosure =
|
|||
|
||||
tcConfigB.SetUseSdkRefs useSdkRefs
|
||||
|
||||
TcConfig.Create(tcConfigB, validate=true), scriptDefaultReferencesDiagnostics
|
||||
TcConfig.Create(tcConfigB, validate = true), scriptDefaultReferencesDiagnostics
|
||||
|
||||
let ClosureSourceOfFilename(fileName, m, inputCodePage, parseRequired) =
|
||||
let ClosureSourceOfFilename (fileName, m, inputCodePage, parseRequired) =
|
||||
try
|
||||
let fileName = FileSystem.GetFullPathShim fileName
|
||||
use stream = FileSystem.OpenFileForReadShim(fileName)
|
||||
|
||||
use reader =
|
||||
match inputCodePage with
|
||||
| None -> new StreamReader(stream, true)
|
||||
| Some (n: int) -> new StreamReader(stream, Encoding.GetEncoding n)
|
||||
|
||||
let source = reader.ReadToEnd()
|
||||
[ClosureSource(fileName, m, SourceText.ofString source, parseRequired)]
|
||||
[ ClosureSource(fileName, m, SourceText.ofString source, parseRequired) ]
|
||||
with exn ->
|
||||
errorRecovery exn m
|
||||
[]
|
||||
|
|
@ -247,27 +267,39 @@ module ScriptPreprocessClosure =
|
|||
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
let mutable nowarns = []
|
||||
let getWarningNumber = fun () (m, s) -> nowarns <- (s, m) :: nowarns
|
||||
let addReferenceDirective = fun () (m, s, directive) -> tcConfigB.AddReferenceDirective(dependencyProvider, m, s, directive)
|
||||
let addLoadedSource = fun () (m, s) -> tcConfigB.AddLoadedSource(m, s, pathOfMetaCommandSource)
|
||||
let getWarningNumber () (m, s) = nowarns <- (s, m) :: nowarns
|
||||
|
||||
let addReferenceDirective () (m, s, directive) =
|
||||
tcConfigB.AddReferenceDirective(dependencyProvider, m, s, directive)
|
||||
|
||||
let addLoadedSource () (m, s) =
|
||||
tcConfigB.AddLoadedSource(m, s, pathOfMetaCommandSource)
|
||||
|
||||
try
|
||||
ProcessMetaCommandsFromInput (getWarningNumber, addReferenceDirective, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ())
|
||||
ProcessMetaCommandsFromInput
|
||||
(getWarningNumber, addReferenceDirective, addLoadedSource)
|
||||
(tcConfigB, inp, pathOfMetaCommandSource, ())
|
||||
with ReportedError _ ->
|
||||
// Recover by using whatever did end up in the tcConfig
|
||||
()
|
||||
|
||||
try
|
||||
TcConfig.Create(tcConfigB, validate=false), nowarns
|
||||
TcConfig.Create(tcConfigB, validate = false), nowarns
|
||||
with ReportedError _ ->
|
||||
// Recover by using a default TcConfig.
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
TcConfig.Create(tcConfigB, validate=false), nowarns
|
||||
TcConfig.Create(tcConfigB, validate = false), nowarns
|
||||
|
||||
let getDirective d =
|
||||
match d with
|
||||
| Directive.Resolution -> "r"
|
||||
| Directive.Include -> "i"
|
||||
|
||||
let FindClosureFiles
|
||||
(
|
||||
mainFile,
|
||||
closureSources,
|
||||
origTcConfig:TcConfig,
|
||||
origTcConfig: TcConfig,
|
||||
codeContext,
|
||||
lexResourceManager: Lexhelp.LexResourceManager,
|
||||
dependencyProvider: DependencyProvider
|
||||
|
|
@ -281,165 +313,273 @@ module ScriptPreprocessClosure =
|
|||
|
||||
// Resolve the packages
|
||||
let rec resolveDependencyManagerSources scriptName =
|
||||
if not (loadScripts.Contains scriptName) then
|
||||
[ for kv in tcConfig.packageManagerLines do
|
||||
let packageManagerKey, packageManagerLines = kv.Key, kv.Value
|
||||
match packageManagerLines with
|
||||
| [] -> ()
|
||||
| { Directive=_; LineStatus=_; Line=_; Range=m } :: _ ->
|
||||
let reportError =
|
||||
ResolvingErrorReport (fun errorType err msg ->
|
||||
let error = err, msg
|
||||
match errorType with
|
||||
| ErrorReportType.Warning -> warning(Error(error, m))
|
||||
| ErrorReportType.Error -> errorR(Error(error, m)))
|
||||
[
|
||||
if not (loadScripts.Contains scriptName) then
|
||||
for kv in tcConfig.packageManagerLines do
|
||||
let packageManagerKey, packageManagerLines = kv.Key, kv.Value
|
||||
|
||||
match origTcConfig.packageManagerLines |> Map.tryFind packageManagerKey with
|
||||
| Some oldDependencyManagerLines when oldDependencyManagerLines = packageManagerLines -> ()
|
||||
| _ ->
|
||||
let outputDir = tcConfig.outputDir |> Option.defaultValue ""
|
||||
match dependencyProvider.TryFindDependencyManagerByKey(tcConfig.compilerToolPaths, outputDir, reportError, packageManagerKey) with
|
||||
| Null ->
|
||||
errorR(Error(dependencyProvider.CreatePackageManagerUnknownError(tcConfig.compilerToolPaths, outputDir, packageManagerKey, reportError), m))
|
||||
match packageManagerLines with
|
||||
| [] -> ()
|
||||
| packageManagerLine :: _ ->
|
||||
let m = packageManagerLine.Range
|
||||
yield! processPackageManagerLines m packageManagerLines scriptName packageManagerKey
|
||||
]
|
||||
|
||||
| NonNull dependencyManager ->
|
||||
let directive d =
|
||||
match d with
|
||||
| Directive.Resolution -> "r"
|
||||
| Directive.Include -> "i"
|
||||
and reportError m =
|
||||
ResolvingErrorReport(fun errorType err msg ->
|
||||
let error = err, msg
|
||||
|
||||
let packageManagerTextLines = packageManagerLines |> List.map(fun l -> directive l.Directive, l.Line)
|
||||
let tfm, rid = tcConfig.FxResolver.GetTfmAndRid()
|
||||
let result = dependencyProvider.Resolve(dependencyManager, ".fsx", packageManagerTextLines, reportError, tfm, rid, tcConfig.implicitIncludeDir, mainFile, scriptName)
|
||||
if result.Success then
|
||||
// Resolution produced no errors
|
||||
//Write outputs in F# Interactive and compiler
|
||||
if codeContext <> CodeContext.Editing then
|
||||
for line in result.StdOut do Console.Out.WriteLine(line)
|
||||
for line in result.StdError do Console.Error.WriteLine(line)
|
||||
match errorType with
|
||||
| ErrorReportType.Warning -> warning (Error(error, m))
|
||||
| ErrorReportType.Error -> errorR (Error(error, m)))
|
||||
|
||||
packageReferences[m] <- [ for script in result.SourceFiles do yield! FileSystem.OpenFileForReadShim(script).ReadLines() ]
|
||||
if not (Seq.isEmpty result.Roots) then
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
for folder in result.Roots do
|
||||
tcConfigB.AddIncludePath(m, folder, "")
|
||||
tcConfigB.packageManagerLines <- PackageManagerLine.SetLinesAsProcessed packageManagerKey tcConfigB.packageManagerLines
|
||||
tcConfig <- TcConfig.Create(tcConfigB, validate=false)
|
||||
and processPackageManagerLines m packageManagerLines scriptName packageManagerKey =
|
||||
[
|
||||
|
||||
if not (Seq.isEmpty result.Resolutions) then
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
for resolution in result.Resolutions do
|
||||
tcConfigB.AddReferencedAssemblyByPath(m, resolution)
|
||||
tcConfig <- TcConfig.Create(tcConfigB, validate = false)
|
||||
match origTcConfig.packageManagerLines |> Map.tryFind packageManagerKey with
|
||||
| Some oldDependencyManagerLines when oldDependencyManagerLines = packageManagerLines -> ()
|
||||
| _ ->
|
||||
let outputDir = tcConfig.outputDir |> Option.defaultValue ""
|
||||
|
||||
for script in result.SourceFiles do
|
||||
use stream = FileSystem.OpenFileForReadShim(script)
|
||||
let scriptText = stream.ReadAllText()
|
||||
loadScripts.Add script |> ignore
|
||||
let iSourceText = SourceText.ofString scriptText
|
||||
yield! loop (ClosureSource(script, m, iSourceText, true))
|
||||
let managerOpt =
|
||||
dependencyProvider.TryFindDependencyManagerByKey(
|
||||
tcConfig.compilerToolPaths,
|
||||
outputDir,
|
||||
reportError m,
|
||||
packageManagerKey
|
||||
)
|
||||
|
||||
else
|
||||
// Send outputs via diagnostics
|
||||
if (result.StdOut.Length > 0 || result.StdError.Length > 0) then
|
||||
for line in Array.append result.StdOut result.StdError do
|
||||
errorR(Error(FSComp.SR.packageManagerError(line), m))
|
||||
// Resolution produced errors update packagerManagerLines entries to note these failure
|
||||
// failed resolutions will no longer be considered
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
tcConfigB.packageManagerLines <- PackageManagerLine.RemoveUnprocessedLines packageManagerKey tcConfigB.packageManagerLines
|
||||
tcConfig <- TcConfig.Create(tcConfigB, validate=false)]
|
||||
else []
|
||||
match managerOpt with
|
||||
| Null ->
|
||||
let err =
|
||||
dependencyProvider.CreatePackageManagerUnknownError(
|
||||
tcConfig.compilerToolPaths,
|
||||
outputDir,
|
||||
packageManagerKey,
|
||||
reportError m
|
||||
)
|
||||
|
||||
and loop (ClosureSource(fileName, m, sourceText, parseRequired)) =
|
||||
[ if not (observedSources.HaveSeen(fileName)) then
|
||||
errorR (Error(err, m))
|
||||
|
||||
| NonNull dependencyManager ->
|
||||
yield! resolvePackageManagerLines m packageManagerLines scriptName packageManagerKey dependencyManager
|
||||
]
|
||||
|
||||
and resolvePackageManagerLines m packageManagerLines scriptName packageManagerKey dependencyManager =
|
||||
[
|
||||
let packageManagerTextLines =
|
||||
packageManagerLines |> List.map (fun l -> getDirective l.Directive, l.Line)
|
||||
|
||||
let tfm, rid = tcConfig.FxResolver.GetTfmAndRid()
|
||||
|
||||
let result =
|
||||
dependencyProvider.Resolve(
|
||||
dependencyManager,
|
||||
".fsx",
|
||||
packageManagerTextLines,
|
||||
reportError m,
|
||||
tfm,
|
||||
rid,
|
||||
tcConfig.implicitIncludeDir,
|
||||
mainFile,
|
||||
scriptName
|
||||
)
|
||||
|
||||
if result.Success then
|
||||
// Resolution produced no errors
|
||||
//Write outputs in F# Interactive and compiler
|
||||
if codeContext <> CodeContext.Editing then
|
||||
for line in result.StdOut do
|
||||
Console.Out.WriteLine(line)
|
||||
|
||||
for line in result.StdError do
|
||||
Console.Error.WriteLine(line)
|
||||
|
||||
packageReferences[m] <-
|
||||
[
|
||||
for script in result.SourceFiles do
|
||||
yield! FileSystem.OpenFileForReadShim(script).ReadLines()
|
||||
]
|
||||
|
||||
if not (Seq.isEmpty result.Roots) then
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
|
||||
for folder in result.Roots do
|
||||
tcConfigB.AddIncludePath(m, folder, "")
|
||||
|
||||
tcConfigB.packageManagerLines <-
|
||||
PackageManagerLine.SetLinesAsProcessed packageManagerKey tcConfigB.packageManagerLines
|
||||
|
||||
tcConfig <- TcConfig.Create(tcConfigB, validate = false)
|
||||
|
||||
if not (Seq.isEmpty result.Resolutions) then
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
|
||||
for resolution in result.Resolutions do
|
||||
tcConfigB.AddReferencedAssemblyByPath(m, resolution)
|
||||
|
||||
tcConfig <- TcConfig.Create(tcConfigB, validate = false)
|
||||
|
||||
for script in result.SourceFiles do
|
||||
use stream = FileSystem.OpenFileForReadShim(script)
|
||||
let scriptText = stream.ReadAllText()
|
||||
loadScripts.Add script |> ignore
|
||||
let iSourceText = SourceText.ofString scriptText
|
||||
yield! processClosureSource (ClosureSource(script, m, iSourceText, true))
|
||||
|
||||
else
|
||||
// Send outputs via diagnostics
|
||||
if (result.StdOut.Length > 0 || result.StdError.Length > 0) then
|
||||
for line in Array.append result.StdOut result.StdError do
|
||||
errorR (Error(FSComp.SR.packageManagerError (line), m))
|
||||
// Resolution produced errors update packagerManagerLines entries to note these failure
|
||||
// failed resolutions will no longer be considered
|
||||
let tcConfigB = tcConfig.CloneToBuilder()
|
||||
|
||||
tcConfigB.packageManagerLines <-
|
||||
PackageManagerLine.RemoveUnprocessedLines packageManagerKey tcConfigB.packageManagerLines
|
||||
|
||||
tcConfig <- TcConfig.Create(tcConfigB, validate = false)
|
||||
]
|
||||
|
||||
and processClosureSource (ClosureSource (fileName, m, sourceText, parseRequired)) =
|
||||
[
|
||||
if not (observedSources.HaveSeen(fileName)) then
|
||||
observedSources.SetSeen(fileName)
|
||||
//printfn "visiting %s" fileName
|
||||
if IsScript fileName || parseRequired then
|
||||
let parseResult, parseDiagnostics =
|
||||
let diagnosticsLogger = CapturingDiagnosticsLogger("FindClosureParse")
|
||||
use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> diagnosticsLogger)
|
||||
let result = ParseScriptClosureInput (fileName, sourceText, tcConfig, codeContext, lexResourceManager, diagnosticsLogger)
|
||||
use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger)
|
||||
|
||||
let result =
|
||||
ParseScriptClosureInput(fileName, sourceText, tcConfig, codeContext, lexResourceManager, diagnosticsLogger)
|
||||
|
||||
result, diagnosticsLogger.Diagnostics
|
||||
|
||||
let diagnosticsLogger = CapturingDiagnosticsLogger("FindClosureMetaCommands")
|
||||
use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> diagnosticsLogger)
|
||||
use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger)
|
||||
let pathOfMetaCommandSource = Path.GetDirectoryName fileName
|
||||
let preSources = tcConfig.GetAvailableLoadedSources()
|
||||
|
||||
let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (tcConfig, parseResult, pathOfMetaCommandSource, dependencyProvider)
|
||||
let tcConfigResult, noWarns =
|
||||
ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn(
|
||||
tcConfig,
|
||||
parseResult,
|
||||
pathOfMetaCommandSource,
|
||||
dependencyProvider
|
||||
)
|
||||
|
||||
tcConfig <- tcConfigResult // We accumulate the tcConfig in order to collect assembly references
|
||||
|
||||
yield! resolveDependencyManagerSources fileName
|
||||
|
||||
let postSources = tcConfig.GetAvailableLoadedSources()
|
||||
let sources = if preSources.Length < postSources.Length then postSources[preSources.Length..] else []
|
||||
|
||||
let sources =
|
||||
if preSources.Length < postSources.Length then
|
||||
postSources[preSources.Length ..]
|
||||
else
|
||||
[]
|
||||
|
||||
yield! resolveDependencyManagerSources fileName
|
||||
|
||||
for m, subFile in sources do
|
||||
if IsScript subFile then
|
||||
for subSource in ClosureSourceOfFilename(subFile, m, tcConfigResult.inputCodePage, false) do
|
||||
yield! loop subSource
|
||||
yield! processClosureSource subSource
|
||||
else
|
||||
yield ClosureFile(subFile, m, None, [], [], [])
|
||||
yield ClosureFile(fileName, m, Some parseResult, parseDiagnostics, diagnosticsLogger.Diagnostics, noWarns)
|
||||
ClosureFile(subFile, m, None, [], [], [])
|
||||
|
||||
ClosureFile(fileName, m, Some parseResult, parseDiagnostics, diagnosticsLogger.Diagnostics, noWarns)
|
||||
|
||||
else
|
||||
// Don't traverse into .fs leafs.
|
||||
printfn "yielding non-script source %s" fileName
|
||||
yield ClosureFile(fileName, m, None, [], [], []) ]
|
||||
ClosureFile(fileName, m, None, [], [], [])
|
||||
]
|
||||
|
||||
let sources = closureSources |> List.collect processClosureSource
|
||||
|
||||
let packageReferences =
|
||||
packageReferences |> Seq.map (fun kvp -> kvp.Key, kvp.Value) |> Seq.toArray
|
||||
|
||||
let sources = closureSources |> List.collect loop
|
||||
let packageReferences = packageReferences |> Seq.map (fun kvp -> kvp.Key, kvp.Value) |> Seq.toArray
|
||||
sources, tcConfig, packageReferences
|
||||
|
||||
/// Mark the last file as isLastCompiland.
|
||||
let MarkLastCompiland (tcConfig: TcConfig, lastClosureFile) =
|
||||
let (ClosureFile (fileName, m, lastParsedInput, parseDiagnostics, metaDiagnostics, nowarns)) =
|
||||
lastClosureFile
|
||||
|
||||
match lastParsedInput with
|
||||
| Some (ParsedInput.ImplFile lastParsedImplFile) ->
|
||||
|
||||
let (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, _, trivia)) =
|
||||
lastParsedImplFile
|
||||
|
||||
let isLastCompiland = (true, tcConfig.target.IsExe)
|
||||
|
||||
let lastParsedImplFileR =
|
||||
ParsedImplFileInput(name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, isLastCompiland, trivia)
|
||||
|
||||
let lastClosureFileR =
|
||||
ClosureFile(fileName, m, Some(ParsedInput.ImplFile lastParsedImplFileR), parseDiagnostics, metaDiagnostics, nowarns)
|
||||
|
||||
lastClosureFileR
|
||||
| _ -> lastClosureFile
|
||||
|
||||
/// Reduce the full directive closure into LoadClosure
|
||||
let GetLoadClosure(rootFilename, closureFiles, tcConfig: TcConfig, codeContext, packageReferences, earlierDiagnostics) =
|
||||
let GetLoadClosure (rootFilename, closureFiles, tcConfig: TcConfig, codeContext, packageReferences, earlierDiagnostics) =
|
||||
|
||||
// Mark the last file as isLastCompiland.
|
||||
let closureFiles =
|
||||
if isNil closureFiles then
|
||||
closureFiles
|
||||
else
|
||||
match List.frontAndBack closureFiles with
|
||||
| rest, ClosureFile
|
||||
(fileName, m,
|
||||
Some(ParsedInput.ImplFile (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, _, trivia))),
|
||||
parseDiagnostics, metaDiagnostics, nowarns) ->
|
||||
|
||||
let isLastCompiland = (true, tcConfig.target.IsExe)
|
||||
rest @ [ClosureFile
|
||||
(fileName, m,
|
||||
Some(ParsedInput.ImplFile (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, isLastCompiland, trivia))),
|
||||
parseDiagnostics, metaDiagnostics, nowarns)]
|
||||
|
||||
| _ -> closureFiles
|
||||
match List.tryFrontAndBack closureFiles with
|
||||
| None -> closureFiles
|
||||
| Some (rest, lastClosureFile) ->
|
||||
let lastClosureFileR = MarkLastCompiland(tcConfig, lastClosureFile)
|
||||
rest @ [ lastClosureFileR ]
|
||||
|
||||
// Get all source files.
|
||||
let sourceFiles = [ for ClosureFile(fileName, m, _, _, _, _) in closureFiles -> (fileName, m) ]
|
||||
let sourceFiles =
|
||||
[ for ClosureFile (fileName, m, _, _, _, _) in closureFiles -> (fileName, m) ]
|
||||
|
||||
let sourceInputs =
|
||||
[ for ClosureFile(fileName, _, input, parseDiagnostics, metaDiagnostics, _nowarns) in closureFiles ->
|
||||
({ FileName=fileName
|
||||
SyntaxTree=input
|
||||
ParseDiagnostics=parseDiagnostics
|
||||
MetaCommandDiagnostics=metaDiagnostics } : LoadClosureInput) ]
|
||||
[
|
||||
for closureFile in closureFiles ->
|
||||
let (ClosureFile (fileName, _, input, parseDiagnostics, metaDiagnostics, _nowarns)) =
|
||||
closureFile
|
||||
|
||||
let globalNoWarns = closureFiles |> List.collect (fun (ClosureFile(_, _, _, _, _, noWarns)) -> noWarns)
|
||||
let closureInput: LoadClosureInput =
|
||||
{
|
||||
FileName = fileName
|
||||
SyntaxTree = input
|
||||
ParseDiagnostics = parseDiagnostics
|
||||
MetaCommandDiagnostics = metaDiagnostics
|
||||
}
|
||||
|
||||
closureInput
|
||||
]
|
||||
|
||||
let globalNoWarns =
|
||||
closureFiles
|
||||
|> List.collect (fun (ClosureFile (_, _, _, _, _, noWarns)) -> noWarns)
|
||||
|
||||
// Resolve all references.
|
||||
let references, unresolvedReferences, resolutionDiagnostics =
|
||||
let diagnosticsLogger = CapturingDiagnosticsLogger("GetLoadClosure")
|
||||
|
||||
use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> diagnosticsLogger)
|
||||
let references, unresolvedReferences = TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig)
|
||||
use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger)
|
||||
|
||||
let references, unresolvedReferences =
|
||||
TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig)
|
||||
|
||||
let references = references |> List.map (fun ar -> ar.resolvedPath, ar)
|
||||
references, unresolvedReferences, diagnosticsLogger.Diagnostics
|
||||
|
||||
// Root errors and warnings - look at the last item in the closureFiles list
|
||||
let loadClosureRootDiagnostics, allRootDiagnostics =
|
||||
match List.rev closureFiles with
|
||||
| ClosureFile(_, _, _, parseDiagnostics, metaDiagnostics, _) :: _ ->
|
||||
| ClosureFile (_, _, _, parseDiagnostics, metaDiagnostics, _) :: _ ->
|
||||
(earlierDiagnostics @ metaDiagnostics @ resolutionDiagnostics),
|
||||
(parseDiagnostics @ earlierDiagnostics @ metaDiagnostics @ resolutionDiagnostics)
|
||||
| _ -> [], [] // When no file existed.
|
||||
|
|
@ -448,8 +588,13 @@ module ScriptPreprocessClosure =
|
|||
match GetRangeOfDiagnostic exn with
|
||||
| Some m ->
|
||||
// Return true if the error was *not* from a #load-ed file.
|
||||
let isArgParameterWhileNotEditing = (codeContext <> CodeContext.Editing) && (equals m range0 || equals m rangeStartup || equals m rangeCmdArgs)
|
||||
let isThisFileName = (0 = String.Compare(rootFilename, m.FileName, StringComparison.OrdinalIgnoreCase))
|
||||
let isArgParameterWhileNotEditing =
|
||||
(codeContext <> CodeContext.Editing)
|
||||
&& (equals m range0 || equals m rangeStartup || equals m rangeCmdArgs)
|
||||
|
||||
let isThisFileName =
|
||||
(0 = String.Compare(rootFilename, m.FileName, StringComparison.OrdinalIgnoreCase))
|
||||
|
||||
isArgParameterWhileNotEditing || isThisFileName
|
||||
| None -> true
|
||||
|
||||
|
|
@ -457,18 +602,20 @@ module ScriptPreprocessClosure =
|
|||
let allRootDiagnostics = allRootDiagnostics |> List.filter (fst >> isRootRange)
|
||||
|
||||
let result: LoadClosure =
|
||||
{ SourceFiles = List.groupBy fst sourceFiles |> List.map (map2Of2 (List.map snd))
|
||||
References = List.groupBy fst references |> List.map (map2Of2 (List.map snd))
|
||||
PackageReferences = packageReferences
|
||||
UseDesktopFramework = (tcConfig.primaryAssembly = PrimaryAssembly.Mscorlib)
|
||||
SdkDirOverride = tcConfig.sdkDirOverride
|
||||
UnresolvedReferences = unresolvedReferences
|
||||
Inputs = sourceInputs
|
||||
NoWarns = List.groupBy fst globalNoWarns |> List.map (map2Of2 (List.map snd))
|
||||
OriginalLoadReferences = tcConfig.loadedSources
|
||||
ResolutionDiagnostics = resolutionDiagnostics
|
||||
AllRootFileDiagnostics = allRootDiagnostics
|
||||
LoadClosureRootFileDiagnostics = loadClosureRootDiagnostics }
|
||||
{
|
||||
SourceFiles = List.groupBy fst sourceFiles |> List.map (map2Of2 (List.map snd))
|
||||
References = List.groupBy fst references |> List.map (map2Of2 (List.map snd))
|
||||
PackageReferences = packageReferences
|
||||
UseDesktopFramework = (tcConfig.primaryAssembly = PrimaryAssembly.Mscorlib)
|
||||
SdkDirOverride = tcConfig.sdkDirOverride
|
||||
UnresolvedReferences = unresolvedReferences
|
||||
Inputs = sourceInputs
|
||||
NoWarns = List.groupBy fst globalNoWarns |> List.map (map2Of2 (List.map snd))
|
||||
OriginalLoadReferences = tcConfig.loadedSources
|
||||
ResolutionDiagnostics = resolutionDiagnostics
|
||||
AllRootFileDiagnostics = allRootDiagnostics
|
||||
LoadClosureRootFileDiagnostics = loadClosureRootDiagnostics
|
||||
}
|
||||
|
||||
result
|
||||
|
||||
|
|
@ -498,42 +645,81 @@ module ScriptPreprocessClosure =
|
|||
// first, then #I and other directives are processed.
|
||||
let references0, assumeDotNetFramework, scriptDefaultReferencesDiagnostics =
|
||||
let tcConfig, scriptDefaultReferencesDiagnostics =
|
||||
CreateScriptTextTcConfig(legacyReferenceResolver, defaultFSharpBinariesDir,
|
||||
fileName, codeContext, useSimpleResolution,
|
||||
useFsiAuxLib, None, applyCommandLineArgs, assumeDotNetFramework,
|
||||
useSdkRefs, sdkDirOverride, tryGetMetadataSnapshot, reduceMemoryUsage)
|
||||
CreateScriptTextTcConfig(
|
||||
legacyReferenceResolver,
|
||||
defaultFSharpBinariesDir,
|
||||
fileName,
|
||||
codeContext,
|
||||
useSimpleResolution,
|
||||
useFsiAuxLib,
|
||||
None,
|
||||
applyCommandLineArgs,
|
||||
assumeDotNetFramework,
|
||||
useSdkRefs,
|
||||
sdkDirOverride,
|
||||
tryGetMetadataSnapshot,
|
||||
reduceMemoryUsage
|
||||
)
|
||||
|
||||
let resolutions0, _unresolvedReferences =
|
||||
TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig)
|
||||
|
||||
let references0 =
|
||||
resolutions0
|
||||
|> List.map (fun r -> r.originalReference.Range, r.resolvedPath)
|
||||
|> Seq.distinct
|
||||
|> List.ofSeq
|
||||
|
||||
let resolutions0, _unresolvedReferences = TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig)
|
||||
let references0 = resolutions0 |> List.map (fun r->r.originalReference.Range, r.resolvedPath) |> Seq.distinct |> List.ofSeq
|
||||
references0, tcConfig.assumeDotNetFramework, scriptDefaultReferencesDiagnostics
|
||||
|
||||
let tcConfig, scriptDefaultReferencesDiagnostics =
|
||||
CreateScriptTextTcConfig(legacyReferenceResolver, defaultFSharpBinariesDir, fileName,
|
||||
codeContext, useSimpleResolution, useFsiAuxLib, Some (references0, scriptDefaultReferencesDiagnostics),
|
||||
applyCommandLineArgs, assumeDotNetFramework, useSdkRefs, sdkDirOverride,
|
||||
tryGetMetadataSnapshot, reduceMemoryUsage)
|
||||
CreateScriptTextTcConfig(
|
||||
legacyReferenceResolver,
|
||||
defaultFSharpBinariesDir,
|
||||
fileName,
|
||||
codeContext,
|
||||
useSimpleResolution,
|
||||
useFsiAuxLib,
|
||||
Some(references0, scriptDefaultReferencesDiagnostics),
|
||||
applyCommandLineArgs,
|
||||
assumeDotNetFramework,
|
||||
useSdkRefs,
|
||||
sdkDirOverride,
|
||||
tryGetMetadataSnapshot,
|
||||
reduceMemoryUsage
|
||||
)
|
||||
|
||||
let closureSources = [ ClosureSource(fileName, range0, sourceText, true) ]
|
||||
|
||||
let closureFiles, tcConfig, packageReferences =
|
||||
FindClosureFiles(fileName, closureSources, tcConfig, codeContext, lexResourceManager, dependencyProvider)
|
||||
|
||||
let closureSources = [ClosureSource(fileName, range0, sourceText, true)]
|
||||
let closureFiles, tcConfig, packageReferences = FindClosureFiles(fileName, closureSources, tcConfig, codeContext, lexResourceManager, dependencyProvider)
|
||||
GetLoadClosure(fileName, closureFiles, tcConfig, codeContext, packageReferences, scriptDefaultReferencesDiagnostics)
|
||||
|
||||
/// Given source file fileName, find the full load closure
|
||||
/// Used from fsi.fs and fsc.fs, for #load and command line
|
||||
let GetFullClosureOfScriptFiles
|
||||
(
|
||||
tcConfig:TcConfig,
|
||||
files:(string*range) list,
|
||||
tcConfig: TcConfig,
|
||||
files: (string * range) list,
|
||||
codeContext,
|
||||
lexResourceManager: Lexhelp.LexResourceManager,
|
||||
dependencyProvider
|
||||
) =
|
||||
|
||||
let mainFile, _mainFileRange = List.last files
|
||||
let closureSources = files |> List.collect (fun (fileName, m) -> ClosureSourceOfFilename(fileName, m,tcConfig.inputCodePage,true))
|
||||
let closureFiles, tcConfig, packageReferences = FindClosureFiles(mainFile, closureSources, tcConfig, codeContext, lexResourceManager, dependencyProvider)
|
||||
|
||||
let closureSources =
|
||||
files
|
||||
|> List.collect (fun (fileName, m) -> ClosureSourceOfFilename(fileName, m, tcConfig.inputCodePage, true))
|
||||
|
||||
let closureFiles, tcConfig, packageReferences =
|
||||
FindClosureFiles(mainFile, closureSources, tcConfig, codeContext, lexResourceManager, dependencyProvider)
|
||||
|
||||
GetLoadClosure(mainFile, closureFiles, tcConfig, codeContext, packageReferences, [])
|
||||
|
||||
type LoadClosure with
|
||||
|
||||
/// Analyze a script text and find the closure of its references.
|
||||
/// Used from FCS, when editing a script file.
|
||||
///
|
||||
|
|
@ -559,20 +745,34 @@ type LoadClosure with
|
|||
) =
|
||||
|
||||
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse
|
||||
ScriptPreprocessClosure.GetFullClosureOfScriptText
|
||||
(legacyReferenceResolver, defaultFSharpBinariesDir, fileName, sourceText,
|
||||
implicitDefines, useSimpleResolution, useFsiAuxLib, useSdkRefs, sdkDir, lexResourceManager,
|
||||
applyCompilerOptions, assumeDotNetFramework, tryGetMetadataSnapshot, reduceMemoryUsage, dependencyProvider)
|
||||
|
||||
ScriptPreprocessClosure.GetFullClosureOfScriptText(
|
||||
legacyReferenceResolver,
|
||||
defaultFSharpBinariesDir,
|
||||
fileName,
|
||||
sourceText,
|
||||
implicitDefines,
|
||||
useSimpleResolution,
|
||||
useFsiAuxLib,
|
||||
useSdkRefs,
|
||||
sdkDir,
|
||||
lexResourceManager,
|
||||
applyCompilerOptions,
|
||||
assumeDotNetFramework,
|
||||
tryGetMetadataSnapshot,
|
||||
reduceMemoryUsage,
|
||||
dependencyProvider
|
||||
)
|
||||
|
||||
/// Analyze a set of script files and find the closure of their references.
|
||||
static member ComputeClosureOfScriptFiles
|
||||
(
|
||||
tcConfig: TcConfig,
|
||||
files:(string*range) list,
|
||||
files: (string * range) list,
|
||||
implicitDefines,
|
||||
lexResourceManager: Lexhelp.LexResourceManager,
|
||||
dependencyProvider
|
||||
) =
|
||||
|
||||
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse
|
||||
ScriptPreprocessClosure.GetFullClosureOfScriptFiles (tcConfig, files, implicitDefines, lexResourceManager, dependencyProvider)
|
||||
ScriptPreprocessClosure.GetFullClosureOfScriptFiles(tcConfig, files, implicitDefines, lexResourceManager, dependencyProvider)
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ open FSharp.Compiler.TypeProviders
|
|||
#endif
|
||||
|
||||
// Handles TypeForwarding for the generated IL model
|
||||
type TypeForwarding (tcImports: TcImports) =
|
||||
type TypeForwarding(tcImports: TcImports) =
|
||||
|
||||
// Make a dictionary of ccus passed to the compiler will be looked up by qualified assembly name
|
||||
let ccuThunksQualifiedName =
|
||||
|
|
@ -40,18 +40,20 @@ type TypeForwarding (tcImports: TcImports) =
|
|||
if String.IsNullOrEmpty(ccuThunk.AssemblyName) then
|
||||
None
|
||||
else
|
||||
Some (ccuThunk.AssemblyName, ccuThunk))
|
||||
Some(ccuThunk.AssemblyName, ccuThunk))
|
||||
|> dict
|
||||
|
||||
let followTypeForwardForILTypeRef (tref:ILTypeRef) =
|
||||
let followTypeForwardForILTypeRef (tref: ILTypeRef) =
|
||||
let typename =
|
||||
let parts = tref.FullName.Split([|'.'|])
|
||||
let parts = tref.FullName.Split([| '.' |])
|
||||
|
||||
match parts.Length with
|
||||
| 0 -> None
|
||||
| 1 -> Some (Array.empty<string>, parts[0])
|
||||
| n -> Some (parts[0..n-2], parts[n-1])
|
||||
| 1 -> Some(Array.empty<string>, parts[0])
|
||||
| n -> Some(parts[0 .. n - 2], parts[n - 1])
|
||||
|
||||
let scoref = tref.Scope
|
||||
|
||||
let scoref = tref.Scope
|
||||
match scoref with
|
||||
| ILScopeRef.Assembly scope ->
|
||||
match ccuThunksQualifiedName.TryGetValue(scope.QualifiedName) with
|
||||
|
|
@ -59,10 +61,12 @@ type TypeForwarding (tcImports: TcImports) =
|
|||
match typename with
|
||||
| Some (parts, name) ->
|
||||
let forwarded = ccu.TryForward(parts, name)
|
||||
|
||||
let result =
|
||||
match forwarded with
|
||||
| Some fwd -> fwd.CompilationPath.ILScopeRef
|
||||
| None -> scoref
|
||||
|
||||
result
|
||||
| None -> scoref
|
||||
| false, _ ->
|
||||
|
|
@ -72,10 +76,12 @@ type TypeForwarding (tcImports: TcImports) =
|
|||
match typename with
|
||||
| Some (parts, name) ->
|
||||
let forwarded = ccu.TryForward(parts, name)
|
||||
|
||||
let result =
|
||||
match forwarded with
|
||||
| Some fwd -> fwd.CompilationPath.ILScopeRef
|
||||
| None -> scoref
|
||||
|
||||
result
|
||||
| None -> scoref
|
||||
| false, _ -> scoref
|
||||
|
|
@ -84,55 +90,83 @@ type TypeForwarding (tcImports: TcImports) =
|
|||
let typeForwardILTypeRef (tref: ILTypeRef) =
|
||||
let scoref1 = tref.Scope
|
||||
let scoref2 = followTypeForwardForILTypeRef tref
|
||||
if scoref1 === scoref2 then tref
|
||||
else ILTypeRef.Create (scoref2, tref.Enclosing, tref.Name)
|
||||
|
||||
if scoref1 === scoref2 then
|
||||
tref
|
||||
else
|
||||
ILTypeRef.Create(scoref2, tref.Enclosing, tref.Name)
|
||||
|
||||
member _.TypeForwardILTypeRef tref = typeForwardILTypeRef tref
|
||||
|
||||
let debugStaticLinking = condition "FSHARP_DEBUG_STATIC_LINKING"
|
||||
|
||||
let StaticLinkILModules (tcConfig:TcConfig, ilGlobals, tcImports, ilxMainModule, dependentILModules: (CcuThunk option * ILModuleDef) list) =
|
||||
let StaticLinkILModules
|
||||
(
|
||||
tcConfig: TcConfig,
|
||||
ilGlobals,
|
||||
tcImports,
|
||||
ilxMainModule,
|
||||
dependentILModules: (CcuThunk option * ILModuleDef) list
|
||||
) =
|
||||
if isNil dependentILModules then
|
||||
ilxMainModule, id
|
||||
else
|
||||
let typeForwarding = TypeForwarding(tcImports)
|
||||
|
||||
// Check no dependent assemblies use quotations
|
||||
let dependentCcuUsingQuotations = dependentILModules |> List.tryPick (function Some ccu, _ when ccu.UsesFSharp20PlusQuotations -> Some ccu | _ -> None)
|
||||
let dependentCcuUsingQuotations =
|
||||
dependentILModules
|
||||
|> List.tryPick (function
|
||||
| Some ccu, _ when ccu.UsesFSharp20PlusQuotations -> Some ccu
|
||||
| _ -> None)
|
||||
|
||||
match dependentCcuUsingQuotations with
|
||||
| Some ccu -> error(Error(FSComp.SR.fscQuotationLiteralsStaticLinking(ccu.AssemblyName), rangeStartup))
|
||||
| Some ccu -> error (Error(FSComp.SR.fscQuotationLiteralsStaticLinking (ccu.AssemblyName), rangeStartup))
|
||||
| None -> ()
|
||||
|
||||
// Check we're not static linking a .EXE
|
||||
if dependentILModules |> List.exists (fun (_, x) -> not x.IsDLL) then
|
||||
error(Error(FSComp.SR.fscStaticLinkingNoEXE(), rangeStartup))
|
||||
if dependentILModules |> List.exists (fun (_, x) -> not x.IsDLL) then
|
||||
error (Error(FSComp.SR.fscStaticLinkingNoEXE (), rangeStartup))
|
||||
|
||||
// Check we're not static linking something that is not pure IL
|
||||
if dependentILModules |> List.exists (fun (_, x) -> not x.IsILOnly) then
|
||||
error(Error(FSComp.SR.fscStaticLinkingNoMixedDLL(), rangeStartup))
|
||||
if dependentILModules |> List.exists (fun (_, x) -> not x.IsILOnly) then
|
||||
error (Error(FSComp.SR.fscStaticLinkingNoMixedDLL (), rangeStartup))
|
||||
|
||||
// The set of short names for the all dependent assemblies
|
||||
let assems =
|
||||
set [ for _, m in dependentILModules do
|
||||
match m.Manifest with
|
||||
| Some m -> yield m.Name
|
||||
| _ -> () ]
|
||||
set
|
||||
[
|
||||
for _, m in dependentILModules do
|
||||
match m.Manifest with
|
||||
| Some m -> m.Name
|
||||
| _ -> ()
|
||||
]
|
||||
|
||||
// A rewriter which rewrites scope references to things in dependent assemblies to be local references
|
||||
let rewriteExternalRefsToLocalRefs x =
|
||||
if assems.Contains (getNameOfScopeRef x) then ILScopeRef.Local else x
|
||||
if assems.Contains(getNameOfScopeRef x) then
|
||||
ILScopeRef.Local
|
||||
else
|
||||
x
|
||||
|
||||
let savedManifestAttrs =
|
||||
[ for _, depILModule in dependentILModules do
|
||||
match depILModule.Manifest with
|
||||
| Some m ->
|
||||
for ca in m.CustomAttrs.AsArray() do
|
||||
if ca.Method.MethodRef.DeclaringTypeRef.FullName = typeof<CompilationMappingAttribute>.FullName then
|
||||
yield ca
|
||||
| _ -> () ]
|
||||
[
|
||||
for _, depILModule in dependentILModules do
|
||||
match depILModule.Manifest with
|
||||
| Some m ->
|
||||
for ca in m.CustomAttrs.AsArray() do
|
||||
if ca.Method.MethodRef.DeclaringTypeRef.FullName = typeof<CompilationMappingAttribute>.FullName then
|
||||
ca
|
||||
| _ -> ()
|
||||
]
|
||||
|
||||
let savedResources =
|
||||
let allResources = [ for ccu, m in dependentILModules do for r in m.Resources.AsList() do yield (ccu, r) ]
|
||||
let allResources =
|
||||
[
|
||||
for ccu, m in dependentILModules do
|
||||
for r in m.Resources.AsList() do
|
||||
(ccu, r)
|
||||
]
|
||||
// Don't save interface, optimization or resource definitions for provider-generated assemblies.
|
||||
// These are "fake".
|
||||
let isProvided (ccu: CcuThunk option) =
|
||||
|
|
@ -146,21 +180,29 @@ let StaticLinkILModules (tcConfig:TcConfig, ilGlobals, tcImports, ilxMainModule,
|
|||
#endif
|
||||
|
||||
// Save only the interface/optimization attributes of generated data
|
||||
let intfDataResources, others = allResources |> List.partition (snd >> IsSignatureDataResource)
|
||||
let intfDataResources =
|
||||
[ for ccu, r in intfDataResources do
|
||||
if tcConfig.GenerateSignatureData && not (isProvided ccu) then
|
||||
yield r ]
|
||||
let intfDataResources, others =
|
||||
allResources |> List.partition (snd >> IsSignatureDataResource)
|
||||
|
||||
let intfDataResources =
|
||||
[
|
||||
for ccu, r in intfDataResources do
|
||||
if tcConfig.GenerateSignatureData && not (isProvided ccu) then
|
||||
r
|
||||
]
|
||||
|
||||
let optDataResources, others =
|
||||
others |> List.partition (snd >> IsOptimizationDataResource)
|
||||
|
||||
let optDataResources, others = others |> List.partition (snd >> IsOptimizationDataResource)
|
||||
let optDataResources =
|
||||
[ for ccu, r in optDataResources do
|
||||
if tcConfig.GenerateOptimizationData && not (isProvided ccu) then
|
||||
yield r ]
|
||||
[
|
||||
for ccu, r in optDataResources do
|
||||
if tcConfig.GenerateOptimizationData && not (isProvided ccu) then
|
||||
r
|
||||
]
|
||||
|
||||
let otherResources = others |> List.map snd
|
||||
|
||||
let result = intfDataResources@optDataResources@otherResources
|
||||
let result = intfDataResources @ optDataResources @ otherResources
|
||||
result
|
||||
|
||||
let moduls = ilxMainModule :: (List.map snd dependentILModules)
|
||||
|
|
@ -168,39 +210,62 @@ let StaticLinkILModules (tcConfig:TcConfig, ilGlobals, tcImports, ilxMainModule,
|
|||
let savedNativeResources =
|
||||
[ //yield! ilxMainModule.NativeResources
|
||||
for m in moduls do
|
||||
yield! m.NativeResources ]
|
||||
yield! m.NativeResources
|
||||
]
|
||||
|
||||
let topTypeDefs, normalTypeDefs =
|
||||
moduls
|
||||
|> List.map (fun m -> m.TypeDefs.AsList() |> List.partition (fun td -> isTypeNameForGlobalFunctions td.Name))
|
||||
|> List.map (fun m ->
|
||||
m.TypeDefs.AsList()
|
||||
|> List.partition (fun td -> isTypeNameForGlobalFunctions td.Name))
|
||||
|> List.unzip
|
||||
|
||||
let topTypeDef =
|
||||
let topTypeDefs = List.concat topTypeDefs
|
||||
mkILTypeDefForGlobalFunctions ilGlobals
|
||||
|
||||
mkILTypeDefForGlobalFunctions
|
||||
ilGlobals
|
||||
(mkILMethods (topTypeDefs |> List.collect (fun td -> td.Methods.AsList())),
|
||||
mkILFields (topTypeDefs |> List.collect (fun td -> td.Fields.AsList())))
|
||||
mkILFields (topTypeDefs |> List.collect (fun td -> td.Fields.AsList())))
|
||||
|
||||
let oldManifest = ilxMainModule.ManifestOfAssembly
|
||||
|
||||
let newManifest =
|
||||
{ oldManifest with
|
||||
CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs (oldManifest.CustomAttrs.AsList() @ savedManifestAttrs))
|
||||
}
|
||||
|
||||
let ilxMainModule =
|
||||
let main =
|
||||
{ ilxMainModule with
|
||||
Manifest = (let m = ilxMainModule.ManifestOfAssembly in Some {m with CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs (m.CustomAttrs.AsList() @ savedManifestAttrs)) })
|
||||
CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs [ for m in moduls do yield! m.CustomAttrs.AsArray() ])
|
||||
Manifest = Some newManifest
|
||||
CustomAttrsStored =
|
||||
storeILCustomAttrs (
|
||||
mkILCustomAttrs
|
||||
[
|
||||
for m in moduls do
|
||||
yield! m.CustomAttrs.AsArray()
|
||||
]
|
||||
)
|
||||
TypeDefs = mkILTypeDefs (topTypeDef :: List.concat normalTypeDefs)
|
||||
Resources = mkILResources (savedResources @ ilxMainModule.Resources.AsList())
|
||||
NativeResources = savedNativeResources }
|
||||
NativeResources = savedNativeResources
|
||||
}
|
||||
|
||||
Morphs.morphILTypeRefsInILModuleMemoized typeForwarding.TypeForwardILTypeRef main
|
||||
|
||||
ilxMainModule, rewriteExternalRefsToLocalRefs
|
||||
|
||||
[<NoEquality; NoComparison>]
|
||||
type Node =
|
||||
{ name: string
|
||||
data: ILModuleDef
|
||||
ccu: CcuThunk option
|
||||
refs: ILReferences
|
||||
mutable edges: Node list
|
||||
mutable visited: bool }
|
||||
{
|
||||
name: string
|
||||
data: ILModuleDef
|
||||
ccu: CcuThunk option
|
||||
refs: ILReferences
|
||||
mutable edges: Node list
|
||||
mutable visited: bool
|
||||
}
|
||||
|
||||
// Find all IL modules that are to be statically linked given the static linking roots.
|
||||
let FindDependentILModulesForStaticLinking (ctok, tcConfig: TcConfig, tcImports: TcImports, ilGlobals: ILGlobals, ilxMainModule) =
|
||||
|
|
@ -209,130 +274,217 @@ let FindDependentILModulesForStaticLinking (ctok, tcConfig: TcConfig, tcImports:
|
|||
else
|
||||
// Recursively find all referenced modules and add them to a module graph
|
||||
let depModuleTable = HashMultiMap(0, HashIdentity.Structural)
|
||||
|
||||
let dummyEntry nm =
|
||||
{ refs = emptyILRefs
|
||||
name=nm
|
||||
ccu=None
|
||||
data=ilxMainModule // any old module
|
||||
edges = []
|
||||
visited = true }
|
||||
let assumedIndependentSet = set [ "mscorlib"; "System"; "System.Core"; "System.Xml"; "Microsoft.Build.Framework"; "Microsoft.Build.Utilities"; "netstandard" ]
|
||||
{
|
||||
refs = emptyILRefs
|
||||
name = nm
|
||||
ccu = None
|
||||
data = ilxMainModule // any old module
|
||||
edges = []
|
||||
visited = true
|
||||
}
|
||||
|
||||
begin
|
||||
let mutable remaining = (computeILRefs ilGlobals ilxMainModule).AssemblyReferences |> Array.toList
|
||||
while not (isNil remaining) do
|
||||
let ilAssemRef = List.head remaining
|
||||
remaining <- List.tail remaining
|
||||
if assumedIndependentSet.Contains ilAssemRef.Name || (ilAssemRef.PublicKey = Some ecmaPublicKey) then
|
||||
depModuleTable[ilAssemRef.Name] <- dummyEntry ilAssemRef.Name
|
||||
else
|
||||
if not (depModuleTable.ContainsKey ilAssemRef.Name) then
|
||||
match tcImports.TryFindDllInfo(ctok, rangeStartup, ilAssemRef.Name, lookupOnly=false) with
|
||||
| Some dllInfo ->
|
||||
let ccu =
|
||||
match tcImports.FindCcuFromAssemblyRef (ctok, rangeStartup, ilAssemRef) with
|
||||
| ResolvedCcu ccu -> Some ccu
|
||||
| UnresolvedCcu(_ccuName) -> None
|
||||
let assumedIndependentSet =
|
||||
set
|
||||
[
|
||||
"mscorlib"
|
||||
"System"
|
||||
"System.Core"
|
||||
"System.Xml"
|
||||
"Microsoft.Build.Framework"
|
||||
"Microsoft.Build.Utilities"
|
||||
"netstandard"
|
||||
]
|
||||
|
||||
let fileName = dllInfo.FileName
|
||||
let modul =
|
||||
let pdbDirPathOption =
|
||||
// We open the pdb file if one exists parallel to the binary we
|
||||
// are reading, so that --standalone will preserve debug information.
|
||||
if tcConfig.openDebugInformationForLaterStaticLinking then
|
||||
let pdbDir = (try FileSystem.GetDirectoryNameShim fileName with _ -> ".")
|
||||
let pdbFile = (try FileSystemUtils.chopExtension fileName with _ -> fileName)+".pdb"
|
||||
if FileSystem.FileExistsShim pdbFile then
|
||||
Some pdbDir
|
||||
else
|
||||
None
|
||||
else
|
||||
None
|
||||
let mutable remaining =
|
||||
(computeILRefs ilGlobals ilxMainModule).AssemblyReferences |> Array.toList
|
||||
|
||||
let opts : ILReaderOptions =
|
||||
{ metadataOnly = MetadataOnlyFlag.No // turn this off here as we need the actual IL code
|
||||
reduceMemoryUsage = tcConfig.reduceMemoryUsage
|
||||
pdbDirPath = pdbDirPathOption
|
||||
tryGetMetadataSnapshot = (fun _ -> None) }
|
||||
while not (isNil remaining) do
|
||||
let ilAssemRef = List.head remaining
|
||||
remaining <- List.tail remaining
|
||||
|
||||
let reader = OpenILModuleReader dllInfo.FileName opts
|
||||
reader.ILModuleDef
|
||||
if assumedIndependentSet.Contains ilAssemRef.Name
|
||||
|| (ilAssemRef.PublicKey = Some ecmaPublicKey) then
|
||||
depModuleTable[ilAssemRef.Name] <- dummyEntry ilAssemRef.Name
|
||||
else if not (depModuleTable.ContainsKey ilAssemRef.Name) then
|
||||
match tcImports.TryFindDllInfo(ctok, rangeStartup, ilAssemRef.Name, lookupOnly = false) with
|
||||
| Some dllInfo ->
|
||||
let ccu =
|
||||
match tcImports.FindCcuFromAssemblyRef(ctok, rangeStartup, ilAssemRef) with
|
||||
| ResolvedCcu ccu -> Some ccu
|
||||
| UnresolvedCcu (_ccuName) -> None
|
||||
|
||||
let refs =
|
||||
if ilAssemRef.Name = GetFSharpCoreLibraryName() then
|
||||
emptyILRefs
|
||||
elif not modul.IsILOnly then
|
||||
warning(Error(FSComp.SR.fscIgnoringMixedWhenLinking ilAssemRef.Name, rangeStartup))
|
||||
emptyILRefs
|
||||
let fileName = dllInfo.FileName
|
||||
|
||||
let modul =
|
||||
let pdbDirPathOption =
|
||||
// We open the pdb file if one exists parallel to the binary we
|
||||
// are reading, so that --standalone will preserve debug information.
|
||||
if tcConfig.openDebugInformationForLaterStaticLinking then
|
||||
let pdbDir =
|
||||
(try
|
||||
FileSystem.GetDirectoryNameShim fileName
|
||||
with _ ->
|
||||
".")
|
||||
|
||||
let pdbFile =
|
||||
(try
|
||||
FileSystemUtils.chopExtension fileName
|
||||
with _ ->
|
||||
fileName)
|
||||
+ ".pdb"
|
||||
|
||||
if FileSystem.FileExistsShim pdbFile then
|
||||
Some pdbDir
|
||||
else
|
||||
{ AssemblyReferences = dllInfo.ILAssemblyRefs |> List.toArray
|
||||
ModuleReferences = [| |]
|
||||
TypeReferences = [| |]
|
||||
MethodReferences = [| |]
|
||||
FieldReferences = [||] }
|
||||
None
|
||||
else
|
||||
None
|
||||
|
||||
depModuleTable[ilAssemRef.Name] <-
|
||||
{ refs=refs
|
||||
name=ilAssemRef.Name
|
||||
ccu=ccu
|
||||
data=modul
|
||||
edges = []
|
||||
visited = false }
|
||||
let opts: ILReaderOptions =
|
||||
{
|
||||
metadataOnly = MetadataOnlyFlag.No // turn this off here as we need the actual IL code
|
||||
reduceMemoryUsage = tcConfig.reduceMemoryUsage
|
||||
pdbDirPath = pdbDirPathOption
|
||||
tryGetMetadataSnapshot = (fun _ -> None)
|
||||
}
|
||||
|
||||
// Push the new work items
|
||||
remaining <- Array.toList refs.AssemblyReferences @ remaining
|
||||
let reader = OpenILModuleReader dllInfo.FileName opts
|
||||
reader.ILModuleDef
|
||||
|
||||
| None ->
|
||||
warning(Error(FSComp.SR.fscAssumeStaticLinkContainsNoDependencies(ilAssemRef.Name), rangeStartup))
|
||||
depModuleTable[ilAssemRef.Name] <- dummyEntry ilAssemRef.Name
|
||||
done
|
||||
end
|
||||
let refs =
|
||||
if ilAssemRef.Name = GetFSharpCoreLibraryName() then
|
||||
emptyILRefs
|
||||
elif not modul.IsILOnly then
|
||||
warning (Error(FSComp.SR.fscIgnoringMixedWhenLinking ilAssemRef.Name, rangeStartup))
|
||||
emptyILRefs
|
||||
else
|
||||
{
|
||||
AssemblyReferences = dllInfo.ILAssemblyRefs |> List.toArray
|
||||
ModuleReferences = [||]
|
||||
TypeReferences = [||]
|
||||
MethodReferences = [||]
|
||||
FieldReferences = [||]
|
||||
}
|
||||
|
||||
depModuleTable[ilAssemRef.Name] <-
|
||||
{
|
||||
refs = refs
|
||||
name = ilAssemRef.Name
|
||||
ccu = ccu
|
||||
data = modul
|
||||
edges = []
|
||||
visited = false
|
||||
}
|
||||
|
||||
// Push the new work items
|
||||
remaining <- Array.toList refs.AssemblyReferences @ remaining
|
||||
|
||||
| None ->
|
||||
warning (Error(FSComp.SR.fscAssumeStaticLinkContainsNoDependencies (ilAssemRef.Name), rangeStartup))
|
||||
depModuleTable[ilAssemRef.Name] <- dummyEntry ilAssemRef.Name
|
||||
|
||||
ReportTime tcConfig "Find dependencies"
|
||||
|
||||
// Add edges from modules to the modules that depend on them
|
||||
for KeyValue(_, n) in depModuleTable do
|
||||
for KeyValue (_, n) in depModuleTable do
|
||||
for aref in n.refs.AssemblyReferences do
|
||||
let n2 = depModuleTable[aref.Name]
|
||||
n2.edges <- n :: n2.edges
|
||||
|
||||
// Find everything that depends on FSharp.Core
|
||||
let roots =
|
||||
[ if tcConfig.standalone && depModuleTable.ContainsKey (GetFSharpCoreLibraryName()) then
|
||||
yield depModuleTable[GetFSharpCoreLibraryName()]
|
||||
for n in tcConfig.extraStaticLinkRoots do
|
||||
match depModuleTable.TryFind n with
|
||||
| Some x -> yield x
|
||||
| None -> error(Error(FSComp.SR.fscAssemblyNotFoundInDependencySet n, rangeStartup))
|
||||
[
|
||||
if tcConfig.standalone && depModuleTable.ContainsKey(GetFSharpCoreLibraryName()) then
|
||||
depModuleTable[GetFSharpCoreLibraryName()]
|
||||
for n in tcConfig.extraStaticLinkRoots do
|
||||
match depModuleTable.TryFind n with
|
||||
| Some x -> x
|
||||
| None -> error (Error(FSComp.SR.fscAssemblyNotFoundInDependencySet n, rangeStartup))
|
||||
]
|
||||
|
||||
let mutable remaining = roots
|
||||
[ while not (isNil remaining) do
|
||||
let n = List.head remaining
|
||||
remaining <- List.tail remaining
|
||||
if not n.visited then
|
||||
n.visited <- true
|
||||
remaining <- n.edges @ remaining
|
||||
yield (n.ccu, n.data) ]
|
||||
|
||||
[
|
||||
while not (isNil remaining) do
|
||||
let n = List.head remaining
|
||||
remaining <- List.tail remaining
|
||||
|
||||
if not n.visited then
|
||||
n.visited <- true
|
||||
remaining <- n.edges @ remaining
|
||||
(n.ccu, n.data)
|
||||
]
|
||||
|
||||
// Add all provider-generated assemblies into the static linking set
|
||||
let FindProviderGeneratedILModules (ctok, tcImports: TcImports, providerGeneratedAssemblies: (ImportedBinary * _) list) =
|
||||
[ for importedBinary, provAssemStaticLinkInfo in providerGeneratedAssemblies do
|
||||
let ilAssemRef =
|
||||
match importedBinary.ILScopeRef with
|
||||
| ILScopeRef.Assembly aref -> aref
|
||||
| _ -> failwith "Invalid ILScopeRef, expected ILScopeRef.Assembly"
|
||||
if debugStaticLinking then printfn "adding provider-generated assembly '%s' into static linking set" ilAssemRef.Name
|
||||
match tcImports.TryFindDllInfo(ctok, rangeStartup, ilAssemRef.Name, lookupOnly=false) with
|
||||
| Some dllInfo ->
|
||||
let ccu =
|
||||
match tcImports.FindCcuFromAssemblyRef (ctok, rangeStartup, ilAssemRef) with
|
||||
| ResolvedCcu ccu -> Some ccu
|
||||
| UnresolvedCcu(_ccuName) -> None
|
||||
[
|
||||
for importedBinary, provAssemStaticLinkInfo in providerGeneratedAssemblies do
|
||||
let ilAssemRef =
|
||||
match importedBinary.ILScopeRef with
|
||||
| ILScopeRef.Assembly aref -> aref
|
||||
| _ -> failwith "Invalid ILScopeRef, expected ILScopeRef.Assembly"
|
||||
|
||||
let modul = dllInfo.RawMetadata.TryGetILModuleDef().Value
|
||||
yield (ccu, dllInfo.ILScopeRef, modul), (ilAssemRef.Name, provAssemStaticLinkInfo)
|
||||
| None -> () ]
|
||||
if debugStaticLinking then
|
||||
printfn "adding provider-generated assembly '%s' into static linking set" ilAssemRef.Name
|
||||
|
||||
match tcImports.TryFindDllInfo(ctok, rangeStartup, ilAssemRef.Name, lookupOnly = false) with
|
||||
| Some dllInfo ->
|
||||
let ccu =
|
||||
match tcImports.FindCcuFromAssemblyRef(ctok, rangeStartup, ilAssemRef) with
|
||||
| ResolvedCcu ccu -> Some ccu
|
||||
| UnresolvedCcu (_ccuName) -> None
|
||||
|
||||
let modul = dllInfo.RawMetadata.TryGetILModuleDef().Value
|
||||
(ccu, dllInfo.ILScopeRef, modul), (ilAssemRef.Name, provAssemStaticLinkInfo)
|
||||
| None -> ()
|
||||
]
|
||||
|
||||
/// Split the list into left, middle and right parts at the first element satisfying 'p'. If no element matches return
|
||||
/// 'None' for the middle part.
|
||||
let trySplitFind p xs =
|
||||
let rec loop xs acc =
|
||||
match xs with
|
||||
| [] -> List.rev acc, None, []
|
||||
| h :: t -> if p h then List.rev acc, Some h, t else loop t (h :: acc)
|
||||
|
||||
loop xs []
|
||||
|
||||
/// Implant the (nested) type definition 'td' at path 'enc' in 'tdefs'.
|
||||
let rec implantTypeDef ilGlobals isNested (tdefs: ILTypeDefs) (enc: string list) (td: ILTypeDef) =
|
||||
match enc with
|
||||
| [] -> addILTypeDef td tdefs
|
||||
| h :: t ->
|
||||
let tdefs = tdefs.AsList()
|
||||
|
||||
let ltdefs, htd, rtdefs =
|
||||
match tdefs |> trySplitFind (fun td -> td.Name = h) with
|
||||
| ltdefs, None, rtdefs ->
|
||||
let access =
|
||||
if isNested then
|
||||
ILTypeDefAccess.Nested ILMemberAccess.Public
|
||||
else
|
||||
ILTypeDefAccess.Public
|
||||
|
||||
let fresh =
|
||||
mkILSimpleClass
|
||||
ilGlobals
|
||||
(h,
|
||||
access,
|
||||
emptyILMethods,
|
||||
emptyILFields,
|
||||
emptyILTypeDefs,
|
||||
emptyILProperties,
|
||||
emptyILEvents,
|
||||
emptyILCustomAttrs,
|
||||
ILTypeInit.OnAny)
|
||||
|
||||
(ltdefs, fresh, rtdefs)
|
||||
| ltdefs, Some htd, rtdefs -> (ltdefs, htd, rtdefs)
|
||||
|
||||
let htd = htd.With(nestedTypes = implantTypeDef ilGlobals true htd.NestedTypes t td)
|
||||
mkILTypeDefs (ltdefs @ [ htd ] @ rtdefs)
|
||||
|
||||
// Compute a static linker. This only captures tcImports (a large data structure) if
|
||||
// static linking is enabled. Normally this is not the case, which lets us collect tcImports
|
||||
|
|
@ -343,181 +495,231 @@ let StaticLink (ctok, tcConfig: TcConfig, tcImports: TcImports, ilGlobals: ILGlo
|
|||
let providerGeneratedAssemblies =
|
||||
|
||||
[ // Add all EST-generated assemblies into the static linking set
|
||||
for KeyValue(_, importedBinary: ImportedBinary) in tcImports.DllTable do
|
||||
for KeyValue (_, importedBinary: ImportedBinary) in tcImports.DllTable do
|
||||
if importedBinary.IsProviderGenerated then
|
||||
match importedBinary.ProviderGeneratedStaticLinkMap with
|
||||
| None -> ()
|
||||
| Some provAssemStaticLinkInfo -> yield (importedBinary, provAssemStaticLinkInfo) ]
|
||||
| Some provAssemStaticLinkInfo -> (importedBinary, provAssemStaticLinkInfo)
|
||||
]
|
||||
#endif
|
||||
if not tcConfig.standalone && tcConfig.extraStaticLinkRoots.IsEmpty
|
||||
if not tcConfig.standalone
|
||||
&& tcConfig.extraStaticLinkRoots.IsEmpty
|
||||
#if !NO_TYPEPROVIDERS
|
||||
&& providerGeneratedAssemblies.IsEmpty
|
||||
&& providerGeneratedAssemblies.IsEmpty
|
||||
#endif
|
||||
then
|
||||
then
|
||||
id
|
||||
else
|
||||
(fun ilxMainModule ->
|
||||
(fun ilxMainModule ->
|
||||
match tcConfig.emitMetadataAssembly with
|
||||
| MetadataAssemblyGeneration.None -> ()
|
||||
| _ ->
|
||||
error(Error(FSComp.SR.optsInvalidRefAssembly(), rangeCmdArgs))
|
||||
| _ -> error (Error(FSComp.SR.optsInvalidRefAssembly (), rangeCmdArgs))
|
||||
|
||||
ReportTime tcConfig "Find assembly references"
|
||||
|
||||
let dependentILModules = FindDependentILModulesForStaticLinking (ctok, tcConfig, tcImports, ilGlobals, ilxMainModule)
|
||||
let dependentILModules =
|
||||
FindDependentILModulesForStaticLinking(ctok, tcConfig, tcImports, ilGlobals, ilxMainModule)
|
||||
|
||||
ReportTime tcConfig "Static link"
|
||||
|
||||
#if !NO_TYPEPROVIDERS
|
||||
Morphs.enableMorphCustomAttributeData()
|
||||
let providerGeneratedILModules = FindProviderGeneratedILModules (ctok, tcImports, providerGeneratedAssemblies)
|
||||
Morphs.enableMorphCustomAttributeData ()
|
||||
|
||||
let providerGeneratedILModules =
|
||||
FindProviderGeneratedILModules(ctok, tcImports, providerGeneratedAssemblies)
|
||||
|
||||
// Transform the ILTypeRefs references in the IL of all provider-generated assemblies so that the references
|
||||
// are now local.
|
||||
let providerGeneratedILModules =
|
||||
|
||||
providerGeneratedILModules |> List.map (fun ((ccu, ilOrigScopeRef, ilModule), (_, localProvAssemStaticLinkInfo)) ->
|
||||
providerGeneratedILModules
|
||||
|> List.map (fun ((ccu, ilOrigScopeRef, ilModule), (_, localProvAssemStaticLinkInfo)) ->
|
||||
let ilAssemStaticLinkMap =
|
||||
dict [ for _, (_, provAssemStaticLinkInfo) in providerGeneratedILModules do
|
||||
for KeyValue(k, v) in provAssemStaticLinkInfo.ILTypeMap do
|
||||
yield (k, v)
|
||||
for KeyValue(k, v) in localProvAssemStaticLinkInfo.ILTypeMap do
|
||||
yield (ILTypeRef.Create(ILScopeRef.Local, k.Enclosing, k.Name), v) ]
|
||||
dict
|
||||
[
|
||||
for _, (_, provAssemStaticLinkInfo) in providerGeneratedILModules do
|
||||
for KeyValue (k, v) in provAssemStaticLinkInfo.ILTypeMap do
|
||||
(k, v)
|
||||
for KeyValue (k, v) in localProvAssemStaticLinkInfo.ILTypeMap do
|
||||
(ILTypeRef.Create(ILScopeRef.Local, k.Enclosing, k.Name), v)
|
||||
]
|
||||
|
||||
let ilModule =
|
||||
ilModule |> Morphs.morphILTypeRefsInILModuleMemoized (fun tref ->
|
||||
if debugStaticLinking then printfn "deciding whether to rewrite type ref %A" tref.QualifiedName
|
||||
let ok, v = ilAssemStaticLinkMap.TryGetValue tref
|
||||
if ok then
|
||||
if debugStaticLinking then printfn "rewriting type ref %A to %A" tref.QualifiedName v.QualifiedName
|
||||
v
|
||||
else
|
||||
tref)
|
||||
ilModule
|
||||
|> Morphs.morphILTypeRefsInILModuleMemoized (fun tref ->
|
||||
if debugStaticLinking then
|
||||
printfn "deciding whether to rewrite type ref %A" tref.QualifiedName
|
||||
|
||||
match ilAssemStaticLinkMap.TryGetValue tref with
|
||||
| true, v ->
|
||||
if debugStaticLinking then
|
||||
printfn "rewriting type ref %A to %A" tref.QualifiedName v.QualifiedName
|
||||
|
||||
v
|
||||
| _ -> tref)
|
||||
|
||||
(ccu, ilOrigScopeRef, ilModule))
|
||||
|
||||
// Relocate provider generated type definitions into the expected shape for the [<Generate>] declarations in an assembly
|
||||
let providerGeneratedILModules, ilxMainModule =
|
||||
// Build a dictionary of all remapped IL type defs
|
||||
let ilOrigTyRefsForProviderGeneratedTypesToRelocate =
|
||||
let rec walk acc (ProviderGeneratedType(ilOrigTyRef, _, xs) as node) = List.fold walk ((ilOrigTyRef, node) :: acc) xs
|
||||
dict (Seq.fold walk [] tcImports.ProviderGeneratedTypeRoots)
|
||||
// Build a dictionary of all remapped IL type defs
|
||||
let ilOrigTyRefsForProviderGeneratedTypesToRelocate =
|
||||
let rec walk acc (ProviderGeneratedType (ilOrigTyRef, _, xs) as node) =
|
||||
List.fold walk ((ilOrigTyRef, node) :: acc) xs
|
||||
|
||||
// Build a dictionary of all IL type defs, mapping ilOrigTyRef --> ilTypeDef
|
||||
let allTypeDefsInProviderGeneratedAssemblies =
|
||||
let rec loop ilOrigTyRef (ilTypeDef: ILTypeDef) =
|
||||
seq { yield (ilOrigTyRef, ilTypeDef)
|
||||
for ntdef in ilTypeDef.NestedTypes do
|
||||
yield! loop (mkILTyRefInTyRef (ilOrigTyRef, ntdef.Name)) ntdef }
|
||||
dict [
|
||||
for _ccu, ilOrigScopeRef, ilModule in providerGeneratedILModules do
|
||||
for td in ilModule.TypeDefs do
|
||||
yield! loop (mkILTyRef (ilOrigScopeRef, td.Name)) td ]
|
||||
dict (Seq.fold walk [] tcImports.ProviderGeneratedTypeRoots)
|
||||
|
||||
// Build a dictionary of all IL type defs, mapping ilOrigTyRef --> ilTypeDef
|
||||
let allTypeDefsInProviderGeneratedAssemblies =
|
||||
let rec loop ilOrigTyRef (ilTypeDef: ILTypeDef) =
|
||||
seq {
|
||||
(ilOrigTyRef, ilTypeDef)
|
||||
|
||||
// Debugging output
|
||||
if debugStaticLinking then
|
||||
for ProviderGeneratedType(ilOrigTyRef, _, _) in tcImports.ProviderGeneratedTypeRoots do
|
||||
printfn "Have [<Generate>] root '%s'" ilOrigTyRef.QualifiedName
|
||||
for ntdef in ilTypeDef.NestedTypes do
|
||||
yield! loop (mkILTyRefInTyRef (ilOrigTyRef, ntdef.Name)) ntdef
|
||||
}
|
||||
|
||||
// Build the ILTypeDefs for generated types, starting with the roots
|
||||
let generatedILTypeDefs =
|
||||
let rec buildRelocatedGeneratedType (ProviderGeneratedType(ilOrigTyRef, ilTgtTyRef, ch)) =
|
||||
let isNested = not (isNil ilTgtTyRef.Enclosing)
|
||||
match allTypeDefsInProviderGeneratedAssemblies.TryGetValue ilOrigTyRef with
|
||||
| true, ilOrigTypeDef ->
|
||||
if debugStaticLinking then printfn "Relocating %s to %s " ilOrigTyRef.QualifiedName ilTgtTyRef.QualifiedName
|
||||
let ilOrigTypeDef =
|
||||
dict
|
||||
[
|
||||
for _ccu, ilOrigScopeRef, ilModule in providerGeneratedILModules do
|
||||
for td in ilModule.TypeDefs do
|
||||
yield! loop (mkILTyRef (ilOrigScopeRef, td.Name)) td
|
||||
]
|
||||
|
||||
// Debugging output
|
||||
if debugStaticLinking then
|
||||
for ProviderGeneratedType (ilOrigTyRef, _, _) in tcImports.ProviderGeneratedTypeRoots do
|
||||
printfn "Have [<Generate>] root '%s'" ilOrigTyRef.QualifiedName
|
||||
|
||||
// Build the ILTypeDefs for generated types, starting with the roots
|
||||
let generatedILTypeDefs =
|
||||
let rec buildRelocatedGeneratedType (ProviderGeneratedType (ilOrigTyRef, ilTgtTyRef, ch)) =
|
||||
let isNested = not (isNil ilTgtTyRef.Enclosing)
|
||||
|
||||
match allTypeDefsInProviderGeneratedAssemblies.TryGetValue ilOrigTyRef with
|
||||
| true, ilOrigTypeDef ->
|
||||
if debugStaticLinking then
|
||||
printfn "Relocating %s to %s " ilOrigTyRef.QualifiedName ilTgtTyRef.QualifiedName
|
||||
|
||||
let ilOrigTypeDef =
|
||||
if isNested then
|
||||
ilOrigTypeDef.WithAccess(
|
||||
match ilOrigTypeDef.Access with
|
||||
| ILTypeDefAccess.Public -> ILTypeDefAccess.Nested ILMemberAccess.Public
|
||||
| ILTypeDefAccess.Private -> ILTypeDefAccess.Nested ILMemberAccess.Private
|
||||
| _ -> ilOrigTypeDef.Access
|
||||
)
|
||||
else
|
||||
ilOrigTypeDef
|
||||
.WithAccess(match ilOrigTypeDef.Access with
|
||||
| ILTypeDefAccess.Public -> ILTypeDefAccess.Nested ILMemberAccess.Public
|
||||
| ILTypeDefAccess.Private -> ILTypeDefAccess.Nested ILMemberAccess.Private
|
||||
| _ -> ilOrigTypeDef.Access)
|
||||
else ilOrigTypeDef
|
||||
ilOrigTypeDef.With(name = ilTgtTyRef.Name,
|
||||
nestedTypes = mkILTypeDefs (List.map buildRelocatedGeneratedType ch))
|
||||
| _ ->
|
||||
// If there is no matching IL type definition, then make a simple container class
|
||||
if debugStaticLinking then
|
||||
printfn "Generating simple class '%s' because we didn't find an original type '%s' in a provider generated assembly"
|
||||
ilTgtTyRef.QualifiedName ilOrigTyRef.QualifiedName
|
||||
|
||||
let access = (if isNested then ILTypeDefAccess.Nested ILMemberAccess.Public else ILTypeDefAccess.Public)
|
||||
let tdefs = mkILTypeDefs (List.map buildRelocatedGeneratedType ch)
|
||||
mkILSimpleClass ilGlobals (ilTgtTyRef.Name, access, emptyILMethods, emptyILFields, tdefs, emptyILProperties, emptyILEvents, emptyILCustomAttrs, ILTypeInit.OnAny)
|
||||
ilOrigTypeDef.With(name = ilTgtTyRef.Name, nestedTypes = mkILTypeDefs (List.map buildRelocatedGeneratedType ch))
|
||||
| _ ->
|
||||
// If there is no matching IL type definition, then make a simple container class
|
||||
if debugStaticLinking then
|
||||
printfn
|
||||
"Generating simple class '%s' because we didn't find an original type '%s' in a provider generated assembly"
|
||||
ilTgtTyRef.QualifiedName
|
||||
ilOrigTyRef.QualifiedName
|
||||
|
||||
[ for ProviderGeneratedType(_, ilTgtTyRef, _) as node in tcImports.ProviderGeneratedTypeRoots do
|
||||
yield (ilTgtTyRef, buildRelocatedGeneratedType node) ]
|
||||
let access =
|
||||
(if isNested then
|
||||
ILTypeDefAccess.Nested ILMemberAccess.Public
|
||||
else
|
||||
ILTypeDefAccess.Public)
|
||||
|
||||
// Implant all the generated type definitions into the ilxMainModule (generating a new ilxMainModule)
|
||||
let ilxMainModule =
|
||||
let tdefs = mkILTypeDefs (List.map buildRelocatedGeneratedType ch)
|
||||
|
||||
/// Split the list into left, middle and right parts at the first element satisfying 'p'. If no element matches return
|
||||
/// 'None' for the middle part.
|
||||
let trySplitFind p xs =
|
||||
let rec loop xs acc =
|
||||
match xs with
|
||||
| [] -> List.rev acc, None, []
|
||||
| h :: t -> if p h then List.rev acc, Some h, t else loop t (h :: acc)
|
||||
loop xs []
|
||||
mkILSimpleClass
|
||||
ilGlobals
|
||||
(ilTgtTyRef.Name,
|
||||
access,
|
||||
emptyILMethods,
|
||||
emptyILFields,
|
||||
tdefs,
|
||||
emptyILProperties,
|
||||
emptyILEvents,
|
||||
emptyILCustomAttrs,
|
||||
ILTypeInit.OnAny)
|
||||
|
||||
/// Implant the (nested) type definition 'td' at path 'enc' in 'tdefs'.
|
||||
let rec implantTypeDef isNested (tdefs: ILTypeDefs) (enc: string list) (td: ILTypeDef) =
|
||||
match enc with
|
||||
| [] -> addILTypeDef td tdefs
|
||||
| h :: t ->
|
||||
let tdefs = tdefs.AsList()
|
||||
let ltdefs, htd, rtdefs =
|
||||
match tdefs |> trySplitFind (fun td -> td.Name = h) with
|
||||
| ltdefs, None, rtdefs ->
|
||||
let access = if isNested then ILTypeDefAccess.Nested ILMemberAccess.Public else ILTypeDefAccess.Public
|
||||
let fresh = mkILSimpleClass ilGlobals (h, access, emptyILMethods, emptyILFields, emptyILTypeDefs, emptyILProperties, emptyILEvents, emptyILCustomAttrs, ILTypeInit.OnAny)
|
||||
(ltdefs, fresh, rtdefs)
|
||||
| ltdefs, Some htd, rtdefs ->
|
||||
(ltdefs, htd, rtdefs)
|
||||
let htd = htd.With(nestedTypes = implantTypeDef true htd.NestedTypes t td)
|
||||
mkILTypeDefs (ltdefs @ [htd] @ rtdefs)
|
||||
[
|
||||
for ProviderGeneratedType (_, ilTgtTyRef, _) as node in tcImports.ProviderGeneratedTypeRoots do
|
||||
(ilTgtTyRef, buildRelocatedGeneratedType node)
|
||||
]
|
||||
|
||||
let newTypeDefs =
|
||||
(ilxMainModule.TypeDefs, generatedILTypeDefs) ||> List.fold (fun acc (ilTgtTyRef, td) ->
|
||||
if debugStaticLinking then printfn "implanting '%s' at '%s'" td.Name ilTgtTyRef.QualifiedName
|
||||
implantTypeDef false acc ilTgtTyRef.Enclosing td)
|
||||
{ ilxMainModule with TypeDefs = newTypeDefs }
|
||||
// Implant all the generated type definitions into the ilxMainModule (generating a new ilxMainModule)
|
||||
let ilxMainModule =
|
||||
|
||||
// Remove any ILTypeDefs from the provider generated modules if they have been relocated because of a [<Generate>] declaration.
|
||||
let providerGeneratedILModules =
|
||||
providerGeneratedILModules |> List.map (fun (ccu, ilOrigScopeRef, ilModule) ->
|
||||
let ilTypeDefsAfterRemovingRelocatedTypes =
|
||||
let rec rw enc (tdefs: ILTypeDefs) =
|
||||
mkILTypeDefs
|
||||
[ for tdef in tdefs do
|
||||
let ilOrigTyRef = mkILNestedTyRef (ilOrigScopeRef, enc, tdef.Name)
|
||||
if not (ilOrigTyRefsForProviderGeneratedTypesToRelocate.ContainsKey ilOrigTyRef) then
|
||||
if debugStaticLinking then printfn "Keep provided type %s in place because it wasn't relocated" ilOrigTyRef.QualifiedName
|
||||
yield tdef.With(nestedTypes = rw (enc@[tdef.Name]) tdef.NestedTypes) ]
|
||||
rw [] ilModule.TypeDefs
|
||||
(ccu, { ilModule with TypeDefs = ilTypeDefsAfterRemovingRelocatedTypes }))
|
||||
let newTypeDefs =
|
||||
(ilxMainModule.TypeDefs, generatedILTypeDefs)
|
||||
||> List.fold (fun acc (ilTgtTyRef, td) ->
|
||||
if debugStaticLinking then
|
||||
printfn "implanting '%s' at '%s'" td.Name ilTgtTyRef.QualifiedName
|
||||
|
||||
providerGeneratedILModules, ilxMainModule
|
||||
implantTypeDef ilGlobals false acc ilTgtTyRef.Enclosing td)
|
||||
|
||||
Morphs.disableMorphCustomAttributeData()
|
||||
{ ilxMainModule with
|
||||
TypeDefs = newTypeDefs
|
||||
}
|
||||
|
||||
// Remove any ILTypeDefs from the provider generated modules if they have been relocated because of a [<Generate>] declaration.
|
||||
let providerGeneratedILModules =
|
||||
providerGeneratedILModules
|
||||
|> List.map (fun (ccu, ilOrigScopeRef, ilModule) ->
|
||||
let ilTypeDefsAfterRemovingRelocatedTypes =
|
||||
let rec rw enc (tdefs: ILTypeDefs) =
|
||||
mkILTypeDefs
|
||||
[
|
||||
for tdef in tdefs do
|
||||
let ilOrigTyRef = mkILNestedTyRef (ilOrigScopeRef, enc, tdef.Name)
|
||||
|
||||
if not (ilOrigTyRefsForProviderGeneratedTypesToRelocate.ContainsKey ilOrigTyRef) then
|
||||
if debugStaticLinking then
|
||||
printfn
|
||||
"Keep provided type %s in place because it wasn't relocated"
|
||||
ilOrigTyRef.QualifiedName
|
||||
|
||||
tdef.With(nestedTypes = rw (enc @ [ tdef.Name ]) tdef.NestedTypes)
|
||||
]
|
||||
|
||||
rw [] ilModule.TypeDefs
|
||||
|
||||
(ccu,
|
||||
{ ilModule with
|
||||
TypeDefs = ilTypeDefsAfterRemovingRelocatedTypes
|
||||
}))
|
||||
|
||||
providerGeneratedILModules, ilxMainModule
|
||||
|
||||
Morphs.disableMorphCustomAttributeData ()
|
||||
#else
|
||||
let providerGeneratedILModules = []
|
||||
#endif
|
||||
|
||||
// Glue all this stuff into ilxMainModule
|
||||
let ilxMainModule, rewriteExternalRefsToLocalRefs =
|
||||
StaticLinkILModules (tcConfig, ilGlobals, tcImports, ilxMainModule, dependentILModules @ providerGeneratedILModules)
|
||||
StaticLinkILModules(tcConfig, ilGlobals, tcImports, ilxMainModule, dependentILModules @ providerGeneratedILModules)
|
||||
|
||||
// Rewrite type and assembly references
|
||||
let ilxMainModule =
|
||||
let isMscorlib = ilGlobals.primaryAssemblyName = PrimaryAssembly.Mscorlib.Name
|
||||
let validateTargetPlatform (scopeRef : ILScopeRef) =
|
||||
let name = getNameOfScopeRef scopeRef
|
||||
if (not isMscorlib && name = PrimaryAssembly.Mscorlib.Name) then
|
||||
error (Error(FSComp.SR.fscStaticLinkingNoProfileMismatches(), rangeCmdArgs))
|
||||
scopeRef
|
||||
let rewriteAssemblyRefsToMatchLibraries = NormalizeAssemblyRefs (ctok, ilGlobals, tcImports)
|
||||
Morphs.morphILTypeRefsInILModuleMemoized (Morphs.morphILScopeRefsInILTypeRef (validateTargetPlatform >> rewriteExternalRefsToLocalRefs >> rewriteAssemblyRefsToMatchLibraries)) ilxMainModule
|
||||
let isMscorlib = ilGlobals.primaryAssemblyName = PrimaryAssembly.Mscorlib.Name
|
||||
|
||||
let validateTargetPlatform (scopeRef: ILScopeRef) =
|
||||
let name = getNameOfScopeRef scopeRef
|
||||
|
||||
if (not isMscorlib && name = PrimaryAssembly.Mscorlib.Name) then
|
||||
error (Error(FSComp.SR.fscStaticLinkingNoProfileMismatches (), rangeCmdArgs))
|
||||
|
||||
scopeRef
|
||||
|
||||
let rewriteAssemblyRefsToMatchLibraries =
|
||||
NormalizeAssemblyRefs(ctok, ilGlobals, tcImports)
|
||||
|
||||
Morphs.morphILTypeRefsInILModuleMemoized
|
||||
(Morphs.morphILScopeRefsInILTypeRef (
|
||||
validateTargetPlatform
|
||||
>> rewriteExternalRefsToLocalRefs
|
||||
>> rewriteAssemblyRefsToMatchLibraries
|
||||
))
|
||||
ilxMainModule
|
||||
|
||||
ilxMainModule)
|
||||
|
|
|
|||
|
|
@ -25,31 +25,31 @@ module XmlDocWriter =
|
|||
|
||||
let doTyconSig ptext (tc: Tycon) =
|
||||
if hasDoc tc.XmlDoc then
|
||||
tc.XmlDocSig <- XmlDocSigOfTycon [ptext; tc.CompiledName]
|
||||
tc.XmlDocSig <- XmlDocSigOfTycon [ ptext; tc.CompiledName ]
|
||||
|
||||
for vref in tc.MembersOfFSharpTyconSorted do
|
||||
doValSig ptext vref.Deref
|
||||
|
||||
for uc in tc.UnionCasesArray do
|
||||
if hasDoc uc.XmlDoc then
|
||||
uc.XmlDocSig <- XmlDocSigOfUnionCase [ptext; tc.CompiledName; uc.Id.idText]
|
||||
uc.XmlDocSig <- XmlDocSigOfUnionCase [ ptext; tc.CompiledName; uc.Id.idText ]
|
||||
|
||||
for field in uc.RecdFieldsArray do
|
||||
if hasDoc field.XmlDoc then
|
||||
// union case fields are exposed as properties
|
||||
field.XmlDocSig <- XmlDocSigOfProperty [ptext; tc.CompiledName; uc.Id.idText; field.Id.idText]
|
||||
field.XmlDocSig <- XmlDocSigOfProperty [ ptext; tc.CompiledName; uc.Id.idText; field.Id.idText ]
|
||||
|
||||
for rf in tc.AllFieldsArray do
|
||||
if hasDoc rf.XmlDoc then
|
||||
rf.XmlDocSig <-
|
||||
if tc.IsRecordTycon && not rf.IsStatic then
|
||||
// represents a record field, which is exposed as a property
|
||||
XmlDocSigOfProperty [ptext; tc.CompiledName; rf.Id.idText]
|
||||
XmlDocSigOfProperty [ ptext; tc.CompiledName; rf.Id.idText ]
|
||||
else
|
||||
XmlDocSigOfField [ptext; tc.CompiledName; rf.Id.idText]
|
||||
XmlDocSigOfField [ ptext; tc.CompiledName; rf.Id.idText ]
|
||||
|
||||
let doModuleMemberSig path (m: ModuleOrNamespace) =
|
||||
m.XmlDocSig <- XmlDocSigOfSubModul [path]
|
||||
m.XmlDocSig <- XmlDocSigOfSubModul [ path ]
|
||||
|
||||
let rec doModuleSig path (mspec: ModuleOrNamespace) =
|
||||
let mtype = mspec.ModuleOrNamespaceType
|
||||
|
|
@ -59,17 +59,16 @@ module XmlDocWriter =
|
|||
match path with
|
||||
| None -> Some ""
|
||||
| Some "" -> Some mspec.LogicalName
|
||||
| Some p -> Some (p+"."+mspec.LogicalName)
|
||||
| Some p -> Some(p + "." + mspec.LogicalName)
|
||||
|
||||
let ptext = defaultArg path ""
|
||||
|
||||
if mspec.IsModule then
|
||||
doModuleMemberSig ptext mspec
|
||||
if mspec.IsModule then doModuleMemberSig ptext mspec
|
||||
|
||||
let vals =
|
||||
mtype.AllValsAndMembers
|
||||
|> Seq.toList
|
||||
|> List.filter (fun x -> not x.IsCompilerGenerated)
|
||||
|> List.filter (fun x -> not x.IsCompilerGenerated)
|
||||
|> List.filter (fun x -> x.MemberInfo.IsNone || x.IsExtensionMember)
|
||||
|
||||
mtype.ModuleAndNamespaceDefinitions |> List.iter (doModuleSig path)
|
||||
|
|
@ -80,8 +79,8 @@ module XmlDocWriter =
|
|||
doModuleSig None generatedCcu.Contents
|
||||
|
||||
let WriteXmlDocFile (g, assemblyName, generatedCcu: CcuThunk, xmlFile) =
|
||||
if not (FileSystemUtils.checkSuffix xmlFile "xml" ) then
|
||||
error(Error(FSComp.SR.docfileNoXmlSuffix(), Range.rangeStartup))
|
||||
if not (FileSystemUtils.checkSuffix xmlFile "xml") then
|
||||
error (Error(FSComp.SR.docfileNoXmlSuffix (), Range.rangeStartup))
|
||||
|
||||
let mutable members = []
|
||||
|
||||
|
|
@ -90,18 +89,17 @@ module XmlDocWriter =
|
|||
let doc = xmlDoc.GetXmlText()
|
||||
members <- (id, doc) :: members
|
||||
|
||||
let doVal (v: Val) =
|
||||
addMember v.XmlDocSig v.XmlDoc
|
||||
let doVal (v: Val) = addMember v.XmlDocSig v.XmlDoc
|
||||
|
||||
let doField (rf: RecdField) =
|
||||
addMember rf.XmlDocSig rf.XmlDoc
|
||||
let doField (rf: RecdField) = addMember rf.XmlDocSig rf.XmlDoc
|
||||
|
||||
let doUnionCase (uc: UnionCase) =
|
||||
addMember uc.XmlDocSig uc.XmlDoc
|
||||
|
||||
for field in uc.RecdFieldsArray do
|
||||
addMember field.XmlDocSig field.XmlDoc
|
||||
|
||||
let doTycon (tc: Tycon) =
|
||||
let doTycon (tc: Tycon) =
|
||||
addMember tc.XmlDocSig tc.XmlDoc
|
||||
|
||||
for vref in tc.MembersOfFSharpTyconSorted do
|
||||
|
|
@ -114,18 +112,16 @@ module XmlDocWriter =
|
|||
for rf in tc.AllFieldsArray do
|
||||
doField rf
|
||||
|
||||
let modulMember (m: ModuleOrNamespace) =
|
||||
addMember m.XmlDocSig m.XmlDoc
|
||||
let modulMember (m: ModuleOrNamespace) = addMember m.XmlDocSig m.XmlDoc
|
||||
|
||||
let rec doModule (mspec: ModuleOrNamespace) =
|
||||
let mtype = mspec.ModuleOrNamespaceType
|
||||
if mspec.IsModule then
|
||||
modulMember mspec
|
||||
if mspec.IsModule then modulMember mspec
|
||||
|
||||
let vals =
|
||||
mtype.AllValsAndMembers
|
||||
|> Seq.toList
|
||||
|> List.filter (fun x -> not x.IsCompilerGenerated)
|
||||
|> List.filter (fun x -> not x.IsCompilerGenerated)
|
||||
|> List.filter (fun x -> x.MemberInfo.IsNone || x.IsExtensionMember)
|
||||
|
||||
List.iter doModule mtype.ModuleAndNamespaceDefinitions
|
||||
|
|
@ -143,9 +139,9 @@ module XmlDocWriter =
|
|||
fprintfn os "<members>"
|
||||
|
||||
for (nm, doc) in members do
|
||||
fprintfn os "<member name=\"%s\">" nm
|
||||
fprintfn os "%s" doc
|
||||
fprintfn os "</member>"
|
||||
fprintfn os "<member name=\"%s\">" nm
|
||||
fprintfn os "%s" doc
|
||||
fprintfn os "</member>"
|
||||
|
||||
fprintfn os "</members>"
|
||||
fprintfn os "</doc>"
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -1906,7 +1906,8 @@ type internal FsiDynamicCompiler(
|
|||
|
||||
match fsiOptions.DependencyProvider.TryFindDependencyManagerByKey(tcConfigB.compilerToolPaths, getOutputDir tcConfigB, reportError m, packageManagerKey) with
|
||||
| Null ->
|
||||
errorR(Error(fsiOptions.DependencyProvider.CreatePackageManagerUnknownError(tcConfigB.compilerToolPaths, outputDir, packageManagerKey, reportError m), m))
|
||||
let err = fsiOptions.DependencyProvider.CreatePackageManagerUnknownError(tcConfigB.compilerToolPaths, outputDir, packageManagerKey, reportError m)
|
||||
errorR(Error(err, m))
|
||||
istate
|
||||
| NonNull dependencyManager ->
|
||||
let directive d =
|
||||
|
|
|
|||
|
|
@ -80,10 +80,7 @@ let jaro (s1: string) (s2: string) =
|
|||
/ 3.0
|
||||
|
||||
// This is for cases where |s1|, |s2| or m are zero
|
||||
if Double.IsNaN result then
|
||||
0.0
|
||||
else
|
||||
result
|
||||
if Double.IsNaN result then 0.0 else result
|
||||
|
||||
/// Calculates the Jaro-Winkler edit distance between two strings.
|
||||
/// The edit distance is a metric that allows to measure the amount of similarity between two strings.
|
||||
|
|
|
|||
|
|
@ -127,8 +127,7 @@ type ByteArrayMemory(bytes: byte[], offset, length) =
|
|||
ByteArrayMemory(Array.empty, 0, 0) :> ByteMemory
|
||||
|
||||
override _.CopyTo stream =
|
||||
if length > 0 then
|
||||
stream.Write(bytes, offset, length)
|
||||
if length > 0 then stream.Write(bytes, offset, length)
|
||||
|
||||
override _.Copy(srcOffset, dest, destOffset, count) =
|
||||
checkCount count
|
||||
|
|
@ -381,12 +380,11 @@ module MemoryMappedFileExtensions =
|
|||
use stream = mmf.CreateViewStream(0L, length, MemoryMappedFileAccess.ReadWrite)
|
||||
copyTo stream
|
||||
Some mmf
|
||||
with
|
||||
| _ ->
|
||||
with _ ->
|
||||
mmf.Dispose()
|
||||
None
|
||||
with
|
||||
| _ -> None
|
||||
with _ ->
|
||||
None
|
||||
|
||||
type MemoryMappedFile with
|
||||
|
||||
|
|
@ -414,8 +412,7 @@ module internal FileSystemUtils =
|
|||
let checkSuffix (path: string) (suffix: string) = path.EndsWithOrdinalIgnoreCase(suffix)
|
||||
|
||||
let hasExtensionWithValidate (validate: bool) (s: string) =
|
||||
if validate then
|
||||
(checkPathForIllegalChars s)
|
||||
if validate then (checkPathForIllegalChars s)
|
||||
|
||||
let sLen = s.Length
|
||||
|
||||
|
|
@ -440,8 +437,7 @@ module internal FileSystemUtils =
|
|||
Path.GetFileName(path)
|
||||
|
||||
let fileNameWithoutExtensionWithValidate (validate: bool) path =
|
||||
if validate then
|
||||
checkPathForIllegalChars path
|
||||
if validate then checkPathForIllegalChars path
|
||||
|
||||
Path.GetFileNameWithoutExtension(path)
|
||||
|
||||
|
|
@ -567,8 +563,7 @@ type DefaultFileSystem() as this =
|
|||
|
||||
let stream = new MemoryMappedStream(mmf, length)
|
||||
|
||||
if not stream.CanRead then
|
||||
invalidOp "Cannot read file"
|
||||
if not stream.CanRead then invalidOp "Cannot read file"
|
||||
|
||||
stream :> Stream
|
||||
|
||||
|
|
@ -615,8 +610,8 @@ type DefaultFileSystem() as this =
|
|||
ifs.GetFullPathShim path
|
||||
else
|
||||
path
|
||||
with
|
||||
| _ -> path
|
||||
with _ ->
|
||||
path
|
||||
|
||||
abstract IsInvalidPathShim: path: string -> bool
|
||||
|
||||
|
|
@ -886,8 +881,7 @@ type internal ByteStream =
|
|||
}
|
||||
|
||||
member b.ReadByte() =
|
||||
if b.pos >= b.max then
|
||||
failwith "end of stream"
|
||||
if b.pos >= b.max then failwith "end of stream"
|
||||
|
||||
let res = b.bytes[b.pos]
|
||||
b.pos <- b.pos + 1
|
||||
|
|
@ -954,8 +948,7 @@ type internal ByteBuffer =
|
|||
|
||||
Bytes.blit old 0 buf.bbArray 0 buf.bbCurrent
|
||||
|
||||
if buf.useArrayPool then
|
||||
ArrayPool.Shared.Return old
|
||||
if buf.useArrayPool then ArrayPool.Shared.Return old
|
||||
|
||||
member buf.AsMemory() =
|
||||
buf.CheckDisposed()
|
||||
|
|
|
|||
|
|
@ -170,8 +170,7 @@ type internal HashMultiMap<'Key, 'Value>(size: int, comparer: IEqualityComparer<
|
|||
member s.Remove(x) =
|
||||
match s.TryFind x.Key with
|
||||
| Some v ->
|
||||
if Unchecked.equals v x.Value then
|
||||
s.Remove(x.Key)
|
||||
if Unchecked.equals v x.Value then s.Remove(x.Key)
|
||||
|
||||
true
|
||||
| _ -> false
|
||||
|
|
|
|||
|
|
@ -18,8 +18,7 @@ module ImmutableArray =
|
|||
| 0 -> ImmutableArray.Empty
|
||||
| 1 -> ImmutableArray.Create(f 0)
|
||||
| n ->
|
||||
if n < 0 then
|
||||
invalidArg "n" "Below zero."
|
||||
if n < 0 then invalidArg "n" "Below zero."
|
||||
|
||||
let builder = ImmutableArray.CreateBuilder(n)
|
||||
|
||||
|
|
@ -144,12 +143,9 @@ module ImmutableArray =
|
|||
|
||||
let tryFind predicate (arr: ImmutableArray<'T>) =
|
||||
let rec loop i =
|
||||
if i >= arr.Length then
|
||||
None
|
||||
else if predicate arr[i] then
|
||||
Some arr[i]
|
||||
else
|
||||
loop (i + 1)
|
||||
if i >= arr.Length then None
|
||||
else if predicate arr[i] then Some arr[i]
|
||||
else loop (i + 1)
|
||||
|
||||
loop 0
|
||||
|
||||
|
|
@ -184,8 +180,7 @@ module ImmutableArray =
|
|||
let builder = ImmutableArray.CreateBuilder(arr.Length)
|
||||
|
||||
for i = 0 to arr.Length - 1 do
|
||||
if predicate arr[i] then
|
||||
builder.Add(arr[i])
|
||||
if predicate arr[i] then builder.Add(arr[i])
|
||||
|
||||
builder.Capacity <- builder.Count
|
||||
builder.MoveToImmutable()
|
||||
|
|
@ -204,8 +199,7 @@ module ImmutableArray =
|
|||
for i = 0 to arr.Length - 1 do
|
||||
let result = chooser arr[i]
|
||||
|
||||
if result.IsSome then
|
||||
builder.Add(result.Value)
|
||||
if result.IsSome then builder.Add(result.Value)
|
||||
|
||||
builder.Capacity <- builder.Count
|
||||
builder.MoveToImmutable()
|
||||
|
|
|
|||
|
|
@ -142,11 +142,7 @@ type internal AgedLookup<'Token, 'Key, 'Value when 'Value: not struct>(keepStron
|
|||
member al.Put(tok, key, value) =
|
||||
let data = FilterAndHold(tok)
|
||||
|
||||
let data =
|
||||
if Exists(data, key) then
|
||||
RemoveImpl(data, key)
|
||||
else
|
||||
data
|
||||
let data = if Exists(data, key) then RemoveImpl(data, key) else data
|
||||
|
||||
let data = Add(data, key, value)
|
||||
AssignWithStrength(tok, data) // This will remove extras
|
||||
|
|
@ -201,11 +197,7 @@ type internal MruCache<'Token, 'Key, 'Value when 'Value: not struct>
|
|||
|
||||
member bc.TryGetAny(tok, key) =
|
||||
match cache.TryPeekKeyValue(tok, key) with
|
||||
| Some (similarKey, value) ->
|
||||
if areSame (similarKey, key) then
|
||||
Some(value)
|
||||
else
|
||||
None
|
||||
| Some (similarKey, value) -> if areSame (similarKey, key) then Some(value) else None
|
||||
| None -> None
|
||||
|
||||
member bc.TryGet(tok, key) =
|
||||
|
|
@ -224,11 +216,7 @@ type internal MruCache<'Token, 'Key, 'Value when 'Value: not struct>
|
|||
|
||||
member bc.TryGetSimilar(tok, key) =
|
||||
match cache.TryGetKeyValue(tok, key) with
|
||||
| Some (_, value) ->
|
||||
if isStillValid (key, value) then
|
||||
Some value
|
||||
else
|
||||
None
|
||||
| Some (_, value) -> if isStillValid (key, value) then Some value else None
|
||||
| None -> None
|
||||
|
||||
member bc.Set(tok, key: 'Key, value: 'Value) = cache.Put(tok, key, value)
|
||||
|
|
|
|||
|
|
@ -27,10 +27,7 @@ type internal QueueList<'T>(firstElementsIn: 'T list, lastElementsRevIn: 'T list
|
|||
|
||||
// Compute the last elements on demand.
|
||||
let lastElements () =
|
||||
if push then
|
||||
[]
|
||||
else
|
||||
List.rev lastElementsRev
|
||||
if push then [] else List.rev lastElementsRev
|
||||
|
||||
static let empty = QueueList<'T>([], [], 0)
|
||||
|
||||
|
|
|
|||
|
|
@ -26,8 +26,7 @@ module internal ResizeArray =
|
|||
if start2 < 0 then
|
||||
invalidArg "start2" "index must be positive"
|
||||
|
||||
if len < 0 then
|
||||
invalidArg "len" "length must be positive"
|
||||
if len < 0 then invalidArg "len" "length must be positive"
|
||||
|
||||
if start1 + len > length arr1 then
|
||||
invalidArg "start1" "(start1+len) out of range"
|
||||
|
|
@ -53,8 +52,7 @@ module internal ResizeArray =
|
|||
if start < 0 then
|
||||
invalidArg "start" "index must be positive"
|
||||
|
||||
if len < 0 then
|
||||
invalidArg "len" "length must be positive"
|
||||
if len < 0 then invalidArg "len" "length must be positive"
|
||||
|
||||
if start + len > length arr then
|
||||
invalidArg "len" "length must be positive"
|
||||
|
|
@ -65,8 +63,7 @@ module internal ResizeArray =
|
|||
if start < 0 then
|
||||
invalidArg "start" "index must be positive"
|
||||
|
||||
if len < 0 then
|
||||
invalidArg "len" "length must be positive"
|
||||
if len < 0 then invalidArg "len" "length must be positive"
|
||||
|
||||
if start + len > length arr then
|
||||
invalidArg "len" "length must be positive"
|
||||
|
|
|
|||
|
|
@ -106,12 +106,9 @@ module SetTree =
|
|||
// nb. no check for rebalance needed for small trees, also be sure to reuse node already allocated
|
||||
let c = comparer.Compare(k, t.Key)
|
||||
|
||||
if c < 0 then
|
||||
SetTreeNode(k, empty, t, 2) :> SetTree<'T>
|
||||
elif c = 0 then
|
||||
t
|
||||
else
|
||||
SetTreeNode(k, t, empty, 2) :> SetTree<'T>
|
||||
if c < 0 then SetTreeNode(k, empty, t, 2) :> SetTree<'T>
|
||||
elif c = 0 then t
|
||||
else SetTreeNode(k, t, empty, 2) :> SetTree<'T>
|
||||
|
||||
let rec balance comparer (t1: SetTree<'T>) k (t2: SetTree<'T>) =
|
||||
// Given t1 < k < t2 where t1 and t2 are "balanced",
|
||||
|
|
@ -211,12 +208,9 @@ module SetTree =
|
|||
|
||||
match t with
|
||||
| :? SetTreeNode<'T> as tn ->
|
||||
if c < 0 then
|
||||
contains comparer k tn.Left
|
||||
elif c = 0 then
|
||||
true
|
||||
else
|
||||
contains comparer k tn.Right
|
||||
if c < 0 then contains comparer k tn.Left
|
||||
elif c = 0 then true
|
||||
else contains comparer k tn.Right
|
||||
| _ -> (c = 0)
|
||||
|
||||
let rec iter f (t: SetTree<'T>) =
|
||||
|
|
@ -266,18 +260,10 @@ module SetTree =
|
|||
else
|
||||
match t with
|
||||
| :? SetTreeNode<'T> as tn ->
|
||||
let acc =
|
||||
if f tn.Key then
|
||||
add comparer tn.Key acc
|
||||
else
|
||||
acc
|
||||
let acc = if f tn.Key then add comparer tn.Key acc else acc
|
||||
|
||||
filterAux comparer f tn.Left (filterAux comparer f tn.Right acc)
|
||||
| _ ->
|
||||
if f t.Key then
|
||||
add comparer t.Key acc
|
||||
else
|
||||
acc
|
||||
| _ -> if f t.Key then add comparer t.Key acc else acc
|
||||
|
||||
let filter comparer f s = filterAux comparer f s empty
|
||||
|
||||
|
|
@ -495,10 +481,7 @@ module SetTree =
|
|||
| _, [] -> 1
|
||||
| x1 :: t1, x2 :: t2 ->
|
||||
if isEmpty x1 then
|
||||
if isEmpty x2 then
|
||||
compareStacks comparer t1 t2
|
||||
else
|
||||
cont ()
|
||||
if isEmpty x2 then compareStacks comparer t1 t2 else cont ()
|
||||
elif isEmpty x2 then
|
||||
cont ()
|
||||
else
|
||||
|
|
@ -540,10 +523,7 @@ module SetTree =
|
|||
| _ ->
|
||||
let c = comparer.Compare(x1.Key, x2.Key)
|
||||
|
||||
if c <> 0 then
|
||||
c
|
||||
else
|
||||
compareStacks comparer t1 t2
|
||||
if c <> 0 then c else compareStacks comparer t1 t2
|
||||
|
||||
let compare comparer (t1: SetTree<'T>) (t2: SetTree<'T>) =
|
||||
if isEmpty t1 then
|
||||
|
|
@ -648,20 +628,14 @@ type internal Set<'T, 'ComparerTag> when 'ComparerTag :> IComparer<'T>(comparer:
|
|||
SetTree.intersection a.Comparer a.Tree b.Tree |> refresh a
|
||||
|
||||
static member Union(a: Set<'T, 'ComparerTag>, b: Set<'T, 'ComparerTag>) : Set<'T, 'ComparerTag> =
|
||||
if SetTree.isEmpty b.Tree then
|
||||
a (* A U 0 = A *)
|
||||
else if SetTree.isEmpty a.Tree then
|
||||
b (* 0 U B = B *)
|
||||
else
|
||||
SetTree.union a.Comparer a.Tree b.Tree |> refresh a
|
||||
if SetTree.isEmpty b.Tree then a (* A U 0 = A *)
|
||||
else if SetTree.isEmpty a.Tree then b (* 0 U B = B *)
|
||||
else SetTree.union a.Comparer a.Tree b.Tree |> refresh a
|
||||
|
||||
static member Difference(a: Set<'T, 'ComparerTag>, b: Set<'T, 'ComparerTag>) : Set<'T, 'ComparerTag> =
|
||||
if SetTree.isEmpty a.Tree then
|
||||
a (* 0 - B = 0 *)
|
||||
else if SetTree.isEmpty b.Tree then
|
||||
a (* A - 0 = A *)
|
||||
else
|
||||
SetTree.diff a.Comparer a.Tree b.Tree |> refresh a
|
||||
if SetTree.isEmpty a.Tree then a (* 0 - B = 0 *)
|
||||
else if SetTree.isEmpty b.Tree then a (* A - 0 = A *)
|
||||
else SetTree.diff a.Comparer a.Tree b.Tree |> refresh a
|
||||
|
||||
static member Equality(a: Set<'T, 'ComparerTag>, b: Set<'T, 'ComparerTag>) =
|
||||
(SetTree.compare a.Comparer a.Tree b.Tree = 0)
|
||||
|
|
@ -852,18 +826,12 @@ module MapTree =
|
|||
let find (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) =
|
||||
let mutable v = Unchecked.defaultof<'Value>
|
||||
|
||||
if tryGetValue comparer k &v m then
|
||||
v
|
||||
else
|
||||
indexNotFound ()
|
||||
if tryGetValue comparer k &v m then v else indexNotFound ()
|
||||
|
||||
let tryFind (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) =
|
||||
let mutable v = Unchecked.defaultof<'Value>
|
||||
|
||||
if tryGetValue comparer k &v m then
|
||||
Some v
|
||||
else
|
||||
None
|
||||
if tryGetValue comparer k &v m then Some v else None
|
||||
|
||||
let partition1 (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) k v (acc1, acc2) =
|
||||
if f.Invoke(k, v) then
|
||||
|
|
@ -886,10 +854,7 @@ module MapTree =
|
|||
partitionAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m (empty, empty)
|
||||
|
||||
let filter1 (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) k v acc =
|
||||
if f.Invoke(k, v) then
|
||||
add comparer k v acc
|
||||
else
|
||||
acc
|
||||
if f.Invoke(k, v) then add comparer k v acc else acc
|
||||
|
||||
let rec filterAux (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) acc =
|
||||
if isEmpty m then
|
||||
|
|
@ -1061,11 +1026,7 @@ module MapTree =
|
|||
let cLoKey = comparer.Compare(lo, mn.Key)
|
||||
let cKeyHi = comparer.Compare(mn.Key, hi)
|
||||
|
||||
let x =
|
||||
if cLoKey < 0 then
|
||||
foldFromTo f mn.Left x
|
||||
else
|
||||
x
|
||||
let x = if cLoKey < 0 then foldFromTo f mn.Left x else x
|
||||
|
||||
let x =
|
||||
if cLoKey <= 0 && cKeyHi <= 0 then
|
||||
|
|
@ -1073,11 +1034,7 @@ module MapTree =
|
|||
else
|
||||
x
|
||||
|
||||
let x =
|
||||
if cKeyHi < 0 then
|
||||
foldFromTo f mn.Right x
|
||||
else
|
||||
x
|
||||
let x = if cKeyHi < 0 then foldFromTo f mn.Right x else x
|
||||
|
||||
x
|
||||
| _ ->
|
||||
|
|
@ -1092,10 +1049,7 @@ module MapTree =
|
|||
|
||||
x
|
||||
|
||||
if comparer.Compare(lo, hi) = 1 then
|
||||
x
|
||||
else
|
||||
foldFromTo f m x
|
||||
if comparer.Compare(lo, hi) = 1 then x else foldFromTo f m x
|
||||
|
||||
let foldSection (comparer: IComparer<'Key>) lo hi f m x =
|
||||
foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) m x
|
||||
|
|
|
|||
|
|
@ -71,8 +71,7 @@ module internal PervasiveAutoOpens =
|
|||
// "How can I detect if am running in Mono?" section
|
||||
try
|
||||
Type.GetType "Mono.Runtime" <> null
|
||||
with
|
||||
| _ ->
|
||||
with _ ->
|
||||
// Must be robust in the case that someone else has installed a handler into System.AppDomain.OnTypeResolveEvent
|
||||
// that is not reliable.
|
||||
// This is related to bug 5506--the issue is actually a bug in VSTypeResolutionService.EnsurePopulated which is
|
||||
|
|
@ -197,8 +196,7 @@ module Array =
|
|||
let mutable i = 0
|
||||
|
||||
while eq && i < len do
|
||||
if not (inp[i] === res[i]) then
|
||||
eq <- false
|
||||
if not (inp[i] === res[i]) then eq <- false
|
||||
|
||||
i <- i + 1
|
||||
|
||||
|
|
@ -373,8 +371,8 @@ module Option =
|
|||
let attempt (f: unit -> 'T) =
|
||||
try
|
||||
Some(f ())
|
||||
with
|
||||
| _ -> None
|
||||
with _ ->
|
||||
None
|
||||
|
||||
module List =
|
||||
|
||||
|
|
@ -404,11 +402,7 @@ module List =
|
|||
let rec findi n f l =
|
||||
match l with
|
||||
| [] -> None
|
||||
| h :: t ->
|
||||
if f h then
|
||||
Some(h, n)
|
||||
else
|
||||
findi (n + 1) f t
|
||||
| h :: t -> if f h then Some(h, n) else findi (n + 1) f t
|
||||
|
||||
let splitChoose select l =
|
||||
let rec ch acc1 acc2 l =
|
||||
|
|
@ -438,10 +432,7 @@ module List =
|
|||
let h2a = f h1a
|
||||
let h2b = f h1b
|
||||
|
||||
if h1a === h2a && h1b === h2b then
|
||||
inp
|
||||
else
|
||||
[ h2a; h2b ]
|
||||
if h1a === h2a && h1b === h2b then inp else [ h2a; h2b ]
|
||||
| [ h1a; h1b; h1c ] ->
|
||||
let h2a = f h1a
|
||||
let h2b = f h1b
|
||||
|
|
@ -466,15 +457,16 @@ module List =
|
|||
|
||||
loop [] l
|
||||
|
||||
let tryFrontAndBack l =
|
||||
match l with
|
||||
| [] -> None
|
||||
| _ -> Some(frontAndBack l)
|
||||
|
||||
let tryRemove f inp =
|
||||
let rec loop acc l =
|
||||
match l with
|
||||
| [] -> None
|
||||
| h :: t ->
|
||||
if f h then
|
||||
Some(h, List.rev acc @ t)
|
||||
else
|
||||
loop (h :: acc) t
|
||||
| h :: t -> if f h then Some(h, List.rev acc @ t) else loop (h :: acc) t
|
||||
|
||||
loop [] inp
|
||||
|
||||
|
|
@ -499,11 +491,7 @@ module List =
|
|||
let rec loop acc l =
|
||||
match l with
|
||||
| [] -> List.rev acc, []
|
||||
| x :: xs ->
|
||||
if p x then
|
||||
List.rev acc, l
|
||||
else
|
||||
loop (x :: acc) xs
|
||||
| x :: xs -> if p x then List.rev acc, l else loop (x :: acc) xs
|
||||
|
||||
loop [] l
|
||||
|
||||
|
|
@ -544,11 +532,7 @@ module List =
|
|||
let rec mn i =
|
||||
function
|
||||
| [] -> []
|
||||
| x :: xs ->
|
||||
if i = n then
|
||||
f x :: xs
|
||||
else
|
||||
x :: mn (i + 1) xs
|
||||
| x :: xs -> if i = n then f x :: xs else x :: mn (i + 1) xs
|
||||
|
||||
mn 0 xs
|
||||
|
||||
|
|
@ -746,20 +730,14 @@ module String =
|
|||
let split options (separator: string[]) (value: string) = value.Split(separator, options)
|
||||
|
||||
let (|StartsWith|_|) pattern value =
|
||||
if String.IsNullOrWhiteSpace value then
|
||||
None
|
||||
elif value.StartsWithOrdinal pattern then
|
||||
Some()
|
||||
else
|
||||
None
|
||||
if String.IsNullOrWhiteSpace value then None
|
||||
elif value.StartsWithOrdinal pattern then Some()
|
||||
else None
|
||||
|
||||
let (|Contains|_|) pattern value =
|
||||
if String.IsNullOrWhiteSpace value then
|
||||
None
|
||||
elif value.Contains pattern then
|
||||
Some()
|
||||
else
|
||||
None
|
||||
if String.IsNullOrWhiteSpace value then None
|
||||
elif value.Contains pattern then Some()
|
||||
else None
|
||||
|
||||
let getLines (str: string) =
|
||||
use reader = new StringReader(str)
|
||||
|
|
@ -991,8 +969,8 @@ module Cancellable =
|
|||
match f ct with
|
||||
| ValueOrCancelled.Value res -> ValueOrCancelled.Value(Choice1Of2 res)
|
||||
| ValueOrCancelled.Cancelled exn -> ValueOrCancelled.Cancelled exn
|
||||
with
|
||||
| err -> ValueOrCancelled.Value(Choice2Of2 err))
|
||||
with err ->
|
||||
ValueOrCancelled.Value(Choice2Of2 err))
|
||||
|
||||
/// Implement try/finally for a cancellable computation
|
||||
let inline tryFinally comp compensation =
|
||||
|
|
@ -1162,8 +1140,7 @@ type LazyWithContext<'T, 'Ctxt> =
|
|||
x.value <- res
|
||||
x.funcOrException <- null
|
||||
res
|
||||
with
|
||||
| exn ->
|
||||
with exn ->
|
||||
x.funcOrException <- box (LazyWithContextFailure(exn))
|
||||
reraise ()
|
||||
| _ -> failwith "unreachable"
|
||||
|
|
@ -1281,8 +1258,8 @@ module NameMap =
|
|||
(fun n x2 acc ->
|
||||
try
|
||||
f n (Map.find n m1) x2 acc
|
||||
with
|
||||
| :? KeyNotFoundException -> errf n x2)
|
||||
with :? KeyNotFoundException ->
|
||||
errf n x2)
|
||||
m2
|
||||
acc
|
||||
|
||||
|
|
|
|||
|
|
@ -154,6 +154,8 @@ module internal List =
|
|||
|
||||
val frontAndBack: l: 'a list -> 'a list * 'a
|
||||
|
||||
val tryFrontAndBack: l: 'a list -> ('a list * 'a) option
|
||||
|
||||
val tryRemove: f: ('a -> bool) -> inp: 'a list -> ('a * 'a list) option
|
||||
|
||||
val zip4: l1: 'a list -> l2: 'b list -> l3: 'c list -> l4: 'd list -> ('a * 'b * 'c * 'd) list
|
||||
|
|
@ -531,18 +533,21 @@ module internal NameMap =
|
|||
val layer: m1: NameMap<'T> -> m2: Map<string, 'T> -> Map<string, 'T>
|
||||
|
||||
/// Not a very useful function - only called in one place - should be changed
|
||||
val layerAdditive: addf: ('a list -> 'b -> 'a list) -> m1: Map<'c, 'b> -> m2: Map<'c, 'a list> -> Map<'c, 'a list>
|
||||
when 'c: comparison
|
||||
val layerAdditive:
|
||||
addf: ('a list -> 'b -> 'a list) -> m1: Map<'c, 'b> -> m2: Map<'c, 'a list> -> Map<'c, 'a list>
|
||||
when 'c: comparison
|
||||
|
||||
/// Union entries by identical key, using the provided function to union sets of values
|
||||
val union: unionf: (seq<'a> -> 'b) -> ms: seq<NameMap<'a>> -> Map<string, 'b>
|
||||
|
||||
/// For every entry in m2 find an entry in m1 and fold
|
||||
val subfold2: errf: ('a -> 'b -> 'c) -> f: ('a -> 'd -> 'b -> 'c -> 'c) -> m1: Map<'a, 'd> -> m2: Map<'a, 'b> -> acc: 'c -> 'c
|
||||
when 'a: comparison
|
||||
val subfold2:
|
||||
errf: ('a -> 'b -> 'c) -> f: ('a -> 'd -> 'b -> 'c -> 'c) -> m1: Map<'a, 'd> -> m2: Map<'a, 'b> -> acc: 'c -> 'c
|
||||
when 'a: comparison
|
||||
|
||||
val suball2: errf: ('a -> 'b -> bool) -> p: ('c -> 'b -> bool) -> m1: Map<'a, 'c> -> m2: Map<'a, 'b> -> bool
|
||||
when 'a: comparison
|
||||
val suball2:
|
||||
errf: ('a -> 'b -> bool) -> p: ('c -> 'b -> bool) -> m1: Map<'a, 'c> -> m2: Map<'a, 'b> -> bool
|
||||
when 'a: comparison
|
||||
|
||||
val mapFold: f: ('a -> string -> 'T -> 'b * 'a) -> s: 'a -> l: NameMap<'T> -> Map<string, 'b> * 'a
|
||||
|
||||
|
|
|
|||
|
|
@ -363,8 +363,8 @@ type Range(code1: int64, code2: int64) =
|
|||
|> Seq.take (m.EndLine - m.StartLine + 1)
|
||||
|> String.concat "\n"
|
||||
|> fun s -> s.Substring(startCol + 1, s.LastIndexOf("\n", StringComparison.Ordinal) + 1 - startCol + endCol)
|
||||
with
|
||||
| e -> e.ToString()
|
||||
with e ->
|
||||
e.ToString()
|
||||
|
||||
member m.ToShortString() =
|
||||
sprintf "(%d,%d--%d,%d)" m.StartLine m.StartColumn m.EndLine m.EndColumn
|
||||
|
|
@ -542,5 +542,5 @@ module Range =
|
|||
match nonEmptyLine with
|
||||
| Some (i, s) -> mkRange file (mkPos (i + 1) 0) (mkPos (i + 1) s.Length)
|
||||
| None -> mkRange file (mkPos 1 0) (mkPos 1 80)
|
||||
with
|
||||
| _ -> mkRange file (mkPos 1 0) (mkPos 1 80)
|
||||
with _ ->
|
||||
mkRange file (mkPos 1 0) (mkPos 1 80)
|
||||
|
|
|
|||
|
|
@ -12,10 +12,7 @@ type Rational =
|
|||
}
|
||||
|
||||
let rec gcd a (b: BigInteger) =
|
||||
if b = BigInteger.Zero then
|
||||
a
|
||||
else
|
||||
gcd b (a % b)
|
||||
if b = BigInteger.Zero then a else gcd b (a % b)
|
||||
|
||||
let lcm a b = (a * b) / (gcd a b)
|
||||
|
||||
|
|
@ -27,11 +24,7 @@ let mkRational p q =
|
|||
let g = gcd q p in
|
||||
p / g, q / g
|
||||
|
||||
let p, q =
|
||||
if q > BigInteger.Zero then
|
||||
p, q
|
||||
else
|
||||
-p, -q
|
||||
let p, q = if q > BigInteger.Zero then p, q else -p, -q
|
||||
|
||||
in
|
||||
|
||||
|
|
@ -73,9 +66,6 @@ let GetNumerator p = int p.numerator
|
|||
let GetDenominator p = int p.denominator
|
||||
|
||||
let SignRational p =
|
||||
if p.numerator < BigInteger.Zero then
|
||||
-1
|
||||
else if p.numerator > BigInteger.Zero then
|
||||
1
|
||||
else
|
||||
0
|
||||
if p.numerator < BigInteger.Zero then -1
|
||||
else if p.numerator > BigInteger.Zero then 1
|
||||
else 0
|
||||
|
|
|
|||
|
|
@ -589,14 +589,14 @@ module Display =
|
|||
ty.GetMethod("ToString", BindingFlags.Public ||| BindingFlags.Instance, null, [||], null)
|
||||
|
||||
methInfo.DeclaringType = typeof<Object>
|
||||
with
|
||||
| _e -> false
|
||||
with _e ->
|
||||
false
|
||||
|
||||
let catchExn f =
|
||||
try
|
||||
Choice1Of2(f ())
|
||||
with
|
||||
| e -> Choice2Of2 e
|
||||
with e ->
|
||||
Choice2Of2 e
|
||||
|
||||
// An implementation of break stack.
|
||||
// Uses mutable state, relying on linear threading of the state.
|
||||
|
|
@ -630,16 +630,11 @@ module Display =
|
|||
Breaks(next + 1, outer, stack)
|
||||
|
||||
let popBreak (Breaks (next, outer, stack)) =
|
||||
if next = 0 then
|
||||
raise (Failure "popBreak: underflow")
|
||||
if next = 0 then raise (Failure "popBreak: underflow")
|
||||
|
||||
let topBroke = stack[next - 1] < 0
|
||||
|
||||
let outer =
|
||||
if outer = next then
|
||||
outer - 1
|
||||
else
|
||||
outer // if all broken, unwind
|
||||
let outer = if outer = next then outer - 1 else outer // if all broken, unwind
|
||||
|
||||
let next = next - 1
|
||||
Breaks(next, outer, stack), topBroke
|
||||
|
|
@ -977,10 +972,7 @@ module Display =
|
|||
let exceededPrintSize () = size <= 0
|
||||
|
||||
let countNodes n =
|
||||
if size > 0 then
|
||||
size <- size - n
|
||||
else
|
||||
() // no need to keep decrementing (and avoid wrap around)
|
||||
if size > 0 then size <- size - n else () // no need to keep decrementing (and avoid wrap around)
|
||||
|
||||
let stopShort _ = exceededPrintSize () // for unfoldL
|
||||
|
||||
|
|
@ -1039,8 +1031,7 @@ module Display =
|
|||
|
||||
path.Remove(x) |> ignore
|
||||
res
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
countNodes 1
|
||||
wordL (tagText ("Error: " + e.Message))
|
||||
|
||||
|
|
@ -1157,8 +1148,8 @@ module Display =
|
|||
)
|
||||
)
|
||||
)
|
||||
with
|
||||
| _ -> None
|
||||
with _ ->
|
||||
None
|
||||
|
||||
// Seed with an empty layout with a space to the left for formatting purposes
|
||||
buildObjMessageL txt [ leftL (tagText "") ]
|
||||
|
|
@ -1296,10 +1287,7 @@ module Display =
|
|||
|> makeListL
|
||||
|
||||
let project1 x =
|
||||
if x >= (b1 + n1) then
|
||||
None
|
||||
else
|
||||
Some(x, x + 1)
|
||||
if x >= (b1 + n1) then None else Some(x, x + 1)
|
||||
|
||||
let rowsL = boundedUnfoldL rowL project1 stopShort b1 opts.PrintLength
|
||||
|
||||
|
|
@ -1341,11 +1329,7 @@ module Display =
|
|||
let itemLs =
|
||||
boundedUnfoldL
|
||||
possibleKeyValueL
|
||||
(fun () ->
|
||||
if it.MoveNext() then
|
||||
Some(it.Current, ())
|
||||
else
|
||||
None)
|
||||
(fun () -> if it.MoveNext() then Some(it.Current, ()) else None)
|
||||
stopShort
|
||||
()
|
||||
(1 + opts.PrintLength / 12)
|
||||
|
|
@ -1463,12 +1447,11 @@ module Display =
|
|||
tagProperty m.Name),
|
||||
(try
|
||||
Some(nestedObjL nDepth Precedence.BracketIfTuple ((getProperty ty obj m.Name), ty))
|
||||
with
|
||||
| _ ->
|
||||
with _ ->
|
||||
try
|
||||
Some(nestedObjL nDepth Precedence.BracketIfTuple ((getField obj (m :?> FieldInfo)), ty))
|
||||
with
|
||||
| _ -> None)))
|
||||
with _ ->
|
||||
None)))
|
||||
|> Array.toList
|
||||
|> makePropertiesL)
|
||||
|
||||
|
|
@ -1594,8 +1577,7 @@ module Display =
|
|||
match text with
|
||||
| null -> ""
|
||||
| _ -> text
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
// If a .ToString() call throws an exception, catch it and use the message as the result.
|
||||
// This may be informative, e.g. division by zero etc...
|
||||
"<ToString exception: " + e.Message + ">"
|
||||
|
|
|
|||
|
|
@ -35,8 +35,8 @@ type CreateFSharpManifestResourceName public () =
|
|||
let runningOnMono =
|
||||
try
|
||||
System.Type.GetType("Mono.Runtime") <> null
|
||||
with
|
||||
| e -> false
|
||||
with e ->
|
||||
false
|
||||
|
||||
let fileName =
|
||||
if
|
||||
|
|
|
|||
|
|
@ -118,8 +118,7 @@ module internal {1} =
|
|||
File.WriteAllText(sourcePath, body.ToString())
|
||||
printMessage <| sprintf "Done: %s" sourcePath
|
||||
Some(sourcePath)
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
printf "An exception occurred when processing '%s'\n%s" resx (e.ToString())
|
||||
None
|
||||
|
||||
|
|
|
|||
|
|
@ -236,8 +236,7 @@ type FSharpEmbedResourceText() =
|
|||
let str =
|
||||
try
|
||||
System.String.Format(Unquote(txt.Substring i)) // Format turns e.g '\n' into that char, but also requires that we 'escape' curlies in the original .txt file, e.g. "{{"
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
Err(
|
||||
fileName,
|
||||
lineNum,
|
||||
|
|
@ -551,8 +550,7 @@ open Printf
|
|||
xd.Save outXmlStream
|
||||
printMessage (sprintf "Done %s" outFileName)
|
||||
Some(fileName, outFileName, outXmlFileName)
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
PrintErr(fileName, 0, sprintf "An exception occurred when processing '%s'\n%s" fileName (e.ToString()))
|
||||
None
|
||||
|
||||
|
|
|
|||
|
|
@ -68,8 +68,8 @@ type public Fsc() as this =
|
|||
let locationOfThisDll =
|
||||
try
|
||||
Some(Path.GetDirectoryName(typeof<Fsc>.Assembly.Location))
|
||||
with
|
||||
| _ -> None
|
||||
with _ ->
|
||||
None
|
||||
|
||||
match FSharpEnvironment.BinFolderOfDefaultFSharpCompiler(locationOfThisDll) with
|
||||
| Some s -> s
|
||||
|
|
@ -677,8 +677,7 @@ type public Fsc() as this =
|
|||
|
||||
try
|
||||
invokeCompiler baseCallDelegate
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
Debug.Fail(
|
||||
"HostObject received by Fsc task did not have a Compile method or the compile method threw an exception. "
|
||||
+ (e.ToString())
|
||||
|
|
|
|||
|
|
@ -51,8 +51,8 @@ type public Fsi() as this =
|
|||
let locationOfThisDll =
|
||||
try
|
||||
Some(Path.GetDirectoryName(typeof<Fsi>.Assembly.Location))
|
||||
with
|
||||
| _ -> None
|
||||
with _ ->
|
||||
None
|
||||
|
||||
match FSharpEnvironment.BinFolderOfDefaultFSharpCompiler(locationOfThisDll) with
|
||||
| Some s -> s
|
||||
|
|
@ -361,8 +361,7 @@ type public Fsi() as this =
|
|||
|
||||
try
|
||||
invokeCompiler baseCallDelegate
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
Debug.Assert(
|
||||
false,
|
||||
"HostObject received by Fsi task did not have a Compile method or the compile method threw an exception. "
|
||||
|
|
|
|||
|
|
@ -87,8 +87,8 @@ type SubstituteText() =
|
|||
Directory.CreateDirectory(directory) |> ignore
|
||||
|
||||
File.WriteAllText(targetPath, contents)
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
copiedFiles.Add(item)
|
||||
|
||||
|
|
|
|||
|
|
@ -166,7 +166,6 @@ type WriteCodeFragment() =
|
|||
_outputFile <- outputFileItem
|
||||
true
|
||||
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
printf "Error writing code fragment: %s" (e.ToString())
|
||||
false
|
||||
|
|
|
|||
|
|
@ -52,8 +52,8 @@ type internal SimpleEventLoop() =
|
|||
result <-
|
||||
try
|
||||
Some(f ())
|
||||
with
|
||||
| _ -> None)
|
||||
with _ ->
|
||||
None)
|
||||
|
||||
setSignal doneSignal
|
||||
run ()
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
# FSharp.Core uses more "conservative" settings - more lines etc.
|
||||
|
||||
[*.fs]
|
||||
max_line_length=120
|
||||
fsharp_max_function_binding_width=1
|
||||
fsharp_max_if_then_else_short_width=40
|
||||
|
|
@ -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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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: 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>) =
|
||||
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: '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>) = (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.HasValue && not y.HasValue)
|
||||
|| (x.HasValue && y.HasValue && x.Value = y.Value)
|
||||
|
||||
let (?<>?) (x : Nullable<'T>) (y: Nullable<'T>) = not (x ?=? y)
|
||||
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: 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 (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: 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: 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 (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: 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: 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 (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: 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: 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 (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: 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: 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 (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: 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()
|
||||
|
|
|
|||
|
|
@ -11,274 +11,336 @@ open Microsoft.FSharp.Quotations
|
|||
open Microsoft.FSharp.Quotations.DerivedPatterns
|
||||
open Microsoft.FSharp.Reflection
|
||||
open Microsoft.FSharp.Linq.RuntimeHelpers
|
||||
open System.Collections
|
||||
open System.Collections.Concurrent
|
||||
open System.Collections.Generic
|
||||
open System.Linq
|
||||
open System.Linq.Expressions
|
||||
open System.Reflection
|
||||
|
||||
// ----------------------------------------------------------------------------
|
||||
|
||||
/// A type used to reconstruct a grouping after applying a mutable->immutable mapping transformation
|
||||
/// 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>) =
|
||||
interface System.Linq.IGrouping<'K, 'T> with
|
||||
type Grouping<'K, 'T>(key: 'K, values: seq<'T>) =
|
||||
interface IGrouping<'K, 'T> with
|
||||
member _.Key = key
|
||||
|
||||
interface System.Collections.IEnumerable with
|
||||
member _.GetEnumerator() = values.GetEnumerator() :> System.Collections.IEnumerator
|
||||
interface IEnumerable with
|
||||
member _.GetEnumerator() =
|
||||
values.GetEnumerator() :> IEnumerator
|
||||
|
||||
interface System.Collections.Generic.IEnumerable<'T> with
|
||||
member _.GetEnumerator() = values.GetEnumerator()
|
||||
interface Generic.IEnumerable<'T> with
|
||||
member _.GetEnumerator() =
|
||||
values.GetEnumerator()
|
||||
|
||||
module internal Adapters =
|
||||
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 memoize f =
|
||||
let d = new ConcurrentDictionary<Type, 'b>(HashIdentity.Structural)
|
||||
|
||||
let isPartiallyImmutableRecord : Type -> bool =
|
||||
memoize (fun t ->
|
||||
FSharpType.IsRecord t &&
|
||||
not (FSharpType.GetRecordFields t |> Array.forall (fun f -> f.CanWrite)) )
|
||||
fun x -> d.GetOrAdd(x, (fun r -> f r))
|
||||
|
||||
let MemberInitializationHelperMeth =
|
||||
let isPartiallyImmutableRecord: Type -> bool =
|
||||
memoize (fun t ->
|
||||
FSharpType.IsRecord t
|
||||
&& not (FSharpType.GetRecordFields t |> Array.forall (fun f -> f.CanWrite)))
|
||||
|
||||
let MemberInitializationHelperMeth =
|
||||
methodhandleof (fun x -> LeafExpressionConverter.MemberInitializationHelper x)
|
||||
|> System.Reflection.MethodInfo.GetMethodFromHandle
|
||||
:?> System.Reflection.MethodInfo
|
||||
|> MethodInfo.GetMethodFromHandle
|
||||
:?> MethodInfo
|
||||
|
||||
let NewAnonymousObjectHelperMeth =
|
||||
let NewAnonymousObjectHelperMeth =
|
||||
methodhandleof (fun x -> LeafExpressionConverter.NewAnonymousObjectHelper x)
|
||||
|> System.Reflection.MethodInfo.GetMethodFromHandle
|
||||
:?> System.Reflection.MethodInfo
|
||||
|> MethodInfo.GetMethodFromHandle
|
||||
:?> MethodInfo
|
||||
|
||||
// The following patterns are used to recognize object construction
|
||||
// The following patterns are used to recognize object construction
|
||||
// using the 'new O(Prop1 = <e>, Prop2 = <e>)' syntax
|
||||
|
||||
/// Recognize sequential series written as (... ((<e>; <e>); <e>); ...)
|
||||
let (|LeftSequentialSeries|) e =
|
||||
let rec leftSequentialSeries acc e =
|
||||
match e with
|
||||
| Patterns.Sequential(e1, e2) -> leftSequentialSeries (e2 :: acc) e1
|
||||
match e with
|
||||
| Patterns.Sequential (e1, e2) -> leftSequentialSeries (e2 :: acc) e1
|
||||
| _ -> e :: acc
|
||||
|
||||
leftSequentialSeries [] e
|
||||
|
||||
/// Tests whether a list consists only of assignments of properties of the
|
||||
/// 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 rec propSetList acc x =
|
||||
match x with
|
||||
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 ->
|
||||
| ((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 =
|
||||
let (|ObjectConstruction|_|) e =
|
||||
match e with
|
||||
| Patterns.Let ( var, (Patterns.NewObject(_, []) as init), LeftSequentialSeries propSets ) ->
|
||||
match propSets with
|
||||
| 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<_ * _>, typedefof<AnonymousObject<_, _>>
|
||||
typedefof<_ * _ * _>, typedefof<AnonymousObject<_, _, _>>
|
||||
typedefof<_ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _>>
|
||||
typedefof<_ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _>>
|
||||
typedefof<_ * _ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _, _>>
|
||||
typedefof<_ * _ * _ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _, _, _>>
|
||||
typedefof<_ * _ * _ * _ * _ * _ * _ * _>, typedefof<AnonymousObject<_, _, _, _, _, _, _, _>> |]
|
||||
let tupleTypes =
|
||||
[|
|
||||
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<_, _, _, _, _, _, _, _>>
|
||||
|]
|
||||
|
||||
let anonObjectTypes = tupleTypes |> Array.map snd
|
||||
let tupleToAnonTypeMap =
|
||||
let t = new Dictionary<Type,Type>()
|
||||
for (k,v) in tupleTypes do t.[k] <- v
|
||||
|
||||
let tupleToAnonTypeMap =
|
||||
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 anonToTupleTypeMap =
|
||||
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 =
|
||||
let (|NewAnonymousObject|_|) e =
|
||||
match e with
|
||||
| Patterns.NewObject(ctor,args) when
|
||||
let dty = ctor.DeclaringType
|
||||
dty.IsGenericType && anonToTupleTypeMap.ContainsKey (dty.GetGenericTypeDefinition()) ->
|
||||
Some (ctor, args)
|
||||
| Patterns.NewObject (ctor, args) when
|
||||
let dty = ctor.DeclaringType
|
||||
|
||||
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 =
|
||||
match args with
|
||||
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) =
|
||||
// Recursively generate tuple get
|
||||
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 =
|
||||
// Tuples are generic, so lookup only for generic types
|
||||
assert ty.IsGenericType
|
||||
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) =
|
||||
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)
|
||||
match fields |> Array.tryFindIndex (fun p -> p = propInfo) with
|
||||
| None -> None
|
||||
| Some i -> if i < els.Length then Some els.[i] else None
|
||||
| _ -> None
|
||||
let (|RecordFieldGetSimplification|_|) (expr: Expr) =
|
||||
match expr with
|
||||
| Patterns.PropertyGet (Some (Patterns.NewRecord (typ, els)), propInfo, []) ->
|
||||
let fields =
|
||||
Microsoft.FSharp.Reflection.FSharpType.GetRecordFields(
|
||||
typ,
|
||||
BindingFlags.Public ||| 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
|
||||
| _ -> 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.
|
||||
[<NoComparison; NoEquality>]
|
||||
type ConversionDescription =
|
||||
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
|
||||
|
||||
/// Given an type involving immutable tuples and records, logically corresponding to the type produced at a
|
||||
/// "yield" or "select", convert it to a type involving anonymous objects according to the conversion data.
|
||||
let rec ConvImmutableTypeToMutableType conv ty =
|
||||
match conv with
|
||||
| TupleConv convs ->
|
||||
let rec ConvImmutableTypeToMutableType conv ty =
|
||||
match conv with
|
||||
| TupleConv convs ->
|
||||
assert (FSharpType.IsTuple ty)
|
||||
match convs with
|
||||
|
||||
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) ->
|
||||
let els = [ x1; x2; x3; x4; x5; x6; x7; TupleConv(x8 :: tail) ]
|
||||
RewriteTupleType ty (List.map2 ConvImmutableTypeToMutableType els)
|
||||
| _ -> 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) ->
|
||||
assert ty.IsGenericType
|
||||
assert (ty.GetGenericTypeDefinition() = typedefof<System.Linq.IGrouping<_, _>>)
|
||||
ConvImmutableTypeToMutableType (TupleConv convs) (FSharpType.MakeTupleType types)
|
||||
| GroupingConv (_keyTy, _elemTy, conv) ->
|
||||
assert ty.IsGenericType
|
||||
assert (ty.GetGenericTypeDefinition() = typedefof<IGrouping<_, _>>)
|
||||
let keyt1 = ty.GetGenericArguments().[0]
|
||||
let valt1 = ty.GetGenericArguments().[1]
|
||||
typedefof<System.Linq.IGrouping<_, _>>.MakeGenericType [| keyt1; ConvImmutableTypeToMutableType conv valt1 |]
|
||||
| SeqConv conv ->
|
||||
typedefof<IGrouping<_, _>>.MakeGenericType [| keyt1; ConvImmutableTypeToMutableType conv valt1 |]
|
||||
| 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 gmd = minfo.GetGenericMethodDefinition()
|
||||
(fun tm ->
|
||||
let IsNewAnonymousObjectHelperQ =
|
||||
let mhandle =
|
||||
(methodhandleof (fun x -> LeafExpressionConverter.NewAnonymousObjectHelper x))
|
||||
|
||||
let minfo = (MethodInfo.GetMethodFromHandle mhandle) :?> 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
|
||||
|
||||
// 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.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) ->
|
||||
// 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]) ])
|
||||
|
||||
// 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 ->
|
||||
let rec CleanupLeaf expr =
|
||||
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.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) ->
|
||||
// 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 ]) ])
|
||||
|
||||
// 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
|
||||
|
||||
/// Simplify gets of tuples and gets of record fields.
|
||||
let rec SimplifyConsumingExpr e =
|
||||
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)
|
||||
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.ShapeVar _ -> e
|
||||
|
||||
match e with
|
||||
| Patterns.TupleGet(Patterns.NewTuple els,i) -> els.[i]
|
||||
| RecordFieldGetSimplification newExpr -> newExpr
|
||||
| Patterns.TupleGet (Patterns.NewTuple els, i) -> els.[i]
|
||||
| RecordFieldGetSimplification newExpr -> newExpr
|
||||
| _ -> e
|
||||
|
||||
/// Given the expression part of a "yield" or "select" which produces a result in terms of immutable tuples or immutable records,
|
||||
/// generate an equivalent expression yielding anonymous objects. Also return the conversion for the immutable-to-mutable correspondence
|
||||
/// so we can reverse this later.
|
||||
let rec ProduceMoreMutables tipf expr =
|
||||
let rec ProduceMoreMutables tipf expr =
|
||||
|
||||
match expr with
|
||||
// Replace immutable tuples by anonymous objects
|
||||
| Patterns.NewTuple exprs ->
|
||||
let argExprsNow, argScripts = exprs |> List.map (ProduceMoreMutables tipf) |> List.unzip
|
||||
NewAnonymousObject argExprsNow, TupleConv argScripts
|
||||
match expr with
|
||||
// Replace immutable tuples by anonymous objects
|
||||
| Patterns.NewTuple exprs ->
|
||||
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
|
||||
|
||||
// Replace immutable records by anonymous objects
|
||||
| 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
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -8,41 +8,59 @@ 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 }
|
||||
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
|
||||
|
||||
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) =
|
||||
NonStructuralComparison.(=) x y
|
||||
}
|
||||
|
||||
module ComparisonIdentity =
|
||||
let inline FromFunctions hasher equality : IEqualityComparer<'T> =
|
||||
let eq = OptimizedClosures.FSharpFunc<_, _, _>.Adapt (equality)
|
||||
|
||||
let inline Structural<'T when 'T : comparison > : IComparer<'T> =
|
||||
{ new IEqualityComparer<'T> with
|
||||
member _.GetHashCode(x) =
|
||||
hasher x
|
||||
|
||||
member _.Equals(x, y) =
|
||||
eq.Invoke(x, y)
|
||||
}
|
||||
|
||||
module ComparisonIdentity =
|
||||
|
||||
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)
|
||||
|
||||
let FromFunction comparer =
|
||||
let comparer = OptimizedClosures.FSharpFunc<'T,'T,int>.Adapt(comparer)
|
||||
{ new IComparer<'T> with
|
||||
member _.Compare(x,y) = comparer.Invoke(x,y) }
|
||||
|
||||
member _.Compare(x, y) =
|
||||
comparer.Invoke(x, y)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -8,8 +8,9 @@ open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
|
|||
open Microsoft.FSharp.Core.Operators
|
||||
open Microsoft.FSharp.Collections
|
||||
open Microsoft.FSharp.Control
|
||||
open System.Reflection
|
||||
open System
|
||||
open System.Diagnostics
|
||||
open System.Reflection
|
||||
|
||||
module private Atomic =
|
||||
open System.Threading
|
||||
|
|
@ -17,138 +18,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) =
|
||||
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
|
||||
observer.OnNext 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) =
|
||||
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
|
||||
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
|
||||
|
||||
type EventWrapper<'Delegate,'Args> = delegate of 'Delegate * obj * 'Args -> unit
|
||||
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) =
|
||||
let args = makeTuple ([| a; b; c; d |]) :?> 'Args
|
||||
observer.OnNext 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
|
||||
|
||||
[<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)
|
||||
static let mi, argTypes =
|
||||
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..]
|
||||
|
||||
// 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
|
||||
(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 = 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)
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -34,7 +34,8 @@ type DelegateEvent<'Delegate when 'Delegate :> System.Delegate> =
|
|||
///
|
||||
/// <category index="3">Events and Observables</category>
|
||||
[<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> =
|
||||
|
||||
/// <summary>Creates an event object suitable for delegate types following the standard .NET Framework convention of a first 'sender' argument.</summary>
|
||||
/// <returns>The created event.</returns>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -16,112 +16,145 @@ module ExtraTopLevelOperators =
|
|||
open Microsoft.FSharp.Primitives.Basics
|
||||
open Microsoft.FSharp.Core.CompilerServices
|
||||
|
||||
let inline checkNonNullNullArg argName arg =
|
||||
match box arg with
|
||||
| null -> nullArg argName
|
||||
let inline checkNonNullNullArg argName arg =
|
||||
match box arg with
|
||||
| null -> nullArg argName
|
||||
| _ -> ()
|
||||
|
||||
let inline checkNonNullInvalidArg argName message arg =
|
||||
match box arg with
|
||||
let inline checkNonNullInvalidArg argName message arg =
|
||||
match box arg with
|
||||
| null -> invalidArg argName message
|
||||
| _ -> ()
|
||||
|
||||
[<CompiledName("CreateSet")>]
|
||||
let set elements = Collections.Set.ofSeq elements
|
||||
let set elements =
|
||||
Collections.Set.ofSeq elements
|
||||
|
||||
let dummyArray = [||]
|
||||
let inline dont_tail_call f =
|
||||
|
||||
let inline dont_tail_call f =
|
||||
let result = f ()
|
||||
dummyArray.Length |> ignore // pretty stupid way to avoid tail call, would be better if attribute existed, but this should be inlineable by the JIT
|
||||
result
|
||||
|
||||
let inline ICollection_Contains<'collection,'item when 'collection :> ICollection<'item>> (collection:'collection) (item:'item) =
|
||||
let inline ICollection_Contains<'collection, 'item when 'collection :> ICollection<'item>>
|
||||
(collection: 'collection)
|
||||
(item: 'item)
|
||||
=
|
||||
collection.Contains item
|
||||
|
||||
[<DebuggerDisplay("Count = {Count}")>]
|
||||
[<DebuggerTypeProxy(typedefof<DictDebugView<_,_,_>>)>]
|
||||
type DictImpl<'SafeKey,'Key,'T>(t : Dictionary<'SafeKey,'T>, makeSafeKey : 'Key->'SafeKey, getKey : 'SafeKey->'Key) =
|
||||
[<DebuggerTypeProxy(typedefof<DictDebugView<_, _, _>>)>]
|
||||
type DictImpl<'SafeKey, 'Key, 'T>
|
||||
(
|
||||
t: Dictionary<'SafeKey, 'T>,
|
||||
makeSafeKey: 'Key -> 'SafeKey,
|
||||
getKey: 'SafeKey -> 'Key
|
||||
) =
|
||||
#if NETSTANDARD
|
||||
static let emptyEnumerator = (Array.empty<KeyValuePair<'Key, 'T>> :> seq<_>).GetEnumerator()
|
||||
static let emptyEnumerator =
|
||||
(Array.empty<KeyValuePair<'Key, 'T>> :> seq<_>).GetEnumerator()
|
||||
#endif
|
||||
member _.Count = t.Count
|
||||
|
||||
// Give a read-only view of the dictionary
|
||||
interface IDictionary<'Key, 'T> with
|
||||
member _.Item
|
||||
member _.Item
|
||||
with get x = dont_tail_call (fun () -> t.[makeSafeKey x])
|
||||
and set _ _ = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
and set _ _ = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.Keys =
|
||||
member _.Keys =
|
||||
let keys = t.Keys
|
||||
{ new ICollection<'Key> with
|
||||
member _.Add(x) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.Clear() = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
{ new ICollection<'Key> with
|
||||
member _.Add(x) =
|
||||
raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.Remove(x) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
member _.Clear() =
|
||||
raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.Contains(x) = t.ContainsKey (makeSafeKey x)
|
||||
member _.Remove(x) =
|
||||
raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.CopyTo(arr,i) =
|
||||
let mutable n = 0
|
||||
for k in keys do
|
||||
arr.[i+n] <- getKey k
|
||||
n <- n + 1
|
||||
member _.Contains(x) =
|
||||
t.ContainsKey(makeSafeKey x)
|
||||
|
||||
member _.IsReadOnly = true
|
||||
member _.CopyTo(arr, i) =
|
||||
let mutable n = 0
|
||||
|
||||
member _.Count = keys.Count
|
||||
for k in keys do
|
||||
arr.[i + n] <- getKey k
|
||||
n <- n + 1
|
||||
|
||||
member _.IsReadOnly = true
|
||||
|
||||
member _.Count = keys.Count
|
||||
interface IEnumerable<'Key> with
|
||||
member _.GetEnumerator() = (keys |> Seq.map getKey).GetEnumerator()
|
||||
|
||||
member _.GetEnumerator() =
|
||||
(keys |> Seq.map getKey).GetEnumerator()
|
||||
interface System.Collections.IEnumerable with
|
||||
member _.GetEnumerator() = ((keys |> Seq.map getKey) :> System.Collections.IEnumerable).GetEnumerator() }
|
||||
|
||||
member _.GetEnumerator() =
|
||||
((keys |> Seq.map getKey) :> System.Collections.IEnumerable).GetEnumerator()
|
||||
}
|
||||
|
||||
member _.Values = upcast t.Values
|
||||
|
||||
member _.Add(_,_) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
member _.Add(_, _) =
|
||||
raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.ContainsKey(k) = dont_tail_call (fun () -> t.ContainsKey(makeSafeKey k))
|
||||
member _.ContainsKey(k) =
|
||||
dont_tail_call (fun () -> t.ContainsKey(makeSafeKey k))
|
||||
|
||||
member _.TryGetValue(k,r) =
|
||||
member _.TryGetValue(k, r) =
|
||||
let safeKey = makeSafeKey k
|
||||
if t.ContainsKey(safeKey) then (r <- t.[safeKey]; true) else false
|
||||
|
||||
member _.Remove(_ : 'Key) = (raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) : bool)
|
||||
if t.ContainsKey(safeKey) then
|
||||
(r <- t.[safeKey]
|
||||
true)
|
||||
else
|
||||
false
|
||||
|
||||
member _.Remove(_: 'Key) =
|
||||
(raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))): bool)
|
||||
|
||||
interface IReadOnlyDictionary<'Key, 'T> with
|
||||
|
||||
member _.Item with get key = t.[makeSafeKey key]
|
||||
member _.Item
|
||||
with get key = t.[makeSafeKey key]
|
||||
|
||||
member _.Keys = t.Keys |> Seq.map getKey
|
||||
|
||||
member _.TryGetValue(key, r) =
|
||||
match t.TryGetValue (makeSafeKey key) with
|
||||
match t.TryGetValue(makeSafeKey key) with
|
||||
| false, _ -> false
|
||||
| true, value ->
|
||||
r <- value
|
||||
true
|
||||
|
||||
member _.Values = (t :> IReadOnlyDictionary<_,_>).Values
|
||||
member _.Values = (t :> IReadOnlyDictionary<_, _>).Values
|
||||
|
||||
member _.ContainsKey k = t.ContainsKey (makeSafeKey k)
|
||||
member _.ContainsKey k =
|
||||
t.ContainsKey(makeSafeKey k)
|
||||
|
||||
interface ICollection<KeyValuePair<'Key, 'T>> with
|
||||
interface ICollection<KeyValuePair<'Key, 'T>> with
|
||||
|
||||
member _.Add(_) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
member _.Add(_) =
|
||||
raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.Clear() = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
member _.Clear() =
|
||||
raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.Remove(_) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
member _.Remove(_) =
|
||||
raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated)))
|
||||
|
||||
member _.Contains(KeyValue(k,v)) = ICollection_Contains t (KeyValuePair<_,_>(makeSafeKey k,v))
|
||||
member _.Contains(KeyValue (k, v)) =
|
||||
ICollection_Contains t (KeyValuePair<_, _>(makeSafeKey k, v))
|
||||
|
||||
member _.CopyTo(arr,i) =
|
||||
let mutable n = 0
|
||||
for (KeyValue(k,v)) in t do
|
||||
arr.[i+n] <- KeyValuePair<_,_>(getKey k,v)
|
||||
member _.CopyTo(arr, i) =
|
||||
let mutable n = 0
|
||||
|
||||
for (KeyValue (k, v)) in t do
|
||||
arr.[i + n] <- KeyValuePair<_, _>(getKey k, v)
|
||||
n <- n + 1
|
||||
|
||||
member _.IsReadOnly = true
|
||||
|
|
@ -135,104 +168,129 @@ module ExtraTopLevelOperators =
|
|||
|
||||
member _.GetEnumerator() =
|
||||
// We use an array comprehension here instead of seq {} as otherwise we get incorrect
|
||||
// IEnumerator.Reset() and IEnumerator.Current semantics.
|
||||
// IEnumerator.Reset() and IEnumerator.Current semantics.
|
||||
// Coreclr has a bug with SZGenericEnumerators --- implement a correct enumerator. On desktop use the desktop implementation because it's ngened.
|
||||
#if !NETSTANDARD
|
||||
let kvps = [| for (KeyValue (k,v)) in t -> KeyValuePair (getKey k, v) |] :> seq<_>
|
||||
#if !NETSTANDARD
|
||||
let kvps = [| for (KeyValue (k, v)) in t -> KeyValuePair(getKey k, v) |] :> seq<_>
|
||||
kvps.GetEnumerator()
|
||||
#else
|
||||
let endIndex = t.Count
|
||||
if endIndex = 0 then emptyEnumerator
|
||||
|
||||
if endIndex = 0 then
|
||||
emptyEnumerator
|
||||
else
|
||||
let kvps = [| for (KeyValue (k,v)) in t -> KeyValuePair (getKey k, v) |]
|
||||
let kvps = [| for (KeyValue (k, v)) in t -> KeyValuePair(getKey k, v) |]
|
||||
let mutable index = -1
|
||||
|
||||
let current () =
|
||||
if index < 0 then raise <| InvalidOperationException(SR.GetString(SR.enumerationNotStarted))
|
||||
if index >= endIndex then raise <| InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))
|
||||
if index < 0 then
|
||||
raise <| InvalidOperationException(SR.GetString(SR.enumerationNotStarted))
|
||||
|
||||
if index >= endIndex then
|
||||
raise <| InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))
|
||||
|
||||
kvps.[index]
|
||||
|
||||
{new IEnumerator<_> with
|
||||
{ new IEnumerator<_> with
|
||||
member _.Current = current ()
|
||||
|
||||
interface System.Collections.IEnumerator with
|
||||
member _.Current = box(current())
|
||||
member _.Current = box (current ())
|
||||
|
||||
member _.MoveNext() =
|
||||
if index < endIndex then
|
||||
index <- index + 1
|
||||
index < endIndex
|
||||
else false
|
||||
member _.MoveNext() =
|
||||
if index < endIndex then
|
||||
index <- index + 1
|
||||
index < endIndex
|
||||
else
|
||||
false
|
||||
|
||||
member _.Reset() = index <- -1
|
||||
|
||||
interface System.IDisposable with
|
||||
member _.Dispose() = () }
|
||||
member _.Reset() =
|
||||
index <- -1
|
||||
interface System.IDisposable with
|
||||
member _.Dispose() =
|
||||
()
|
||||
}
|
||||
#endif
|
||||
|
||||
interface System.Collections.IEnumerable with
|
||||
member _.GetEnumerator() =
|
||||
// We use an array comprehension here instead of seq {} as otherwise we get incorrect
|
||||
// IEnumerator.Reset() and IEnumerator.Current semantics.
|
||||
let kvps = [| for (KeyValue (k,v)) in t -> KeyValuePair (getKey k, v) |] :> System.Collections.IEnumerable
|
||||
// IEnumerator.Reset() and IEnumerator.Current semantics.
|
||||
let kvps =
|
||||
[| for (KeyValue (k, v)) in t -> KeyValuePair(getKey k, v) |] :> System.Collections.IEnumerable
|
||||
|
||||
kvps.GetEnumerator()
|
||||
|
||||
and DictDebugView<'SafeKey,'Key,'T>(d:DictImpl<'SafeKey,'Key,'T>) =
|
||||
and DictDebugView<'SafeKey, 'Key, 'T>(d: DictImpl<'SafeKey, 'Key, 'T>) =
|
||||
[<DebuggerBrowsable(DebuggerBrowsableState.RootHidden)>]
|
||||
member _.Items = Array.ofSeq d
|
||||
|
||||
let inline dictImpl (comparer:IEqualityComparer<'SafeKey>) (makeSafeKey : 'Key->'SafeKey) (getKey : 'SafeKey->'Key) (l:seq<'Key*'T>) =
|
||||
let inline dictImpl
|
||||
(comparer: IEqualityComparer<'SafeKey>)
|
||||
(makeSafeKey: 'Key -> 'SafeKey)
|
||||
(getKey: 'SafeKey -> 'Key)
|
||||
(l: seq<'Key * 'T>)
|
||||
=
|
||||
let t = Dictionary comparer
|
||||
for (k,v) in l do
|
||||
|
||||
for (k, v) in l do
|
||||
t.[makeSafeKey k] <- v
|
||||
|
||||
DictImpl(t, makeSafeKey, getKey)
|
||||
|
||||
// We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance
|
||||
let dictValueType (l:seq<'Key*'T>) =
|
||||
let dictValueType (l: seq<'Key * 'T>) =
|
||||
dictImpl HashIdentity.Structural<'Key> id id l
|
||||
|
||||
// Wrap a StructBox around all keys in case the key type is itself a type using null as a representation
|
||||
let dictRefType (l:seq<'Key*'T>) =
|
||||
let dictRefType (l: seq<'Key * 'T>) =
|
||||
dictImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun k -> RuntimeHelpers.StructBox k) (fun sb -> sb.Value) l
|
||||
|
||||
[<CompiledName("CreateDictionary")>]
|
||||
let dict (keyValuePairs:seq<'Key*'T>) : IDictionary<'Key,'T> =
|
||||
let dict (keyValuePairs: seq<'Key * 'T>) : IDictionary<'Key, 'T> =
|
||||
if typeof<'Key>.IsValueType then
|
||||
dictValueType keyValuePairs
|
||||
else
|
||||
dictRefType keyValuePairs
|
||||
|
||||
[<CompiledName("CreateReadOnlyDictionary")>]
|
||||
let readOnlyDict (keyValuePairs:seq<'Key*'T>) : IReadOnlyDictionary<'Key,'T> =
|
||||
let readOnlyDict (keyValuePairs: seq<'Key * 'T>) : IReadOnlyDictionary<'Key, 'T> =
|
||||
if typeof<'Key>.IsValueType then
|
||||
dictValueType keyValuePairs
|
||||
else
|
||||
dictRefType keyValuePairs
|
||||
|
||||
let getArray (vals : seq<'T>) =
|
||||
let getArray (vals: seq<'T>) =
|
||||
match vals with
|
||||
| :? ('T[]) as arr -> arr
|
||||
| _ -> Seq.toArray vals
|
||||
|
||||
[<CompiledName("CreateArray2D")>]
|
||||
let array2D (rows : seq<#seq<'T>>) =
|
||||
let array2D (rows: seq<#seq<'T>>) =
|
||||
checkNonNullNullArg "rows" rows
|
||||
let rowsArr = getArray rows
|
||||
let m = rowsArr.Length
|
||||
if m = 0
|
||||
then Array2D.zeroCreate<'T> 0 0
|
||||
|
||||
if m = 0 then
|
||||
Array2D.zeroCreate<'T> 0 0
|
||||
else
|
||||
checkNonNullInvalidArg "rows" (SR.GetString(SR.nullsNotAllowedInArray)) rowsArr.[0]
|
||||
let firstRowArr = getArray rowsArr.[0]
|
||||
let n = firstRowArr.Length
|
||||
let res = Array2D.zeroCreate<'T> m n
|
||||
for j in 0..(n-1) do
|
||||
res.[0,j] <- firstRowArr.[j]
|
||||
for i in 1..(m-1) do
|
||||
|
||||
for j in 0 .. (n - 1) do
|
||||
res.[0, j] <- firstRowArr.[j]
|
||||
|
||||
for i in 1 .. (m - 1) do
|
||||
checkNonNullInvalidArg "rows" (SR.GetString(SR.nullsNotAllowedInArray)) rowsArr.[i]
|
||||
let rowiArr = getArray rowsArr.[i]
|
||||
if rowiArr.Length <> n then invalidArg "vals" (SR.GetString(SR.arraysHadDifferentLengths))
|
||||
for j in 0..(n-1) do
|
||||
res.[i,j] <- rowiArr.[j]
|
||||
|
||||
if rowiArr.Length <> n then
|
||||
invalidArg "vals" (SR.GetString(SR.arraysHadDifferentLengths))
|
||||
|
||||
for j in 0 .. (n - 1) do
|
||||
res.[i, j] <- rowiArr.[j]
|
||||
|
||||
res
|
||||
|
||||
[<CompiledName("PrintFormatToString")>]
|
||||
|
|
@ -244,28 +302,28 @@ module ExtraTopLevelOperators =
|
|||
Printf.failwithf format
|
||||
|
||||
[<CompiledName("PrintFormatToTextWriter")>]
|
||||
let fprintf (textWriter:TextWriter) format =
|
||||
Printf.fprintf textWriter format
|
||||
let fprintf (textWriter: TextWriter) format =
|
||||
Printf.fprintf textWriter format
|
||||
|
||||
[<CompiledName("PrintFormatLineToTextWriter")>]
|
||||
let fprintfn (textWriter:TextWriter) format =
|
||||
Printf.fprintfn textWriter format
|
||||
|
||||
let fprintfn (textWriter: TextWriter) format =
|
||||
Printf.fprintfn textWriter format
|
||||
|
||||
[<CompiledName("PrintFormat")>]
|
||||
let printf format =
|
||||
Printf.printf format
|
||||
Printf.printf format
|
||||
|
||||
[<CompiledName("PrintFormatToError")>]
|
||||
let eprintf format =
|
||||
Printf.eprintf format
|
||||
Printf.eprintf format
|
||||
|
||||
[<CompiledName("PrintFormatLine")>]
|
||||
let printfn format =
|
||||
Printf.printfn format
|
||||
Printf.printfn format
|
||||
|
||||
[<CompiledName("PrintFormatLineToError")>]
|
||||
let eprintfn format =
|
||||
Printf.eprintfn format
|
||||
Printf.eprintfn format
|
||||
|
||||
[<CompiledName("FailWith")>]
|
||||
let failwith s =
|
||||
|
|
@ -275,167 +333,205 @@ module ExtraTopLevelOperators =
|
|||
let async = AsyncBuilder()
|
||||
|
||||
[<CompiledName("ToSingle")>]
|
||||
let inline single value = float32 value
|
||||
let inline single value =
|
||||
float32 value
|
||||
|
||||
[<CompiledName("ToDouble")>]
|
||||
let inline double value = float value
|
||||
let inline double value =
|
||||
float value
|
||||
|
||||
[<CompiledName("ToByte")>]
|
||||
let inline uint8 value = byte value
|
||||
let inline uint8 value =
|
||||
byte value
|
||||
|
||||
[<CompiledName("ToSByte")>]
|
||||
let inline int8 value = sbyte value
|
||||
let inline int8 value =
|
||||
sbyte value
|
||||
|
||||
module Checked =
|
||||
module Checked =
|
||||
|
||||
[<CompiledName("ToByte")>]
|
||||
let inline uint8 value = Checked.byte value
|
||||
let inline uint8 value =
|
||||
Checked.byte value
|
||||
|
||||
[<CompiledName("ToSByte")>]
|
||||
let inline int8 value = Checked.sbyte value
|
||||
let inline int8 value =
|
||||
Checked.sbyte value
|
||||
|
||||
[<CompiledName("SpliceExpression")>]
|
||||
let (~%) (expression:Microsoft.FSharp.Quotations.Expr<'T>) : 'T =
|
||||
let (~%) (expression: Microsoft.FSharp.Quotations.Expr<'T>) : 'T =
|
||||
ignore expression
|
||||
raise (InvalidOperationException(SR.GetString(SR.firstClassUsesOfSplice)))
|
||||
|
||||
[<CompiledName("SpliceUntypedExpression")>]
|
||||
let (~%%) (expression: Microsoft.FSharp.Quotations.Expr) : 'T =
|
||||
ignore expression
|
||||
raise (InvalidOperationException (SR.GetString(SR.firstClassUsesOfSplice)))
|
||||
raise (InvalidOperationException(SR.GetString(SR.firstClassUsesOfSplice)))
|
||||
|
||||
[<assembly: AutoOpen("Microsoft.FSharp")>]
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators")>]
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Core")>]
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Collections")>]
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Control")>]
|
||||
#if !BUILDING_WITH_LKG && !BUILD_FROM_SOURCE
|
||||
#if !BUILDING_WITH_LKG && !BUILD_FROM_SOURCE
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Control.TaskBuilderExtensions.LowPriority")>]
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Control.TaskBuilderExtensions.MediumPriority")>]
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Control.TaskBuilderExtensions.HighPriority")>]
|
||||
#endif
|
||||
#endif
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Linq.QueryRunExtensions.LowPriority")>]
|
||||
[<assembly: AutoOpen("Microsoft.FSharp.Linq.QueryRunExtensions.HighPriority")>]
|
||||
do()
|
||||
do ()
|
||||
|
||||
[<CompiledName("LazyPattern")>]
|
||||
let (|Lazy|) (input:Lazy<_>) =
|
||||
let (|Lazy|) (input: Lazy<_>) =
|
||||
input.Force()
|
||||
|
||||
let query = Microsoft.FSharp.Linq.QueryBuilder()
|
||||
|
||||
|
||||
namespace Microsoft.FSharp.Core.CompilerServices
|
||||
|
||||
open System
|
||||
open System.Reflection
|
||||
open Microsoft.FSharp.Core
|
||||
open Microsoft.FSharp.Control
|
||||
open Microsoft.FSharp.Quotations
|
||||
open System
|
||||
open System.Reflection
|
||||
open Microsoft.FSharp.Core
|
||||
open Microsoft.FSharp.Control
|
||||
open Microsoft.FSharp.Quotations
|
||||
|
||||
/// <summary>Represents the product of two measure expressions when returned as a generic argument of a provided type.</summary>
|
||||
[<Sealed>]
|
||||
type MeasureProduct<'Measure1, 'Measure2>() = class end
|
||||
/// <summary>Represents the product of two measure expressions when returned as a generic argument of a provided type.</summary>
|
||||
[<Sealed>]
|
||||
type MeasureProduct<'Measure1, 'Measure2>() =
|
||||
class
|
||||
end
|
||||
|
||||
/// <summary>Represents the inverse of a measure expressions when returned as a generic argument of a provided type.</summary>
|
||||
[<Sealed>]
|
||||
type MeasureInverse<'Measure> = class end
|
||||
/// <summary>Represents the inverse of a measure expressions when returned as a generic argument of a provided type.</summary>
|
||||
[<Sealed>]
|
||||
type MeasureInverse<'Measure> =
|
||||
class
|
||||
end
|
||||
|
||||
/// <summary>Represents the '1' measure expression when returned as a generic argument of a provided type.</summary>
|
||||
[<Sealed>]
|
||||
type MeasureOne = class end
|
||||
/// <summary>Represents the '1' measure expression when returned as a generic argument of a provided type.</summary>
|
||||
[<Sealed>]
|
||||
type MeasureOne =
|
||||
class
|
||||
end
|
||||
|
||||
[<AttributeUsage(AttributeTargets.Class, AllowMultiple = false)>]
|
||||
type TypeProviderAttribute() =
|
||||
inherit System.Attribute()
|
||||
[<AttributeUsage(AttributeTargets.Class, AllowMultiple = false)>]
|
||||
type TypeProviderAttribute() =
|
||||
inherit System.Attribute()
|
||||
|
||||
[<AttributeUsage(AttributeTargets.Assembly, AllowMultiple = false)>]
|
||||
type TypeProviderAssemblyAttribute(assemblyName : string) =
|
||||
inherit System.Attribute()
|
||||
new () = TypeProviderAssemblyAttribute(null)
|
||||
[<AttributeUsage(AttributeTargets.Assembly, AllowMultiple = false)>]
|
||||
type TypeProviderAssemblyAttribute(assemblyName: string) =
|
||||
inherit System.Attribute()
|
||||
new() = TypeProviderAssemblyAttribute(null)
|
||||
|
||||
member _.AssemblyName = assemblyName
|
||||
member _.AssemblyName = assemblyName
|
||||
|
||||
[<AttributeUsage(AttributeTargets.All, AllowMultiple = false)>]
|
||||
type TypeProviderXmlDocAttribute(commentText: string) =
|
||||
inherit System.Attribute()
|
||||
[<AttributeUsage(AttributeTargets.All, AllowMultiple = false)>]
|
||||
type TypeProviderXmlDocAttribute(commentText: string) =
|
||||
inherit System.Attribute()
|
||||
|
||||
member _.CommentText = commentText
|
||||
member _.CommentText = commentText
|
||||
|
||||
[<AttributeUsage(AttributeTargets.All, AllowMultiple = false)>]
|
||||
type TypeProviderDefinitionLocationAttribute() =
|
||||
inherit System.Attribute()
|
||||
let mutable filePath : string = null
|
||||
let mutable line : int = 0
|
||||
let mutable column : int = 0
|
||||
[<AttributeUsage(AttributeTargets.All, AllowMultiple = false)>]
|
||||
type TypeProviderDefinitionLocationAttribute() =
|
||||
inherit System.Attribute()
|
||||
let mutable filePath: string = null
|
||||
let mutable line: int = 0
|
||||
let mutable column: int = 0
|
||||
|
||||
member _.FilePath with get() = filePath and set v = filePath <- v
|
||||
member _.FilePath
|
||||
with get () = filePath
|
||||
and set v = filePath <- v
|
||||
|
||||
member _.Line with get() = line and set v = line <- v
|
||||
member _.Line
|
||||
with get () = line
|
||||
and set v = line <- v
|
||||
|
||||
member _.Column with get() = column and set v = column <- v
|
||||
member _.Column
|
||||
with get () = column
|
||||
and set v = column <- v
|
||||
|
||||
[<AttributeUsage(AttributeTargets.Class ||| AttributeTargets.Interface ||| AttributeTargets.Struct ||| AttributeTargets.Delegate, AllowMultiple = false)>]
|
||||
type TypeProviderEditorHideMethodsAttribute() =
|
||||
inherit System.Attribute()
|
||||
[<AttributeUsage(AttributeTargets.Class
|
||||
||| AttributeTargets.Interface
|
||||
||| AttributeTargets.Struct
|
||||
||| AttributeTargets.Delegate,
|
||||
AllowMultiple = false)>]
|
||||
type TypeProviderEditorHideMethodsAttribute() =
|
||||
inherit System.Attribute()
|
||||
|
||||
/// <summary>Additional type attribute flags related to provided types</summary>
|
||||
type TypeProviderTypeAttributes =
|
||||
| SuppressRelocate = 0x80000000
|
||||
| IsErased = 0x40000000
|
||||
/// <summary>Additional type attribute flags related to provided types</summary>
|
||||
type TypeProviderTypeAttributes =
|
||||
| SuppressRelocate = 0x80000000
|
||||
| IsErased = 0x40000000
|
||||
|
||||
type TypeProviderConfig( systemRuntimeContainsType : string -> bool ) =
|
||||
let mutable resolutionFolder: string = null
|
||||
let mutable runtimeAssembly: string = null
|
||||
let mutable referencedAssemblies: string[] = null
|
||||
let mutable temporaryFolder: string = null
|
||||
let mutable isInvalidationSupported: bool = false
|
||||
let mutable useResolutionFolderAtRuntime: bool = false
|
||||
let mutable systemRuntimeAssemblyVersion: System.Version = null
|
||||
type TypeProviderConfig(systemRuntimeContainsType: string -> bool) =
|
||||
let mutable resolutionFolder: string = null
|
||||
let mutable runtimeAssembly: string = null
|
||||
let mutable referencedAssemblies: string[] = null
|
||||
let mutable temporaryFolder: string = null
|
||||
let mutable isInvalidationSupported: bool = false
|
||||
let mutable useResolutionFolderAtRuntime: bool = false
|
||||
let mutable systemRuntimeAssemblyVersion: System.Version = null
|
||||
|
||||
member _.ResolutionFolder with get() = resolutionFolder and set v = resolutionFolder <- v
|
||||
member _.ResolutionFolder
|
||||
with get () = resolutionFolder
|
||||
and set v = resolutionFolder <- v
|
||||
|
||||
member _.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v
|
||||
member _.RuntimeAssembly
|
||||
with get () = runtimeAssembly
|
||||
and set v = runtimeAssembly <- v
|
||||
|
||||
member _.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v
|
||||
member _.ReferencedAssemblies
|
||||
with get () = referencedAssemblies
|
||||
and set v = referencedAssemblies <- v
|
||||
|
||||
member _.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v
|
||||
member _.TemporaryFolder
|
||||
with get () = temporaryFolder
|
||||
and set v = temporaryFolder <- v
|
||||
|
||||
member _.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v
|
||||
member _.IsInvalidationSupported
|
||||
with get () = isInvalidationSupported
|
||||
and set v = isInvalidationSupported <- v
|
||||
|
||||
member _.IsHostedExecution with get() = useResolutionFolderAtRuntime and set v = useResolutionFolderAtRuntime <- v
|
||||
member _.IsHostedExecution
|
||||
with get () = useResolutionFolderAtRuntime
|
||||
and set v = useResolutionFolderAtRuntime <- v
|
||||
|
||||
member _.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v
|
||||
member _.SystemRuntimeAssemblyVersion
|
||||
with get () = systemRuntimeAssemblyVersion
|
||||
and set v = systemRuntimeAssemblyVersion <- v
|
||||
|
||||
member _.SystemRuntimeContainsType (typeName: string) = systemRuntimeContainsType typeName
|
||||
member _.SystemRuntimeContainsType(typeName: string) =
|
||||
systemRuntimeContainsType typeName
|
||||
|
||||
type IProvidedNamespace =
|
||||
type IProvidedNamespace =
|
||||
|
||||
abstract NamespaceName: string
|
||||
abstract NamespaceName: string
|
||||
|
||||
abstract GetNestedNamespaces: unit -> IProvidedNamespace[]
|
||||
abstract GetNestedNamespaces: unit -> IProvidedNamespace[]
|
||||
|
||||
abstract GetTypes: unit -> Type[]
|
||||
abstract GetTypes: unit -> Type[]
|
||||
|
||||
abstract ResolveTypeName: typeName: string -> Type
|
||||
abstract ResolveTypeName: typeName: string -> Type
|
||||
|
||||
type ITypeProvider =
|
||||
inherit System.IDisposable
|
||||
type ITypeProvider =
|
||||
inherit System.IDisposable
|
||||
|
||||
abstract GetNamespaces: unit -> IProvidedNamespace[]
|
||||
abstract GetNamespaces: unit -> IProvidedNamespace[]
|
||||
|
||||
abstract GetStaticParameters: typeWithoutArguments: Type -> ParameterInfo[]
|
||||
abstract GetStaticParameters: typeWithoutArguments: Type -> ParameterInfo[]
|
||||
|
||||
abstract ApplyStaticArguments: typeWithoutArguments: Type * typePathWithArguments: string[] * staticArguments:obj[] -> Type
|
||||
abstract ApplyStaticArguments:
|
||||
typeWithoutArguments: Type * typePathWithArguments: string[] * staticArguments: obj[] -> Type
|
||||
|
||||
abstract GetInvokerExpression: syntheticMethodBase:MethodBase * parameters:Expr[] -> Expr
|
||||
abstract GetInvokerExpression: syntheticMethodBase: MethodBase * parameters: Expr[] -> Expr
|
||||
|
||||
[<CLIEvent>]
|
||||
abstract Invalidate : IEvent<System.EventHandler, System.EventArgs>
|
||||
abstract GetGeneratedAssemblyContents: assembly:System.Reflection.Assembly -> byte[]
|
||||
[<CLIEvent>]
|
||||
abstract Invalidate: IEvent<System.EventHandler, System.EventArgs>
|
||||
|
||||
type ITypeProvider2 =
|
||||
abstract GetStaticParametersForMethod: methodWithoutArguments:MethodBase -> ParameterInfo[]
|
||||
abstract GetGeneratedAssemblyContents: assembly: System.Reflection.Assembly -> byte[]
|
||||
|
||||
abstract ApplyStaticArgumentsForMethod: methodWithoutArguments:MethodBase * methodNameWithArguments:string * staticArguments:obj[] -> MethodBase
|
||||
type ITypeProvider2 =
|
||||
abstract GetStaticParametersForMethod: methodWithoutArguments: MethodBase -> ParameterInfo[]
|
||||
|
||||
abstract ApplyStaticArgumentsForMethod:
|
||||
methodWithoutArguments: MethodBase * methodNameWithArguments: string * staticArguments: obj[] -> MethodBase
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -43,8 +43,9 @@ module internal List =
|
|||
|
||||
val distinctWithComparer: System.Collections.Generic.IEqualityComparer<'T> -> 'T list -> 'T list
|
||||
|
||||
val distinctByWithComparer: System.Collections.Generic.IEqualityComparer<'Key> -> ('T -> 'Key) -> list: 'T list -> 'T list
|
||||
when 'Key: equality
|
||||
val distinctByWithComparer:
|
||||
System.Collections.Generic.IEqualityComparer<'Key> -> ('T -> 'Key) -> list: 'T list -> 'T list
|
||||
when 'Key: equality
|
||||
|
||||
val init: int -> (int -> 'T) -> 'T list
|
||||
val filter: predicate: ('T -> bool) -> 'T list -> 'T list
|
||||
|
|
|
|||
|
|
@ -18,13 +18,22 @@ module AsyncHelpers =
|
|||
async {
|
||||
let resultCell = new ResultCell<_>()
|
||||
let! cancellationToken = Async.CancellationToken
|
||||
|
||||
let start a f =
|
||||
Async.StartWithContinuationsUsingDispatchInfo(a,
|
||||
(fun res -> resultCell.RegisterResult(f res |> AsyncResult.Ok, reuseThread=false) |> ignore),
|
||||
(fun edi -> resultCell.RegisterResult(edi |> AsyncResult.Error, reuseThread=false) |> ignore),
|
||||
(fun oce -> resultCell.RegisterResult(oce |> AsyncResult.Canceled, reuseThread=false) |> ignore),
|
||||
Async.StartWithContinuationsUsingDispatchInfo(
|
||||
a,
|
||||
(fun res ->
|
||||
resultCell.RegisterResult(f res |> AsyncResult.Ok, reuseThread = false)
|
||||
|> ignore),
|
||||
(fun edi ->
|
||||
resultCell.RegisterResult(edi |> AsyncResult.Error, reuseThread = false)
|
||||
|> ignore),
|
||||
(fun oce ->
|
||||
resultCell.RegisterResult(oce |> AsyncResult.Canceled, reuseThread = false)
|
||||
|> ignore),
|
||||
cancellationToken = cancellationToken
|
||||
)
|
||||
)
|
||||
|
||||
start a1 Choice1Of2
|
||||
start a2 Choice2Of2
|
||||
// Note: It is ok to use "NoDirectCancel" here because the started computations use the same
|
||||
|
|
@ -37,12 +46,14 @@ module AsyncHelpers =
|
|||
let timeout msec cancellationToken =
|
||||
assert (msec >= 0)
|
||||
let resultCell = new ResultCell<_>()
|
||||
|
||||
Async.StartWithContinuations(
|
||||
computation=Async.Sleep msec,
|
||||
continuation=(fun () -> resultCell.RegisterResult((), reuseThread = false) |> ignore),
|
||||
exceptionContinuation=ignore,
|
||||
cancellationContinuation=ignore,
|
||||
cancellationToken = cancellationToken)
|
||||
computation = Async.Sleep msec,
|
||||
continuation = (fun () -> resultCell.RegisterResult((), reuseThread = false) |> ignore),
|
||||
exceptionContinuation = ignore,
|
||||
cancellationContinuation = ignore,
|
||||
cancellationToken = cancellationToken
|
||||
)
|
||||
// Note: It is ok to use "NoDirectCancel" here because the started computations use the same
|
||||
// cancellation token and will register a cancelled result if cancellation occurs.
|
||||
// Note: It is ok to use "NoDirectTimeout" here because the child compuation above looks after the timeout.
|
||||
|
|
@ -51,7 +62,7 @@ module AsyncHelpers =
|
|||
[<Sealed>]
|
||||
[<AutoSerializable(false)>]
|
||||
type Mailbox<'Msg>(cancellationSupported: bool) =
|
||||
let mutable inboxStore = null
|
||||
let mutable inboxStore = null
|
||||
let arrivals = Queue<'Msg>()
|
||||
let syncRoot = arrivals
|
||||
|
||||
|
|
@ -59,22 +70,21 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
// asynchronous receive, either
|
||||
// -- "cont" is non-null and the reader is "activated" by re-scheduling cont in the thread pool; or
|
||||
// -- "pulse" is non-null and the reader is "activated" by setting this event
|
||||
let mutable savedCont : (bool -> AsyncReturn) option = None
|
||||
let mutable savedCont: (bool -> AsyncReturn) option = None
|
||||
|
||||
// Readers who have a timeout use this event
|
||||
let mutable pulse : AutoResetEvent = null
|
||||
let mutable pulse: AutoResetEvent = null
|
||||
|
||||
// Make sure that the "pulse" value is created
|
||||
let ensurePulse() =
|
||||
let ensurePulse () =
|
||||
match pulse with
|
||||
| null ->
|
||||
pulse <- new AutoResetEvent(false)
|
||||
| _ ->
|
||||
()
|
||||
| null -> pulse <- new AutoResetEvent(false)
|
||||
| _ -> ()
|
||||
|
||||
pulse
|
||||
|
||||
let waitOneNoTimeoutOrCancellation =
|
||||
MakeAsync (fun ctxt ->
|
||||
MakeAsync(fun ctxt ->
|
||||
match savedCont with
|
||||
| None ->
|
||||
let descheduled =
|
||||
|
|
@ -86,16 +96,16 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
true
|
||||
else
|
||||
false)
|
||||
|
||||
if descheduled then
|
||||
Unchecked.defaultof<_>
|
||||
else
|
||||
// If we didn't deschedule then run the continuation immediately
|
||||
ctxt.CallContinuation true
|
||||
| Some _ ->
|
||||
failwith "multiple waiting reader continuations for mailbox")
|
||||
| Some _ -> failwith "multiple waiting reader continuations for mailbox")
|
||||
|
||||
let waitOneWithCancellation timeout =
|
||||
Async.AwaitWaitHandle(ensurePulse(), millisecondsTimeout=timeout)
|
||||
Async.AwaitWaitHandle(ensurePulse (), millisecondsTimeout = timeout)
|
||||
|
||||
let waitOne timeout =
|
||||
if timeout < 0 && not cancellationSupported then
|
||||
|
|
@ -107,16 +117,17 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
match inboxStore with
|
||||
| null -> inboxStore <- new System.Collections.Generic.List<'Msg>(1)
|
||||
| _ -> ()
|
||||
|
||||
inboxStore
|
||||
|
||||
member x.CurrentQueueLength =
|
||||
lock syncRoot (fun () -> x.inbox.Count + arrivals.Count)
|
||||
member x.CurrentQueueLength = lock syncRoot (fun () -> x.inbox.Count + arrivals.Count)
|
||||
|
||||
member x.ScanArrivalsUnsafe f =
|
||||
if arrivals.Count = 0 then
|
||||
None
|
||||
else
|
||||
let msg = arrivals.Dequeue()
|
||||
|
||||
match f msg with
|
||||
| None ->
|
||||
x.inbox.Add msg
|
||||
|
|
@ -131,13 +142,16 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
match inboxStore with
|
||||
| null -> None
|
||||
| inbox ->
|
||||
if n >= inbox.Count
|
||||
then None
|
||||
if n >= inbox.Count then
|
||||
None
|
||||
else
|
||||
let msg = inbox.[n]
|
||||
|
||||
match f msg with
|
||||
| None -> x.ScanInbox (f, n+1)
|
||||
| res -> inbox.RemoveAt n; res
|
||||
| None -> x.ScanInbox(f, n + 1)
|
||||
| res ->
|
||||
inbox.RemoveAt n
|
||||
res
|
||||
|
||||
member x.ReceiveFromArrivalsUnsafe() =
|
||||
if arrivals.Count = 0 then
|
||||
|
|
@ -170,8 +184,7 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
match savedCont with
|
||||
| None ->
|
||||
match pulse with
|
||||
| null ->
|
||||
() // no one waiting, leaving the message in the queue is sufficient
|
||||
| null -> () // no one waiting, leaving the message in the queue is sufficient
|
||||
| ev ->
|
||||
// someone is waiting on the wait handle
|
||||
ev.Set() |> ignore
|
||||
|
|
@ -180,16 +193,16 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
savedCont <- None
|
||||
action true |> ignore)
|
||||
|
||||
member x.TryScan ((f: 'Msg -> (Async<'T>) option), timeout) : Async<'T option> =
|
||||
let rec scan timeoutAsync (timeoutCts:CancellationTokenSource) =
|
||||
member x.TryScan((f: 'Msg -> (Async<'T>) option), timeout) : Async<'T option> =
|
||||
let rec scan timeoutAsync (timeoutCts: CancellationTokenSource) =
|
||||
async {
|
||||
match x.ScanArrivals f with
|
||||
| None ->
|
||||
// Deschedule and wait for a message. When it comes, rescan the arrivals
|
||||
let! ok = AsyncHelpers.awaitEither waitOneNoTimeoutOrCancellation timeoutAsync
|
||||
|
||||
match ok with
|
||||
| Choice1Of2 true ->
|
||||
return! scan timeoutAsync timeoutCts
|
||||
| Choice1Of2 true -> return! scan timeoutAsync timeoutCts
|
||||
| Choice1Of2 false ->
|
||||
return failwith "should not happen - waitOneNoTimeoutOrCancellation always returns true"
|
||||
| Choice2Of2 () ->
|
||||
|
|
@ -214,13 +227,15 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
let! res = resP
|
||||
return Some res
|
||||
}
|
||||
|
||||
let rec scanNoTimeout () =
|
||||
async {
|
||||
match x.ScanArrivals f with
|
||||
| None ->
|
||||
let! ok = waitOne Timeout.Infinite
|
||||
|
||||
if ok then
|
||||
return! scanNoTimeout()
|
||||
return! scanNoTimeout ()
|
||||
else
|
||||
return (failwith "Timed out with infinite timeout??")
|
||||
| Some resP ->
|
||||
|
|
@ -231,11 +246,13 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
// Look in the inbox first
|
||||
async {
|
||||
match x.ScanInbox(f, 0) with
|
||||
| None when timeout < 0 ->
|
||||
return! scanNoTimeout()
|
||||
| None when timeout < 0 -> return! scanNoTimeout ()
|
||||
| None ->
|
||||
let! cancellationToken = Async.CancellationToken
|
||||
let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, CancellationToken.None)
|
||||
|
||||
let timeoutCts =
|
||||
CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, CancellationToken.None)
|
||||
|
||||
let timeoutAsync = AsyncHelpers.timeout timeout timeoutCts.Token
|
||||
return! scan timeoutAsync timeoutCts
|
||||
| Some resP ->
|
||||
|
|
@ -246,13 +263,14 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
member x.Scan((f: 'Msg -> (Async<'T>) option), timeout) =
|
||||
async {
|
||||
let! resOpt = x.TryScan(f, timeout)
|
||||
|
||||
match resOpt with
|
||||
| None -> return raise(TimeoutException(SR.GetString(SR.mailboxScanTimedOut)))
|
||||
| None -> return raise (TimeoutException(SR.GetString(SR.mailboxScanTimedOut)))
|
||||
| Some res -> return res
|
||||
}
|
||||
|
||||
member x.TryReceive timeout =
|
||||
let rec processFirstArrival() =
|
||||
let rec processFirstArrival () =
|
||||
async {
|
||||
match x.ReceiveFromArrivals() with
|
||||
| None ->
|
||||
|
|
@ -261,13 +279,14 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
// check arrivals again.
|
||||
match pulse with
|
||||
| null when timeout >= 0 || cancellationSupported ->
|
||||
ensurePulse() |> ignore
|
||||
return! processFirstArrival()
|
||||
ensurePulse () |> ignore
|
||||
return! processFirstArrival ()
|
||||
| _ ->
|
||||
// Wait until we have been notified about a message. When that happens, rescan the arrivals
|
||||
let! ok = waitOne timeout
|
||||
|
||||
if ok then
|
||||
return! processFirstArrival()
|
||||
return! processFirstArrival ()
|
||||
else
|
||||
return None
|
||||
| res -> return res
|
||||
|
|
@ -276,13 +295,13 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
// look in the inbox first
|
||||
async {
|
||||
match x.ReceiveFromInbox() with
|
||||
| None -> return! processFirstArrival()
|
||||
| None -> return! processFirstArrival ()
|
||||
| res -> return res
|
||||
}
|
||||
|
||||
member x.Receive timeout =
|
||||
|
||||
let rec processFirstArrival() =
|
||||
let rec processFirstArrival () =
|
||||
async {
|
||||
match x.ReceiveFromArrivals() with
|
||||
| None ->
|
||||
|
|
@ -291,39 +310,40 @@ type Mailbox<'Msg>(cancellationSupported: bool) =
|
|||
// check arrivals again.
|
||||
match pulse with
|
||||
| null when timeout >= 0 || cancellationSupported ->
|
||||
ensurePulse() |> ignore
|
||||
return! processFirstArrival()
|
||||
ensurePulse () |> ignore
|
||||
return! processFirstArrival ()
|
||||
| _ ->
|
||||
// Wait until we have been notified about a message. When that happens, rescan the arrivals
|
||||
let! ok = waitOne timeout
|
||||
|
||||
if ok then
|
||||
return! processFirstArrival()
|
||||
return! processFirstArrival ()
|
||||
else
|
||||
return raise(TimeoutException(SR.GetString(SR.mailboxReceiveTimedOut)))
|
||||
return raise (TimeoutException(SR.GetString(SR.mailboxReceiveTimedOut)))
|
||||
| Some res -> return res
|
||||
}
|
||||
|
||||
// look in the inbox first
|
||||
async {
|
||||
match x.ReceiveFromInbox() with
|
||||
| None -> return! processFirstArrival()
|
||||
| None -> return! processFirstArrival ()
|
||||
| Some res -> return res
|
||||
}
|
||||
|
||||
interface System.IDisposable with
|
||||
member _.Dispose() =
|
||||
if isNotNull pulse then (pulse :> IDisposable).Dispose()
|
||||
if isNotNull pulse then
|
||||
(pulse :> IDisposable).Dispose()
|
||||
|
||||
#if DEBUG
|
||||
member x.UnsafeContents =
|
||||
(x.inbox, arrivals, pulse, savedCont) |> box
|
||||
member x.UnsafeContents = (x.inbox, arrivals, pulse, savedCont) |> box
|
||||
#endif
|
||||
|
||||
|
||||
[<Sealed>]
|
||||
[<CompiledName("FSharpAsyncReplyChannel`1")>]
|
||||
type AsyncReplyChannel<'Reply>(replyf : 'Reply -> unit) =
|
||||
member x.Reply value = replyf value
|
||||
type AsyncReplyChannel<'Reply>(replyf: 'Reply -> unit) =
|
||||
member x.Reply value =
|
||||
replyf value
|
||||
|
||||
[<Sealed>]
|
||||
[<AutoSerializable(false)>]
|
||||
|
|
@ -340,7 +360,7 @@ type MailboxProcessor<'Msg>(body, ?cancellationToken) =
|
|||
member _.CurrentQueueLength = mailbox.CurrentQueueLength // nb. unprotected access gives an approximation of the queue length
|
||||
|
||||
member _.DefaultTimeout
|
||||
with get() = defaultTimeout
|
||||
with get () = defaultTimeout
|
||||
and set v = defaultTimeout <- v
|
||||
|
||||
[<CLIEvent>]
|
||||
|
|
@ -360,81 +380,118 @@ type MailboxProcessor<'Msg>(body, ?cancellationToken) =
|
|||
// Note that exception stack traces are lost in this design - in an extended design
|
||||
// the event could propagate an ExceptionDispatchInfo instead of an Exception.
|
||||
let p =
|
||||
async { try
|
||||
do! body x
|
||||
with exn ->
|
||||
errorEvent.Trigger exn }
|
||||
async {
|
||||
try
|
||||
do! body x
|
||||
with exn ->
|
||||
errorEvent.Trigger exn
|
||||
}
|
||||
|
||||
Async.Start(computation=p, cancellationToken=cancellationToken)
|
||||
Async.Start(computation = p, cancellationToken = cancellationToken)
|
||||
|
||||
member _.Post message = mailbox.Post message
|
||||
member _.Post message =
|
||||
mailbox.Post message
|
||||
|
||||
member _.TryPostAndReply(buildMessage : (_ -> 'Msg), ?timeout) : 'Reply option =
|
||||
member _.TryPostAndReply(buildMessage: (_ -> 'Msg), ?timeout) : 'Reply option =
|
||||
let timeout = defaultArg timeout defaultTimeout
|
||||
use resultCell = new ResultCell<_>()
|
||||
let msg = buildMessage (new AsyncReplyChannel<_>(fun reply ->
|
||||
// Note the ResultCell may have been disposed if the operation
|
||||
// timed out. In this case RegisterResult drops the result on the floor.
|
||||
resultCell.RegisterResult(reply, reuseThread=false) |> ignore))
|
||||
|
||||
let msg =
|
||||
buildMessage (
|
||||
new AsyncReplyChannel<_>(fun reply ->
|
||||
// Note the ResultCell may have been disposed if the operation
|
||||
// timed out. In this case RegisterResult drops the result on the floor.
|
||||
resultCell.RegisterResult(reply, reuseThread = false) |> ignore)
|
||||
)
|
||||
|
||||
mailbox.Post msg
|
||||
resultCell.TryWaitForResultSynchronously(timeout=timeout)
|
||||
resultCell.TryWaitForResultSynchronously(timeout = timeout)
|
||||
|
||||
member x.PostAndReply(buildMessage, ?timeout) : 'Reply =
|
||||
match x.TryPostAndReply(buildMessage, ?timeout=timeout) with
|
||||
| None -> raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndReplyTimedOut)))
|
||||
match x.TryPostAndReply(buildMessage, ?timeout = timeout) with
|
||||
| None -> raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndReplyTimedOut)))
|
||||
| Some res -> res
|
||||
|
||||
member _.PostAndTryAsyncReply(buildMessage, ?timeout) : Async<'Reply option> =
|
||||
let timeout = defaultArg timeout defaultTimeout
|
||||
let resultCell = new ResultCell<_>()
|
||||
let msg = buildMessage (new AsyncReplyChannel<_>(fun reply ->
|
||||
// Note the ResultCell may have been disposed if the operation
|
||||
// timed out. In this case RegisterResult drops the result on the floor.
|
||||
resultCell.RegisterResult(reply, reuseThread=false) |> ignore))
|
||||
|
||||
let msg =
|
||||
buildMessage (
|
||||
new AsyncReplyChannel<_>(fun reply ->
|
||||
// Note the ResultCell may have been disposed if the operation
|
||||
// timed out. In this case RegisterResult drops the result on the floor.
|
||||
resultCell.RegisterResult(reply, reuseThread = false) |> ignore)
|
||||
)
|
||||
|
||||
mailbox.Post msg
|
||||
|
||||
match timeout with
|
||||
| Threading.Timeout.Infinite when not cancellationSupported ->
|
||||
async { let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout
|
||||
return Some result }
|
||||
async {
|
||||
let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout
|
||||
return Some result
|
||||
}
|
||||
|
||||
| _ ->
|
||||
async { use _disposeCell = resultCell
|
||||
let! ok = Async.AwaitWaitHandle(resultCell.GetWaitHandle(), millisecondsTimeout=timeout)
|
||||
let res = (if ok then Some(resultCell.GrabResult()) else None)
|
||||
return res }
|
||||
async {
|
||||
use _disposeCell = resultCell
|
||||
let! ok = Async.AwaitWaitHandle(resultCell.GetWaitHandle(), millisecondsTimeout = timeout)
|
||||
|
||||
member x.PostAndAsyncReply(buildMessage, ?timeout:int) =
|
||||
let res =
|
||||
(if ok then
|
||||
Some(resultCell.GrabResult())
|
||||
else
|
||||
None)
|
||||
|
||||
return res
|
||||
}
|
||||
|
||||
member x.PostAndAsyncReply(buildMessage, ?timeout: int) =
|
||||
let timeout = defaultArg timeout defaultTimeout
|
||||
|
||||
match timeout with
|
||||
| Threading.Timeout.Infinite when not cancellationSupported ->
|
||||
// Nothing to dispose, no wait handles used
|
||||
let resultCell = new ResultCell<_>()
|
||||
let msg = buildMessage (new AsyncReplyChannel<_>(fun reply -> resultCell.RegisterResult(reply, reuseThread=false) |> ignore))
|
||||
|
||||
let channel =
|
||||
AsyncReplyChannel<_>(fun reply -> resultCell.RegisterResult(reply, reuseThread = false) |> ignore)
|
||||
|
||||
let msg = buildMessage channel
|
||||
|
||||
mailbox.Post msg
|
||||
resultCell.AwaitResult_NoDirectCancelOrTimeout
|
||||
| _ ->
|
||||
let asyncReply = x.PostAndTryAsyncReply(buildMessage, timeout=timeout)
|
||||
async { let! res = asyncReply
|
||||
match res with
|
||||
| None -> return! raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndAsyncReplyTimedOut)))
|
||||
| Some res -> return res }
|
||||
let asyncReply = x.PostAndTryAsyncReply(buildMessage, timeout = timeout)
|
||||
|
||||
async {
|
||||
let! res = asyncReply
|
||||
|
||||
match res with
|
||||
| None -> return! raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndAsyncReplyTimedOut)))
|
||||
| Some res -> return res
|
||||
}
|
||||
|
||||
member _.Receive(?timeout) =
|
||||
mailbox.Receive(timeout=defaultArg timeout defaultTimeout)
|
||||
mailbox.Receive(timeout = defaultArg timeout defaultTimeout)
|
||||
|
||||
member _.TryReceive(?timeout) =
|
||||
mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout)
|
||||
mailbox.TryReceive(timeout = defaultArg timeout defaultTimeout)
|
||||
|
||||
member _.Scan(scanner: 'Msg -> (Async<'T>) option, ?timeout) =
|
||||
mailbox.Scan(scanner, timeout=defaultArg timeout defaultTimeout)
|
||||
mailbox.Scan(scanner, timeout = defaultArg timeout defaultTimeout)
|
||||
|
||||
member _.TryScan(scanner: 'Msg -> (Async<'T>) option, ?timeout) =
|
||||
mailbox.TryScan(scanner, timeout=defaultArg timeout defaultTimeout)
|
||||
mailbox.TryScan(scanner, timeout = defaultArg timeout defaultTimeout)
|
||||
|
||||
interface System.IDisposable with
|
||||
member _.Dispose() = (mailbox :> IDisposable).Dispose()
|
||||
member _.Dispose() =
|
||||
(mailbox :> IDisposable).Dispose()
|
||||
|
||||
static member Start(body, ?cancellationToken) =
|
||||
let mailboxProcessor = new MailboxProcessor<'Msg>(body, ?cancellationToken=cancellationToken)
|
||||
let mailboxProcessor =
|
||||
new MailboxProcessor<'Msg>(body, ?cancellationToken = cancellationToken)
|
||||
|
||||
mailboxProcessor.Start()
|
||||
mailboxProcessor
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -484,8 +484,9 @@ module Map =
|
|||
/// Evaluates to <c>"1 a 2 b initial"</c>
|
||||
/// </example>
|
||||
[<CompiledName("FoldBack")>]
|
||||
val foldBack<'Key, 'T, 'State> : folder: ('Key -> 'T -> 'State -> 'State) -> table: Map<'Key, 'T> -> state: 'State -> 'State
|
||||
when 'Key: comparison
|
||||
val foldBack<'Key, 'T, 'State> :
|
||||
folder: ('Key -> 'T -> 'State -> 'State) -> table: Map<'Key, 'T> -> state: 'State -> 'State
|
||||
when 'Key: comparison
|
||||
|
||||
/// <summary>Folds over the bindings in the map </summary>
|
||||
///
|
||||
|
|
@ -504,8 +505,9 @@ module Map =
|
|||
/// Evaluates to <c>"initial 1 a 2 b"</c>.
|
||||
/// </example>
|
||||
[<CompiledName("Fold")>]
|
||||
val fold<'Key, 'T, 'State> : folder: ('State -> 'Key -> 'T -> 'State) -> state: 'State -> table: Map<'Key, 'T> -> 'State
|
||||
when 'Key: comparison
|
||||
val fold<'Key, 'T, 'State> :
|
||||
folder: ('State -> 'Key -> 'T -> 'State) -> state: 'State -> table: Map<'Key, 'T> -> 'State
|
||||
when 'Key: comparison
|
||||
|
||||
/// <summary>Applies the given function to each binding in the dictionary</summary>
|
||||
///
|
||||
|
|
|
|||
|
|
@ -26,60 +26,64 @@ open System.Numerics
|
|||
[<AutoOpen>]
|
||||
module NumericLiterals =
|
||||
|
||||
module NumericLiteralI =
|
||||
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 tab64 = new System.Collections.Generic.Dictionary<int64, obj>()
|
||||
let tabParse = new System.Collections.Generic.Dictionary<string, obj>()
|
||||
|
||||
let inline get32 (x32:int32) = FromInt64Dynamic (int64 x32)
|
||||
let FromInt64Dynamic (value: int64) : obj =
|
||||
lock tab64 (fun () ->
|
||||
let mutable res = Unchecked.defaultof<_>
|
||||
let ok = tab64.TryGetValue(value, &res)
|
||||
|
||||
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
|
||||
if ok then
|
||||
res
|
||||
else
|
||||
res <- BigInteger(value)
|
||||
tab64.[value] <- res
|
||||
res)
|
||||
|
||||
let FromOne () : 'T =
|
||||
(get32 1 :?> 'T)
|
||||
when 'T : BigInteger = BigInteger.One
|
||||
let inline get32 (x32: int32) =
|
||||
FromInt64Dynamic(int64 x32)
|
||||
|
||||
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 inline isOX s =
|
||||
not (System.String.IsNullOrEmpty(s))
|
||||
&& s.Length > 2
|
||||
&& s.[0] = '0'
|
||||
&& s.[1] = 'x'
|
||||
|
||||
let FromStringDynamic (text:string) : obj =
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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,55 +25,67 @@ 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
|
||||
member x.OnNext value =
|
||||
if not stopped then x.Next value
|
||||
|
||||
member x.OnError e =
|
||||
if not stopped then
|
||||
member x.OnError e =
|
||||
if not stopped then
|
||||
stopped <- true
|
||||
x.Error e
|
||||
|
||||
member x.OnCompleted () =
|
||||
if not stopped then
|
||||
stopped <- true
|
||||
x.Completed ()
|
||||
member x.OnCompleted() =
|
||||
if not stopped then
|
||||
stopped <- true
|
||||
x.Completed()
|
||||
|
||||
[<CompiledName("Map")>]
|
||||
let map mapping (source: IObservable<'T>) =
|
||||
{ new IObservable<'U> with
|
||||
member x.Subscribe(observer) =
|
||||
source.Subscribe
|
||||
{ new BasicObserver<'T>() with
|
||||
|
||||
member x.Next(v) =
|
||||
protect (fun () -> mapping v) observer.OnNext observer.OnError
|
||||
|
||||
member x.Error(e) = observer.OnError(e)
|
||||
|
||||
member x.Completed() = observer.OnCompleted() } }
|
||||
{ new IObservable<'U> with
|
||||
member x.Subscribe(observer) =
|
||||
source.Subscribe
|
||||
{ new BasicObserver<'T>() with
|
||||
|
||||
member x.Next(v) =
|
||||
protect (fun () -> mapping v) observer.OnNext observer.OnError
|
||||
|
||||
member x.Error(e) =
|
||||
observer.OnError(e)
|
||||
|
||||
member x.Completed() =
|
||||
observer.OnCompleted()
|
||||
}
|
||||
}
|
||||
|
||||
[<CompiledName("Choose")>]
|
||||
let choose chooser (source: IObservable<'T>) =
|
||||
{ new IObservable<'U> with
|
||||
member x.Subscribe(observer) =
|
||||
source.Subscribe
|
||||
{ new BasicObserver<'T>() with
|
||||
{ new IObservable<'U> with
|
||||
member x.Subscribe(observer) =
|
||||
source.Subscribe
|
||||
{ new BasicObserver<'T>() with
|
||||
|
||||
member x.Next(v) =
|
||||
protect (fun () -> chooser v) (function None -> () | Some v2 -> observer.OnNext v2) observer.OnError
|
||||
member x.Next(v) =
|
||||
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>) =
|
||||
|
|
@ -81,97 +97,129 @@ module Observable =
|
|||
|
||||
[<CompiledName("Scan")>]
|
||||
let scan collector state (source: IObservable<'T>) =
|
||||
{ new IObservable<'U> with
|
||||
member x.Subscribe(observer) =
|
||||
let mutable state = state
|
||||
source.Subscribe
|
||||
{ new BasicObserver<'T>() with
|
||||
{ new IObservable<'U> with
|
||||
member x.Subscribe(observer) =
|
||||
let mutable state = state
|
||||
|
||||
member x.Next(v) =
|
||||
let z = state
|
||||
protect (fun () -> collector z v) (fun z ->
|
||||
state <- z
|
||||
observer.OnNext z) observer.OnError
|
||||
|
||||
member x.Error(e) = observer.OnError(e)
|
||||
source.Subscribe
|
||||
{ new BasicObserver<'T>() with
|
||||
|
||||
member x.Completed() = observer.OnCompleted() } }
|
||||
member x.Next(v) =
|
||||
let z = state
|
||||
|
||||
protect
|
||||
(fun () -> collector z v)
|
||||
(fun z ->
|
||||
state <- z
|
||||
observer.OnNext z)
|
||||
observer.OnError
|
||||
|
||||
member x.Error(e) =
|
||||
observer.OnError(e)
|
||||
|
||||
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> =
|
||||
{ new IObservable<_> with
|
||||
member x.Subscribe(observer) =
|
||||
let mutable lastArgs = None
|
||||
source.Subscribe
|
||||
{ new BasicObserver<'T>() with
|
||||
let pairwise (source: IObservable<'T>) : IObservable<'T * 'T> =
|
||||
{ new IObservable<_> with
|
||||
member x.Subscribe(observer) =
|
||||
let mutable lastArgs = None
|
||||
|
||||
member x.Next(args2) =
|
||||
match lastArgs with
|
||||
| None -> ()
|
||||
| Some args1 -> observer.OnNext (args1,args2)
|
||||
lastArgs <- Some args2
|
||||
source.Subscribe
|
||||
{ new BasicObserver<'T>() with
|
||||
|
||||
member x.Error(e) = observer.OnError(e)
|
||||
member x.Next(args2) =
|
||||
match lastArgs with
|
||||
| None -> ()
|
||||
| Some args1 -> observer.OnNext(args1, args2)
|
||||
|
||||
member x.Completed() = observer.OnCompleted() } }
|
||||
lastArgs <- Some args2
|
||||
|
||||
member x.Error(e) =
|
||||
observer.OnError(e)
|
||||
|
||||
member x.Completed() =
|
||||
observer.OnCompleted()
|
||||
}
|
||||
}
|
||||
|
||||
[<CompiledName("Merge")>]
|
||||
let merge (source1: IObservable<'T>) (source2: IObservable<'T>) =
|
||||
{ new IObservable<_> with
|
||||
member x.Subscribe(observer) =
|
||||
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
|
||||
{ new IObservable<_> with
|
||||
member x.Subscribe(observer) =
|
||||
let mutable stopped = false
|
||||
let mutable completed1 = false
|
||||
let mutable completed2 = false
|
||||
|
||||
member x.OnError(e) =
|
||||
if not stopped then
|
||||
stopped <- true
|
||||
observer.OnError(e)
|
||||
let h1 =
|
||||
source1.Subscribe
|
||||
{ new IObserver<'T> with
|
||||
member x.OnNext(v) =
|
||||
if not stopped then observer.OnNext v
|
||||
|
||||
member x.OnCompleted() =
|
||||
if not stopped then
|
||||
completed1 <- true
|
||||
if completed1 && completed2 then
|
||||
stopped <- true
|
||||
observer.OnCompleted() }
|
||||
let h2 =
|
||||
source2.Subscribe
|
||||
{ new IObserver<'T> with
|
||||
member x.OnNext(v) =
|
||||
if not stopped then
|
||||
observer.OnNext v
|
||||
member x.OnError(e) =
|
||||
if not stopped then
|
||||
stopped <- true
|
||||
observer.OnError(e)
|
||||
|
||||
member x.OnError(e) =
|
||||
if not stopped then
|
||||
stopped <- true
|
||||
observer.OnError(e)
|
||||
member x.OnCompleted() =
|
||||
if not stopped then
|
||||
completed1 <- true
|
||||
|
||||
member x.OnCompleted() =
|
||||
if not stopped then
|
||||
completed2 <- true
|
||||
if completed1 && completed2 then
|
||||
stopped <- true
|
||||
observer.OnCompleted() }
|
||||
if completed1 && completed2 then
|
||||
stopped <- true
|
||||
observer.OnCompleted()
|
||||
}
|
||||
|
||||
{ new IDisposable with
|
||||
member x.Dispose() =
|
||||
h1.Dispose()
|
||||
h2.Dispose() } }
|
||||
let h2 =
|
||||
source2.Subscribe
|
||||
{ new IObserver<'T> with
|
||||
member x.OnNext(v) =
|
||||
if not stopped then observer.OnNext v
|
||||
|
||||
member x.OnError(e) =
|
||||
if not stopped then
|
||||
stopped <- true
|
||||
observer.OnError(e)
|
||||
|
||||
member x.OnCompleted() =
|
||||
if not stopped then
|
||||
completed2 <- true
|
||||
|
||||
if completed1 && completed2 then
|
||||
stopped <- true
|
||||
observer.OnCompleted()
|
||||
}
|
||||
|
||||
{ new IDisposable with
|
||||
member x.Dispose() =
|
||||
h1.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
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ namespace Microsoft.FSharp.Core
|
|||
open Microsoft.FSharp.Core.Operators
|
||||
|
||||
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
|
||||
module Option =
|
||||
module Option =
|
||||
|
||||
[<CompiledName("GetValue")>]
|
||||
let get option =
|
||||
|
|
@ -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 =
|
||||
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 =
|
||||
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 =
|
||||
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 =
|
||||
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
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -20,9 +20,9 @@ open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
|
|||
open Microsoft.FSharp.Control
|
||||
open Microsoft.FSharp.Collections
|
||||
|
||||
[<AttributeUsage (AttributeTargets.Method, AllowMultiple=false)>]
|
||||
[<AttributeUsage(AttributeTargets.Method, AllowMultiple = false)>]
|
||||
[<Sealed>]
|
||||
type NoEagerConstraintApplicationAttribute() =
|
||||
type NoEagerConstraintApplicationAttribute() =
|
||||
inherit System.Attribute()
|
||||
|
||||
type IResumableStateMachine<'Data> =
|
||||
|
|
@ -43,26 +43,28 @@ type ResumableStateMachine<'Data> =
|
|||
[<DefaultValue(false)>]
|
||||
val mutable ResumptionDynamicInfo: ResumptionDynamicInfo<'Data>
|
||||
|
||||
interface IResumableStateMachine<'Data> with
|
||||
interface IResumableStateMachine<'Data> with
|
||||
member sm.ResumptionPoint = sm.ResumptionPoint
|
||||
member sm.Data with get() = sm.Data and set v = sm.Data <- v
|
||||
|
||||
interface IAsyncStateMachine with
|
||||
|
||||
member sm.Data
|
||||
with get () = sm.Data
|
||||
and set v = sm.Data <- v
|
||||
|
||||
interface IAsyncStateMachine with
|
||||
|
||||
// Used for dynamic execution. For "__stateMachine" it is replaced.
|
||||
member sm.MoveNext() =
|
||||
member sm.MoveNext() =
|
||||
sm.ResumptionDynamicInfo.MoveNext(&sm)
|
||||
|
||||
// Used when dynamic execution. For "__stateMachine" it is replaced.
|
||||
member sm.SetStateMachine(state) =
|
||||
member sm.SetStateMachine(state) =
|
||||
sm.ResumptionDynamicInfo.SetStateMachine(&sm, state)
|
||||
|
||||
and ResumptionFunc<'Data> = delegate of byref<ResumableStateMachine<'Data>> -> bool
|
||||
|
||||
and [<AbstractClass>]
|
||||
ResumptionDynamicInfo<'Data>(initial: ResumptionFunc<'Data>) =
|
||||
member val ResumptionFunc: ResumptionFunc<'Data> = initial with get, set
|
||||
member val ResumptionData: obj = null with get, set
|
||||
and [<AbstractClass>] ResumptionDynamicInfo<'Data>(initial: ResumptionFunc<'Data>) =
|
||||
member val ResumptionFunc: ResumptionFunc<'Data> = initial with get, set
|
||||
member val ResumptionData: obj = null with get, set
|
||||
abstract MoveNext: machine: byref<ResumableStateMachine<'Data>> -> unit
|
||||
abstract SetStateMachine: machine: byref<ResumableStateMachine<'Data>> * machineState: IAsyncStateMachine -> unit
|
||||
|
||||
|
|
@ -78,33 +80,40 @@ type SetStateMachineMethodImpl<'Data> = delegate of byref<ResumableStateMachine<
|
|||
type AfterCode<'Data, 'Result> = delegate of byref<ResumableStateMachine<'Data>> -> 'Result
|
||||
|
||||
[<AutoOpen>]
|
||||
module StateMachineHelpers =
|
||||
module StateMachineHelpers =
|
||||
|
||||
/// Statically determines whether resumable code is being used
|
||||
[<MethodImpl(MethodImplOptions.NoInlining)>]
|
||||
let __useResumableCode<'T> : bool = false
|
||||
|
||||
[<MethodImpl(MethodImplOptions.NoInlining)>]
|
||||
let __debugPoint (_name: string) : unit = ()
|
||||
let __debugPoint (_name: string) : unit =
|
||||
()
|
||||
|
||||
[<MethodImpl(MethodImplOptions.NoInlining)>]
|
||||
let __resumableEntry () : int option =
|
||||
failwith "__resumableEntry should always be guarded by __useResumableCode and only used in valid state machine implementations"
|
||||
let __resumableEntry () : int option =
|
||||
failwith
|
||||
"__resumableEntry should always be guarded by __useResumableCode and only used in valid state machine implementations"
|
||||
|
||||
[<MethodImpl(MethodImplOptions.NoInlining)>]
|
||||
let __resumeAt<'T> (programLabel: int) : 'T =
|
||||
let __resumeAt<'T> (programLabel: int) : 'T =
|
||||
ignore programLabel
|
||||
failwith "__resumeAt should always be guarded by __useResumableCode and only used in valid state machine implementations"
|
||||
|
||||
failwith
|
||||
"__resumeAt should always be guarded by __useResumableCode and only used in valid state machine implementations"
|
||||
|
||||
[<MethodImpl(MethodImplOptions.NoInlining)>]
|
||||
let __stateMachine<'Data, 'Result>
|
||||
(moveNextMethod: MoveNextMethodImpl<'Data>)
|
||||
(setStateMachineMethod: SetStateMachineMethodImpl<'Data>)
|
||||
(afterCode: AfterCode<'Data, 'Result>): 'Result =
|
||||
let __stateMachine<'Data, 'Result>
|
||||
(moveNextMethod: MoveNextMethodImpl<'Data>)
|
||||
(setStateMachineMethod: SetStateMachineMethodImpl<'Data>)
|
||||
(afterCode: AfterCode<'Data, 'Result>)
|
||||
: 'Result =
|
||||
ignore moveNextMethod
|
||||
ignore setStateMachineMethod
|
||||
ignore afterCode
|
||||
failwith "__stateMachine should always be guarded by __useResumableCode and only used in valid state machine implementations"
|
||||
|
||||
failwith
|
||||
"__stateMachine should always be guarded by __useResumableCode and only used in valid state machine implementations"
|
||||
|
||||
module ResumableCode =
|
||||
|
||||
|
|
@ -114,23 +123,28 @@ module ResumableCode =
|
|||
let inline GetResumptionFunc (sm: byref<ResumableStateMachine<'Data>>) =
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc
|
||||
|
||||
let inline Delay(f : unit -> ResumableCode<'Data, 'T>) : ResumableCode<'Data, 'T> =
|
||||
ResumableCode<'Data, 'T>(fun sm -> (f()).Invoke(&sm))
|
||||
let inline Delay (f: unit -> ResumableCode<'Data, 'T>) : ResumableCode<'Data, 'T> =
|
||||
ResumableCode<'Data, 'T>(fun sm -> (f ()).Invoke(&sm))
|
||||
|
||||
/// Used to represent no-ops like the implicit empty "else" branch of an "if" expression.
|
||||
let inline Zero() : ResumableCode<'Data, unit> =
|
||||
let inline Zero () : ResumableCode<'Data, unit> =
|
||||
ResumableCode<'Data, unit>(fun sm -> true)
|
||||
|
||||
/// Chains together a step with its following step.
|
||||
/// Note that this requires that the first step has no result.
|
||||
/// This prevents constructs like `task { return 1; return 2; }`.
|
||||
let CombineDynamic(sm: byref<ResumableStateMachine<'Data>>, code1: ResumableCode<'Data, unit>, code2: ResumableCode<'Data, 'T>) : bool =
|
||||
if code1.Invoke(&sm) then
|
||||
let CombineDynamic
|
||||
(
|
||||
sm: byref<ResumableStateMachine<'Data>>,
|
||||
code1: ResumableCode<'Data, unit>,
|
||||
code2: ResumableCode<'Data, 'T>
|
||||
) : bool =
|
||||
if code1.Invoke(&sm) then
|
||||
code2.Invoke(&sm)
|
||||
else
|
||||
let rec resume (mf: ResumptionFunc<'Data>) =
|
||||
ResumptionFunc<'Data>(fun sm ->
|
||||
if mf.Invoke(&sm) then
|
||||
ResumptionFunc<'Data>(fun sm ->
|
||||
if mf.Invoke(&sm) then
|
||||
code2.Invoke(&sm)
|
||||
else
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- (resume (GetResumptionFunc &sm))
|
||||
|
|
@ -142,131 +156,191 @@ module ResumableCode =
|
|||
/// Chains together a step with its following step.
|
||||
/// Note that this requires that the first step has no result.
|
||||
/// This prevents constructs like `task { return 1; return 2; }`.
|
||||
let inline Combine(code1: ResumableCode<'Data, unit>, code2: ResumableCode<'Data, 'T>) : ResumableCode<'Data, 'T> =
|
||||
let inline Combine (code1: ResumableCode<'Data, unit>, code2: ResumableCode<'Data, 'T>) : ResumableCode<'Data, 'T> =
|
||||
ResumableCode<'Data, 'T>(fun sm ->
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
// NOTE: The code for code1 may contain await points! Resuming may branch directly
|
||||
// into this code!
|
||||
let __stack_fin = code1.Invoke(&sm)
|
||||
if __stack_fin then
|
||||
|
||||
if __stack_fin then
|
||||
code2.Invoke(&sm)
|
||||
else
|
||||
false
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
else
|
||||
CombineDynamic(&sm, code1, code2))
|
||||
|
||||
let rec WhileDynamic (sm: byref<ResumableStateMachine<'Data>>, condition: unit -> bool, body: ResumableCode<'Data,unit>) : bool =
|
||||
if condition() then
|
||||
if body.Invoke (&sm) then
|
||||
WhileDynamic (&sm, condition, body)
|
||||
let rec WhileDynamic
|
||||
(
|
||||
sm: byref<ResumableStateMachine<'Data>>,
|
||||
condition: unit -> bool,
|
||||
body: ResumableCode<'Data, unit>
|
||||
) : bool =
|
||||
if condition () then
|
||||
if body.Invoke(&sm) then
|
||||
WhileDynamic(&sm, condition, body)
|
||||
else
|
||||
let rf = GetResumptionFunc &sm
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- (ResumptionFunc<'Data>(fun sm -> WhileBodyDynamicAux(&sm, condition, body, rf)))
|
||||
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <-
|
||||
(ResumptionFunc<'Data>(fun sm -> WhileBodyDynamicAux(&sm, condition, body, rf)))
|
||||
|
||||
false
|
||||
else
|
||||
true
|
||||
and WhileBodyDynamicAux (sm: byref<ResumableStateMachine<'Data>>, condition: unit -> bool, body: ResumableCode<'Data,unit>, rf: ResumptionFunc<_>) : bool =
|
||||
if rf.Invoke (&sm) then
|
||||
WhileDynamic (&sm, condition, body)
|
||||
|
||||
and WhileBodyDynamicAux
|
||||
(
|
||||
sm: byref<ResumableStateMachine<'Data>>,
|
||||
condition: unit -> bool,
|
||||
body: ResumableCode<'Data, unit>,
|
||||
rf: ResumptionFunc<_>
|
||||
) : bool =
|
||||
if rf.Invoke(&sm) then
|
||||
WhileDynamic(&sm, condition, body)
|
||||
else
|
||||
let rf = GetResumptionFunc &sm
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- (ResumptionFunc<'Data>(fun sm -> WhileBodyDynamicAux(&sm, condition, body, rf)))
|
||||
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <-
|
||||
(ResumptionFunc<'Data>(fun sm -> WhileBodyDynamicAux(&sm, condition, body, rf)))
|
||||
|
||||
false
|
||||
|
||||
/// Builds a step that executes the body while the condition predicate is true.
|
||||
let inline While ([<InlineIfLambda>] condition : unit -> bool, body : ResumableCode<'Data, unit>) : ResumableCode<'Data, unit> =
|
||||
let inline While
|
||||
(
|
||||
[<InlineIfLambda>] condition: unit -> bool,
|
||||
body: ResumableCode<'Data, unit>
|
||||
) : ResumableCode<'Data, unit> =
|
||||
ResumableCode<'Data, unit>(fun sm ->
|
||||
if __useResumableCode then
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
let mutable __stack_go = true
|
||||
while __stack_go && condition() do
|
||||
let mutable __stack_go = true
|
||||
|
||||
while __stack_go && condition () do
|
||||
// NOTE: The body of the state machine code for 'while' may contain await points, so resuming
|
||||
// the code will branch directly into the expanded 'body', branching directly into the while loop
|
||||
let __stack_body_fin = body.Invoke(&sm)
|
||||
// If the body completed, we go back around the loop (__stack_go = true)
|
||||
// If the body yielded, we yield (__stack_go = false)
|
||||
__stack_go <- __stack_body_fin
|
||||
|
||||
__stack_go
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
else
|
||||
WhileDynamic(&sm, condition, body))
|
||||
|
||||
let rec TryWithDynamic (sm: byref<ResumableStateMachine<'Data>>, body: ResumableCode<'Data, 'T>, handler: exn -> ResumableCode<'Data, 'T>) : bool =
|
||||
let rec TryWithDynamic
|
||||
(
|
||||
sm: byref<ResumableStateMachine<'Data>>,
|
||||
body: ResumableCode<'Data, 'T>,
|
||||
handler: exn -> ResumableCode<'Data, 'T>
|
||||
) : bool =
|
||||
try
|
||||
if body.Invoke(&sm) then
|
||||
if body.Invoke(&sm) then
|
||||
true
|
||||
else
|
||||
let rf = GetResumptionFunc &sm
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- (ResumptionFunc<'Data>(fun sm -> TryWithDynamic(&sm, ResumableCode<'Data,'T>(fun sm -> rf.Invoke(&sm)), handler)))
|
||||
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <-
|
||||
(ResumptionFunc<'Data>(fun sm ->
|
||||
TryWithDynamic(&sm, ResumableCode<'Data, 'T>(fun sm -> rf.Invoke(&sm)), handler)))
|
||||
|
||||
false
|
||||
with exn ->
|
||||
with exn ->
|
||||
(handler exn).Invoke(&sm)
|
||||
|
||||
/// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function
|
||||
/// to retrieve the step, and in the continuation of the step (if any).
|
||||
let inline TryWith (body: ResumableCode<'Data, 'T>, catch: exn -> ResumableCode<'Data, 'T>) : ResumableCode<'Data, 'T> =
|
||||
let inline TryWith
|
||||
(
|
||||
body: ResumableCode<'Data, 'T>,
|
||||
catch: exn -> ResumableCode<'Data, 'T>
|
||||
) : ResumableCode<'Data, 'T> =
|
||||
ResumableCode<'Data, 'T>(fun sm ->
|
||||
if __useResumableCode then
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
let mutable __stack_fin = false
|
||||
let mutable __stack_caught = false
|
||||
let mutable __stack_savedExn = Unchecked.defaultof<_>
|
||||
|
||||
try
|
||||
// The try block may contain await points.
|
||||
let __stack_body_fin = body.Invoke(&sm)
|
||||
// If we make it to the assignment we prove we've made a step
|
||||
__stack_fin <- __stack_body_fin
|
||||
with exn ->
|
||||
with exn ->
|
||||
__stack_caught <- true
|
||||
__stack_savedExn <- exn
|
||||
|
||||
if __stack_caught then
|
||||
// Place the catch code outside the catch block
|
||||
if __stack_caught then
|
||||
// Place the catch code outside the catch block
|
||||
(catch __stack_savedExn).Invoke(&sm)
|
||||
else
|
||||
__stack_fin
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
|
||||
else
|
||||
TryWithDynamic(&sm, body, catch))
|
||||
|
||||
let rec TryFinallyCompensateDynamic (sm: byref<ResumableStateMachine<'Data>>, mf: ResumptionFunc<'Data>, savedExn: exn option) : bool =
|
||||
let rec TryFinallyCompensateDynamic
|
||||
(
|
||||
sm: byref<ResumableStateMachine<'Data>>,
|
||||
mf: ResumptionFunc<'Data>,
|
||||
savedExn: exn option
|
||||
) : bool =
|
||||
let mutable fin = false
|
||||
fin <- mf.Invoke(&sm)
|
||||
|
||||
if fin then
|
||||
// reraise at the end of the finally block
|
||||
match savedExn with
|
||||
match savedExn with
|
||||
| None -> true
|
||||
| Some exn -> raise exn
|
||||
else
|
||||
else
|
||||
let rf = GetResumptionFunc &sm
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- (ResumptionFunc<'Data>(fun sm -> TryFinallyCompensateDynamic(&sm, rf, savedExn)))
|
||||
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <-
|
||||
(ResumptionFunc<'Data>(fun sm -> TryFinallyCompensateDynamic(&sm, rf, savedExn)))
|
||||
|
||||
false
|
||||
|
||||
let rec TryFinallyAsyncDynamic (sm: byref<ResumableStateMachine<'Data>>, body: ResumableCode<'Data, 'T>, compensation: ResumableCode<'Data,unit>) : bool =
|
||||
let rec TryFinallyAsyncDynamic
|
||||
(
|
||||
sm: byref<ResumableStateMachine<'Data>>,
|
||||
body: ResumableCode<'Data, 'T>,
|
||||
compensation: ResumableCode<'Data, unit>
|
||||
) : bool =
|
||||
let mutable fin = false
|
||||
let mutable savedExn = None
|
||||
|
||||
try
|
||||
fin <- body.Invoke(&sm)
|
||||
with exn ->
|
||||
savedExn <- Some exn
|
||||
savedExn <- Some exn
|
||||
fin <- true
|
||||
if fin then
|
||||
|
||||
if fin then
|
||||
TryFinallyCompensateDynamic(&sm, ResumptionFunc<'Data>(fun sm -> compensation.Invoke(&sm)), savedExn)
|
||||
else
|
||||
let rf = GetResumptionFunc &sm
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- (ResumptionFunc<'Data>(fun sm -> TryFinallyAsyncDynamic(&sm, ResumableCode<'Data,'T>(fun sm -> rf.Invoke(&sm)), compensation)))
|
||||
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <-
|
||||
(ResumptionFunc<'Data>(fun sm ->
|
||||
TryFinallyAsyncDynamic(&sm, ResumableCode<'Data, 'T>(fun sm -> rf.Invoke(&sm)), compensation)))
|
||||
|
||||
false
|
||||
|
||||
/// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function
|
||||
/// to retrieve the step, and in the continuation of the step (if any).
|
||||
let inline TryFinally (body: ResumableCode<'Data, 'T>, compensation: ResumableCode<'Data,unit>) =
|
||||
let inline TryFinally (body: ResumableCode<'Data, 'T>, compensation: ResumableCode<'Data, unit>) =
|
||||
ResumableCode<'Data, 'T>(fun sm ->
|
||||
if __useResumableCode then
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
let mutable __stack_fin = false
|
||||
|
||||
try
|
||||
let __stack_body_fin = body.Invoke(&sm)
|
||||
// If we make it to the assignment we prove we've made a step, an early 'ret' exit out of the try/with
|
||||
|
|
@ -274,24 +348,30 @@ module ResumableCode =
|
|||
__stack_fin <- __stack_body_fin
|
||||
with _exn ->
|
||||
let __stack_ignore = compensation.Invoke(&sm)
|
||||
reraise()
|
||||
reraise ()
|
||||
|
||||
if __stack_fin then
|
||||
if __stack_fin then
|
||||
let __stack_ignore = compensation.Invoke(&sm)
|
||||
()
|
||||
|
||||
__stack_fin
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
else
|
||||
TryFinallyAsyncDynamic(&sm, body, ResumableCode<_,_>(fun sm -> compensation.Invoke(&sm))))
|
||||
TryFinallyAsyncDynamic(&sm, body, ResumableCode<_, _>(fun sm -> compensation.Invoke(&sm))))
|
||||
|
||||
/// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function
|
||||
/// to retrieve the step, and in the continuation of the step (if any).
|
||||
let inline TryFinallyAsync (body: ResumableCode<'Data, 'T>, compensation: ResumableCode<'Data,unit>) : ResumableCode<'Data, 'T> =
|
||||
let inline TryFinallyAsync
|
||||
(
|
||||
body: ResumableCode<'Data, 'T>,
|
||||
compensation: ResumableCode<'Data, unit>
|
||||
) : ResumableCode<'Data, 'T> =
|
||||
ResumableCode<'Data, 'T>(fun sm ->
|
||||
if __useResumableCode then
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
let mutable __stack_fin = false
|
||||
let mutable savedExn = None
|
||||
|
||||
try
|
||||
let __stack_body_fin = body.Invoke(&sm)
|
||||
// If we make it to the assignment we prove we've made a step, an early 'ret' exit out of the try/with
|
||||
|
|
@ -301,59 +381,67 @@ module ResumableCode =
|
|||
savedExn <- Some exn
|
||||
__stack_fin <- true
|
||||
|
||||
if __stack_fin then
|
||||
if __stack_fin then
|
||||
let __stack_compensation_fin = compensation.Invoke(&sm)
|
||||
__stack_fin <- __stack_compensation_fin
|
||||
|
||||
if __stack_fin then
|
||||
match savedExn with
|
||||
if __stack_fin then
|
||||
match savedExn with
|
||||
| None -> ()
|
||||
| Some exn -> raise exn
|
||||
|
||||
__stack_fin
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
else
|
||||
TryFinallyAsyncDynamic(&sm, body, compensation))
|
||||
|
||||
let inline Using (resource : 'Resource, body : 'Resource -> ResumableCode<'Data, 'T>) : ResumableCode<'Data, 'T> when 'Resource :> IDisposable =
|
||||
let inline Using
|
||||
(
|
||||
resource: 'Resource,
|
||||
body: 'Resource -> ResumableCode<'Data, 'T>
|
||||
) : ResumableCode<'Data, 'T> when 'Resource :> IDisposable =
|
||||
// A using statement is just a try/finally with the finally block disposing if non-null.
|
||||
TryFinally(
|
||||
ResumableCode<'Data, 'T>(fun sm -> (body resource).Invoke(&sm)),
|
||||
ResumableCode<'Data,unit>(fun sm ->
|
||||
if not (isNull (box resource)) then
|
||||
ResumableCode<'Data, unit>(fun sm ->
|
||||
if not (isNull (box resource)) then
|
||||
resource.Dispose()
|
||||
true))
|
||||
|
||||
let inline For (sequence : seq<'T>, body : 'T -> ResumableCode<'Data, unit>) : ResumableCode<'Data, unit> =
|
||||
true)
|
||||
)
|
||||
|
||||
let inline For (sequence: seq<'T>, body: 'T -> ResumableCode<'Data, unit>) : ResumableCode<'Data, unit> =
|
||||
// A for loop is just a using statement on the sequence's enumerator...
|
||||
Using (sequence.GetEnumerator(),
|
||||
Using(
|
||||
sequence.GetEnumerator(),
|
||||
// ... and its body is a while loop that advances the enumerator and runs the body on each element.
|
||||
(fun e ->
|
||||
While(
|
||||
(fun () ->
|
||||
(fun () ->
|
||||
__debugPoint "ForLoop.InOrToKeyword"
|
||||
e.MoveNext()),
|
||||
ResumableCode<'Data, unit>(fun sm ->
|
||||
(body e.Current).Invoke(&sm)))))
|
||||
e.MoveNext()),
|
||||
ResumableCode<'Data, unit>(fun sm -> (body e.Current).Invoke(&sm))
|
||||
))
|
||||
)
|
||||
|
||||
let YieldDynamic (sm: byref<ResumableStateMachine<'Data>>) : bool =
|
||||
let YieldDynamic (sm: byref<ResumableStateMachine<'Data>>) : bool =
|
||||
let cont = ResumptionFunc<'Data>(fun _sm -> true)
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- cont
|
||||
false
|
||||
|
||||
let inline Yield () : ResumableCode<'Data, unit> =
|
||||
ResumableCode<'Data, unit>(fun sm ->
|
||||
if __useResumableCode then
|
||||
let inline Yield () : ResumableCode<'Data, unit> =
|
||||
ResumableCode<'Data, unit>(fun sm ->
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
match __resumableEntry() with
|
||||
match __resumableEntry () with
|
||||
| Some contID ->
|
||||
sm.ResumptionPoint <- contID
|
||||
//if verbose then printfn $"[{sm.Id}] Yield: returning false to indicate yield, contID = {contID}"
|
||||
//if verbose then printfn $"[{sm.Id}] Yield: returning false to indicate yield, contID = {contID}"
|
||||
false
|
||||
| None ->
|
||||
//if verbose then printfn $"[{sm.Id}] Yield: returning true to indicate post-yield"
|
||||
//if verbose then printfn $"[{sm.Id}] Yield: returning true to indicate post-yield"
|
||||
true
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
else
|
||||
YieldDynamic(&sm))
|
||||
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -100,8 +100,8 @@ module RuntimeHelpers =
|
|||
/// <param name="source">The input sequence.</param>
|
||||
///
|
||||
/// <returns>The result sequence.</returns>
|
||||
val EnumerateUsing: resource: 'T -> source: ('T -> 'Collection) -> seq<'U>
|
||||
when 'T :> IDisposable and 'Collection :> seq<'U>
|
||||
val EnumerateUsing:
|
||||
resource: 'T -> source: ('T -> 'Collection) -> seq<'U> when 'T :> IDisposable and 'Collection :> seq<'U>
|
||||
|
||||
/// <summary>Creates an anonymous event with the given handlers.</summary>
|
||||
///
|
||||
|
|
|
|||
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
|
@ -471,8 +471,8 @@ module Set =
|
|||
/// The reverse of the set is [3; 2; 1]</c>
|
||||
/// </example>
|
||||
[<CompiledName("Fold")>]
|
||||
val fold<'T, 'State> : folder: ('State -> 'T -> 'State) -> state: 'State -> set: Set<'T> -> 'State
|
||||
when 'T: comparison
|
||||
val fold<'T, 'State> :
|
||||
folder: ('State -> 'T -> 'State) -> state: 'State -> set: Set<'T> -> 'State when 'T: comparison
|
||||
|
||||
/// <summary>Applies the given accumulating function to all the elements of the set.</summary>
|
||||
///
|
||||
|
|
@ -492,8 +492,8 @@ module Set =
|
|||
/// The set is [1; 2; 3]</c>
|
||||
/// </example>
|
||||
[<CompiledName("FoldBack")>]
|
||||
val foldBack<'T, 'State> : folder: ('T -> 'State -> 'State) -> set: Set<'T> -> state: 'State -> 'State
|
||||
when 'T: comparison
|
||||
val foldBack<'T, 'State> :
|
||||
folder: ('T -> 'State -> 'State) -> set: Set<'T> -> state: 'State -> 'State when 'T: comparison
|
||||
|
||||
/// <summary>Tests if all elements of the collection satisfy the given predicate.
|
||||
/// If the input function is <c>f</c> and the elements are <c>i0...iN</c> and "j0...jN"
|
||||
|
|
|
|||
|
|
@ -20,13 +20,13 @@ module String =
|
|||
let LOH_CHAR_THRESHOLD = 40_000
|
||||
|
||||
[<CompiledName("Length")>]
|
||||
let length (str:string) =
|
||||
let length (str: string) =
|
||||
if isNull str then 0 else str.Length
|
||||
|
||||
[<CompiledName("Concat")>]
|
||||
let concat sep (strings : seq<string>) =
|
||||
let concat sep (strings: seq<string>) =
|
||||
|
||||
let concatArray sep (strings: string []) =
|
||||
let concatArray sep (strings: string[]) =
|
||||
match length sep with
|
||||
| 0 -> String.Concat strings
|
||||
// following line should be used when this overload becomes part of .NET Standard (it's only in .NET Core)
|
||||
|
|
@ -34,37 +34,34 @@ module String =
|
|||
| _ -> String.Join(sep, strings, 0, strings.Length)
|
||||
|
||||
match strings with
|
||||
| :? (string[]) as arr ->
|
||||
concatArray sep arr
|
||||
| :? (string[]) as arr -> concatArray sep arr
|
||||
|
||||
| :? (string list) as lst ->
|
||||
lst
|
||||
|> List.toArray
|
||||
|> concatArray sep
|
||||
| :? (string list) as lst -> lst |> List.toArray |> concatArray sep
|
||||
|
||||
| _ ->
|
||||
String.Join(sep, strings)
|
||||
| _ -> String.Join(sep, strings)
|
||||
|
||||
[<CompiledName("Iterate")>]
|
||||
let iter (action : (char -> unit)) (str:string) =
|
||||
let iter (action: (char -> unit)) (str: string) =
|
||||
if not (String.IsNullOrEmpty str) then
|
||||
for i = 0 to str.Length - 1 do
|
||||
action str.[i]
|
||||
action str.[i]
|
||||
|
||||
[<CompiledName("IterateIndexed")>]
|
||||
let iteri action (str:string) =
|
||||
let iteri action (str: string) =
|
||||
if not (String.IsNullOrEmpty str) then
|
||||
let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(action)
|
||||
let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt (action)
|
||||
|
||||
for i = 0 to str.Length - 1 do
|
||||
f.Invoke(i, str.[i])
|
||||
f.Invoke(i, str.[i])
|
||||
|
||||
[<CompiledName("Map")>]
|
||||
let map (mapping: char -> char) (str:string) =
|
||||
let map (mapping: char -> char) (str: string) =
|
||||
if String.IsNullOrEmpty str then
|
||||
String.Empty
|
||||
else
|
||||
let result = str.ToCharArray()
|
||||
let mutable i = 0
|
||||
|
||||
for c in result do
|
||||
result.[i] <- mapping c
|
||||
i <- i + 1
|
||||
|
|
@ -72,15 +69,17 @@ module String =
|
|||
new String(result)
|
||||
|
||||
[<CompiledName("MapIndexed")>]
|
||||
let mapi (mapping: int -> char -> char) (str:string) =
|
||||
let mapi (mapping: int -> char -> char) (str: string) =
|
||||
let len = length str
|
||||
if len = 0 then
|
||||
|
||||
if len = 0 then
|
||||
String.Empty
|
||||
else
|
||||
let result = str.ToCharArray()
|
||||
let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(mapping)
|
||||
let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt (mapping)
|
||||
|
||||
let mutable i = 0
|
||||
|
||||
while i < len do
|
||||
result.[i] <- f.Invoke(i, result.[i])
|
||||
i <- i + 1
|
||||
|
|
@ -88,33 +87,39 @@ module String =
|
|||
new String(result)
|
||||
|
||||
[<CompiledName("Filter")>]
|
||||
let filter (predicate: char -> bool) (str:string) =
|
||||
let filter (predicate: char -> bool) (str: string) =
|
||||
let len = length str
|
||||
|
||||
if len = 0 then
|
||||
if len = 0 then
|
||||
String.Empty
|
||||
|
||||
elif len > LOH_CHAR_THRESHOLD then
|
||||
// By using SB here, which is twice slower than the optimized path, we prevent LOH allocations
|
||||
// By using SB here, which is twice slower than the optimized path, we prevent LOH allocations
|
||||
// and 'stop the world' collections if the filtering results in smaller strings.
|
||||
// We also don't pre-allocate SB here, to allow for less mem pressure when filter result is small.
|
||||
let res = StringBuilder()
|
||||
str |> iter (fun c -> if predicate c then res.Append c |> ignore)
|
||||
|
||||
str
|
||||
|> iter (fun c ->
|
||||
if predicate c then
|
||||
res.Append c |> ignore)
|
||||
|
||||
res.ToString()
|
||||
|
||||
else
|
||||
// Must do it this way, since array.fs is not yet in scope, but this is safe
|
||||
let target = Microsoft.FSharp.Primitives.Basics.Array.zeroCreateUnchecked len
|
||||
let mutable i = 0
|
||||
|
||||
for c in str do
|
||||
if predicate c then
|
||||
if predicate c then
|
||||
target.[i] <- c
|
||||
i <- i + 1
|
||||
|
||||
String(target, 0, i)
|
||||
|
||||
[<CompiledName("Collect")>]
|
||||
let collect (mapping: char -> string) (str:string) =
|
||||
let collect (mapping: char -> string) (str: string) =
|
||||
if String.IsNullOrEmpty str then
|
||||
String.Empty
|
||||
else
|
||||
|
|
@ -123,19 +128,25 @@ module String =
|
|||
res.ToString()
|
||||
|
||||
[<CompiledName("Initialize")>]
|
||||
let init (count:int) (initializer: int-> string) =
|
||||
if count < 0 then invalidArgInputMustBeNonNegative "count" count
|
||||
let init (count: int) (initializer: int -> string) =
|
||||
if count < 0 then
|
||||
invalidArgInputMustBeNonNegative "count" count
|
||||
|
||||
let res = StringBuilder count
|
||||
for i = 0 to count - 1 do
|
||||
res.Append(initializer i) |> ignore
|
||||
|
||||
for i = 0 to count - 1 do
|
||||
res.Append(initializer i) |> ignore
|
||||
|
||||
res.ToString()
|
||||
|
||||
[<CompiledName("Replicate")>]
|
||||
let replicate (count:int) (str:string) =
|
||||
if count < 0 then invalidArgInputMustBeNonNegative "count" count
|
||||
let replicate (count: int) (str: string) =
|
||||
if count < 0 then
|
||||
invalidArgInputMustBeNonNegative "count" count
|
||||
|
||||
let len = length str
|
||||
if len = 0 || count = 0 then
|
||||
|
||||
if len = 0 || count = 0 then
|
||||
String.Empty
|
||||
|
||||
elif len = 1 then
|
||||
|
|
@ -150,14 +161,17 @@ module String =
|
|||
|
||||
else
|
||||
// Using the primitive, because array.fs is not yet in scope. It's safe: both len and count are positive.
|
||||
let target = Microsoft.FSharp.Primitives.Basics.Array.zeroCreateUnchecked (len * count)
|
||||
let target =
|
||||
Microsoft.FSharp.Primitives.Basics.Array.zeroCreateUnchecked (len * count)
|
||||
|
||||
let source = str.ToCharArray()
|
||||
|
||||
// O(log(n)) performance loop:
|
||||
// Copy first string, then keep copying what we already copied
|
||||
// Copy first string, then keep copying what we already copied
|
||||
// (i.e., doubling it) until we reach or pass the halfway point
|
||||
Array.Copy(source, 0, target, 0, len)
|
||||
let mutable i = len
|
||||
|
||||
while i * 2 < target.Length do
|
||||
Array.Copy(target, 0, target, i, i)
|
||||
i <- i * 2
|
||||
|
|
@ -167,17 +181,21 @@ module String =
|
|||
new String(target)
|
||||
|
||||
[<CompiledName("ForAll")>]
|
||||
let forall predicate (str:string) =
|
||||
let forall predicate (str: string) =
|
||||
if String.IsNullOrEmpty str then
|
||||
true
|
||||
else
|
||||
let rec check i = (i >= str.Length) || (predicate str.[i] && check (i+1))
|
||||
let rec check i =
|
||||
(i >= str.Length) || (predicate str.[i] && check (i + 1))
|
||||
|
||||
check 0
|
||||
|
||||
[<CompiledName("Exists")>]
|
||||
let exists predicate (str:string) =
|
||||
let exists predicate (str: string) =
|
||||
if String.IsNullOrEmpty str then
|
||||
false
|
||||
else
|
||||
let rec check i = (i < str.Length) && (predicate str.[i] || check (i+1))
|
||||
check 0
|
||||
let rec check i =
|
||||
(i < str.Length) && (predicate str.[i] || check (i + 1))
|
||||
|
||||
check 0
|
||||
|
|
|
|||
|
|
@ -30,10 +30,10 @@ open Microsoft.FSharp.Collections
|
|||
type TaskStateMachineData<'T> =
|
||||
|
||||
[<DefaultValue(false)>]
|
||||
val mutable Result : 'T
|
||||
val mutable Result: 'T
|
||||
|
||||
[<DefaultValue(false)>]
|
||||
val mutable MethodBuilder : AsyncTaskMethodBuilder<'T>
|
||||
val mutable MethodBuilder: AsyncTaskMethodBuilder<'T>
|
||||
|
||||
and TaskStateMachine<'TOverall> = ResumableStateMachine<TaskStateMachineData<'TOverall>>
|
||||
and TaskResumptionFunc<'TOverall> = ResumptionFunc<TaskStateMachineData<'TOverall>>
|
||||
|
|
@ -42,136 +42,177 @@ and TaskCode<'TOverall, 'T> = ResumableCode<TaskStateMachineData<'TOverall>, 'T>
|
|||
|
||||
type TaskBuilderBase() =
|
||||
|
||||
member inline _.Delay(generator : unit -> TaskCode<'TOverall, 'T>) : TaskCode<'TOverall, 'T> =
|
||||
TaskCode<'TOverall, 'T>(fun sm -> (generator()).Invoke(&sm))
|
||||
member inline _.Delay(generator: unit -> TaskCode<'TOverall, 'T>) : TaskCode<'TOverall, 'T> =
|
||||
TaskCode<'TOverall, 'T>(fun sm -> (generator ()).Invoke(&sm))
|
||||
|
||||
/// Used to represent no-ops like the implicit empty "else" branch of an "if" expression.
|
||||
[<DefaultValue>]
|
||||
member inline _.Zero() : TaskCode<'TOverall, unit> = ResumableCode.Zero()
|
||||
member inline _.Zero() : TaskCode<'TOverall, unit> =
|
||||
ResumableCode.Zero()
|
||||
|
||||
member inline _.Return (value: 'T) : TaskCode<'T, 'T> =
|
||||
TaskCode<'T, _>(fun sm ->
|
||||
member inline _.Return(value: 'T) : TaskCode<'T, 'T> =
|
||||
TaskCode<'T, _>(fun sm ->
|
||||
sm.Data.Result <- value
|
||||
true)
|
||||
|
||||
/// Chains together a step with its following step.
|
||||
/// Note that this requires that the first step has no result.
|
||||
/// This prevents constructs like `task { return 1; return 2; }`.
|
||||
member inline _.Combine(task1: TaskCode<'TOverall, unit>, task2: TaskCode<'TOverall, 'T>) : TaskCode<'TOverall, 'T> =
|
||||
member inline _.Combine
|
||||
(
|
||||
task1: TaskCode<'TOverall, unit>,
|
||||
task2: TaskCode<'TOverall, 'T>
|
||||
) : TaskCode<'TOverall, 'T> =
|
||||
ResumableCode.Combine(task1, task2)
|
||||
|
||||
/// Builds a step that executes the body while the condition predicate is true.
|
||||
member inline _.While ([<InlineIfLambda>] condition : unit -> bool, body : TaskCode<'TOverall, unit>) : TaskCode<'TOverall, unit> =
|
||||
member inline _.While
|
||||
(
|
||||
[<InlineIfLambda>] condition: unit -> bool,
|
||||
body: TaskCode<'TOverall, unit>
|
||||
) : TaskCode<'TOverall, unit> =
|
||||
ResumableCode.While(condition, body)
|
||||
|
||||
/// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function
|
||||
/// to retrieve the step, and in the continuation of the step (if any).
|
||||
member inline _.TryWith (body: TaskCode<'TOverall, 'T>, catch: exn -> TaskCode<'TOverall, 'T>) : TaskCode<'TOverall, 'T> =
|
||||
member inline _.TryWith
|
||||
(
|
||||
body: TaskCode<'TOverall, 'T>,
|
||||
catch: exn -> TaskCode<'TOverall, 'T>
|
||||
) : TaskCode<'TOverall, 'T> =
|
||||
ResumableCode.TryWith(body, catch)
|
||||
|
||||
/// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function
|
||||
/// to retrieve the step, and in the continuation of the step (if any).
|
||||
member inline _.TryFinally (body: TaskCode<'TOverall, 'T>, [<InlineIfLambda>] compensation : unit -> unit) : TaskCode<'TOverall, 'T> =
|
||||
ResumableCode.TryFinally(body, ResumableCode<_,_>(fun _sm -> compensation(); true))
|
||||
member inline _.TryFinally
|
||||
(
|
||||
body: TaskCode<'TOverall, 'T>,
|
||||
[<InlineIfLambda>] compensation: unit -> unit
|
||||
) : TaskCode<'TOverall, 'T> =
|
||||
ResumableCode.TryFinally(
|
||||
body,
|
||||
ResumableCode<_, _>(fun _sm ->
|
||||
compensation ()
|
||||
true)
|
||||
)
|
||||
|
||||
member inline _.For (sequence : seq<'T>, body : 'T -> TaskCode<'TOverall, unit>) : TaskCode<'TOverall, unit> =
|
||||
member inline _.For(sequence: seq<'T>, body: 'T -> TaskCode<'TOverall, unit>) : TaskCode<'TOverall, unit> =
|
||||
ResumableCode.For(sequence, body)
|
||||
|
||||
#if NETSTANDARD2_1
|
||||
member inline internal this.TryFinallyAsync(body: TaskCode<'TOverall, 'T>, compensation : unit -> ValueTask) : TaskCode<'TOverall, 'T> =
|
||||
ResumableCode.TryFinallyAsync(body, ResumableCode<_,_>(fun sm ->
|
||||
if __useResumableCode then
|
||||
let mutable __stack_condition_fin = true
|
||||
let __stack_vtask = compensation()
|
||||
if not __stack_vtask.IsCompleted then
|
||||
let mutable awaiter = __stack_vtask.GetAwaiter()
|
||||
let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm)
|
||||
__stack_condition_fin <- __stack_yield_fin
|
||||
member inline internal this.TryFinallyAsync
|
||||
(
|
||||
body: TaskCode<'TOverall, 'T>,
|
||||
compensation: unit -> ValueTask
|
||||
) : TaskCode<'TOverall, 'T> =
|
||||
ResumableCode.TryFinallyAsync(
|
||||
body,
|
||||
ResumableCode<_, _>(fun sm ->
|
||||
if __useResumableCode then
|
||||
let mutable __stack_condition_fin = true
|
||||
let __stack_vtask = compensation ()
|
||||
|
||||
if not __stack_condition_fin then
|
||||
sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm)
|
||||
if not __stack_vtask.IsCompleted then
|
||||
let mutable awaiter = __stack_vtask.GetAwaiter()
|
||||
let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm)
|
||||
__stack_condition_fin <- __stack_yield_fin
|
||||
|
||||
__stack_condition_fin
|
||||
else
|
||||
let vtask = compensation()
|
||||
let mutable awaiter = vtask.GetAwaiter()
|
||||
if not __stack_condition_fin then
|
||||
sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm)
|
||||
|
||||
let cont =
|
||||
TaskResumptionFunc<'TOverall>( fun sm ->
|
||||
awaiter.GetResult() |> ignore
|
||||
true)
|
||||
|
||||
// shortcut to continue immediately
|
||||
if awaiter.IsCompleted then
|
||||
true
|
||||
__stack_condition_fin
|
||||
else
|
||||
sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion)
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- cont
|
||||
false
|
||||
))
|
||||
let vtask = compensation ()
|
||||
let mutable awaiter = vtask.GetAwaiter()
|
||||
|
||||
member inline this.Using<'Resource, 'TOverall, 'T when 'Resource :> IAsyncDisposable> (resource: 'Resource, body: 'Resource -> TaskCode<'TOverall, 'T>) : TaskCode<'TOverall, 'T> =
|
||||
let cont =
|
||||
TaskResumptionFunc<'TOverall>(fun sm ->
|
||||
awaiter.GetResult() |> ignore
|
||||
true)
|
||||
|
||||
// shortcut to continue immediately
|
||||
if awaiter.IsCompleted then
|
||||
true
|
||||
else
|
||||
sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion)
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- cont
|
||||
false)
|
||||
)
|
||||
|
||||
member inline this.Using<'Resource, 'TOverall, 'T when 'Resource :> IAsyncDisposable>
|
||||
(
|
||||
resource: 'Resource,
|
||||
body: 'Resource -> TaskCode<'TOverall, 'T>
|
||||
) : TaskCode<'TOverall, 'T> =
|
||||
this.TryFinallyAsync(
|
||||
(fun sm -> (body resource).Invoke(&sm)),
|
||||
(fun () ->
|
||||
if not (isNull (box resource)) then
|
||||
(fun () ->
|
||||
if not (isNull (box resource)) then
|
||||
resource.DisposeAsync()
|
||||
else
|
||||
ValueTask()))
|
||||
ValueTask())
|
||||
)
|
||||
#endif
|
||||
|
||||
|
||||
type TaskBuilder() =
|
||||
|
||||
inherit TaskBuilderBase()
|
||||
|
||||
// This is the dynamic implementation - this is not used
|
||||
// for statically compiled tasks. An executor (resumptionFuncExecutor) is
|
||||
// for statically compiled tasks. An executor (resumptionFuncExecutor) is
|
||||
// registered with the state machine, plus the initial resumption.
|
||||
// The executor stays constant throughout the execution, it wraps each step
|
||||
// of the execution in a try/with. The resumption is changed at each step
|
||||
// to represent the continuation of the computation.
|
||||
static member RunDynamic(code: TaskCode<'T, 'T>) : Task<'T> =
|
||||
static member RunDynamic(code: TaskCode<'T, 'T>) : Task<'T> =
|
||||
let mutable sm = TaskStateMachine<'T>()
|
||||
let initialResumptionFunc = TaskResumptionFunc<'T>(fun sm -> code.Invoke(&sm))
|
||||
let resumptionInfo =
|
||||
{ new TaskResumptionDynamicInfo<'T>(initialResumptionFunc) with
|
||||
member info.MoveNext(sm) =
|
||||
|
||||
let resumptionInfo =
|
||||
{ new TaskResumptionDynamicInfo<'T>(initialResumptionFunc) with
|
||||
member info.MoveNext(sm) =
|
||||
let mutable savedExn = null
|
||||
|
||||
try
|
||||
sm.ResumptionDynamicInfo.ResumptionData <- null
|
||||
let step = info.ResumptionFunc.Invoke(&sm)
|
||||
if step then
|
||||
let step = info.ResumptionFunc.Invoke(&sm)
|
||||
|
||||
if step then
|
||||
sm.Data.MethodBuilder.SetResult(sm.Data.Result)
|
||||
else
|
||||
let mutable awaiter = sm.ResumptionDynamicInfo.ResumptionData :?> ICriticalNotifyCompletion
|
||||
let mutable awaiter =
|
||||
sm.ResumptionDynamicInfo.ResumptionData :?> ICriticalNotifyCompletion
|
||||
|
||||
assert not (isNull awaiter)
|
||||
sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm)
|
||||
|
||||
with exn ->
|
||||
savedExn <- exn
|
||||
// Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567
|
||||
match savedExn with
|
||||
match savedExn with
|
||||
| null -> ()
|
||||
| exn -> sm.Data.MethodBuilder.SetException exn
|
||||
|
||||
member _.SetStateMachine(sm, state) =
|
||||
sm.Data.MethodBuilder.SetStateMachine(state)
|
||||
}
|
||||
}
|
||||
|
||||
sm.ResumptionDynamicInfo <- resumptionInfo
|
||||
sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create()
|
||||
sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create ()
|
||||
sm.Data.MethodBuilder.Start(&sm)
|
||||
sm.Data.MethodBuilder.Task
|
||||
|
||||
member inline _.Run(code : TaskCode<'T, 'T>) : Task<'T> =
|
||||
if __useResumableCode then
|
||||
member inline _.Run(code: TaskCode<'T, 'T>) : Task<'T> =
|
||||
if __useResumableCode then
|
||||
__stateMachine<TaskStateMachineData<'T>, Task<'T>>
|
||||
(MoveNextMethodImpl<_>(fun sm ->
|
||||
(MoveNextMethodImpl<_>(fun sm ->
|
||||
//-- RESUMABLE CODE START
|
||||
__resumeAt sm.ResumptionPoint
|
||||
let mutable __stack_exn : Exception = null
|
||||
__resumeAt sm.ResumptionPoint
|
||||
let mutable __stack_exn: Exception = null
|
||||
|
||||
try
|
||||
let __stack_code_fin = code.Invoke(&sm)
|
||||
|
||||
if __stack_code_fin then
|
||||
sm.Data.MethodBuilder.SetResult(sm.Data.Result)
|
||||
with exn ->
|
||||
|
|
@ -180,11 +221,11 @@ type TaskBuilder() =
|
|||
match __stack_exn with
|
||||
| null -> ()
|
||||
| exn -> sm.Data.MethodBuilder.SetException exn
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
))
|
||||
(SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine(state)))
|
||||
(AfterCode<_,_>(fun sm ->
|
||||
sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create()
|
||||
(AfterCode<_, _>(fun sm ->
|
||||
sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create ()
|
||||
sm.Data.MethodBuilder.Start(&sm)
|
||||
sm.Data.MethodBuilder.Task))
|
||||
else
|
||||
|
|
@ -194,53 +235,62 @@ type BackgroundTaskBuilder() =
|
|||
|
||||
inherit TaskBuilderBase()
|
||||
|
||||
static member RunDynamic(code: TaskCode<'T, 'T>) : Task<'T> =
|
||||
static member RunDynamic(code: TaskCode<'T, 'T>) : Task<'T> =
|
||||
// backgroundTask { .. } escapes to a background thread where necessary
|
||||
// See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/
|
||||
if isNull SynchronizationContext.Current && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) then
|
||||
if
|
||||
isNull SynchronizationContext.Current
|
||||
&& obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default)
|
||||
then
|
||||
TaskBuilder.RunDynamic(code)
|
||||
else
|
||||
Task.Run<'T>(fun () -> TaskBuilder.RunDynamic(code))
|
||||
|
||||
//// Same as TaskBuilder.Run except the start is inside Task.Run if necessary
|
||||
member inline _.Run(code : TaskCode<'T, 'T>) : Task<'T> =
|
||||
if __useResumableCode then
|
||||
member inline _.Run(code: TaskCode<'T, 'T>) : Task<'T> =
|
||||
if __useResumableCode then
|
||||
__stateMachine<TaskStateMachineData<'T>, Task<'T>>
|
||||
(MoveNextMethodImpl<_>(fun sm ->
|
||||
(MoveNextMethodImpl<_>(fun sm ->
|
||||
//-- RESUMABLE CODE START
|
||||
__resumeAt sm.ResumptionPoint
|
||||
__resumeAt sm.ResumptionPoint
|
||||
|
||||
try
|
||||
let __stack_code_fin = code.Invoke(&sm)
|
||||
|
||||
if __stack_code_fin then
|
||||
sm.Data.MethodBuilder.SetResult(sm.Data.Result)
|
||||
with exn ->
|
||||
sm.Data.MethodBuilder.SetException exn
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
))
|
||||
(SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine(state)))
|
||||
(AfterCode<_,Task<'T>>(fun sm ->
|
||||
(AfterCode<_, Task<'T>>(fun sm ->
|
||||
// backgroundTask { .. } escapes to a background thread where necessary
|
||||
// See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/
|
||||
if isNull SynchronizationContext.Current && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) then
|
||||
sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create()
|
||||
if
|
||||
isNull SynchronizationContext.Current
|
||||
&& obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default)
|
||||
then
|
||||
sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create ()
|
||||
sm.Data.MethodBuilder.Start(&sm)
|
||||
sm.Data.MethodBuilder.Task
|
||||
else
|
||||
let sm = sm // copy contents of state machine so we can capture it
|
||||
Task.Run<'T>(fun () ->
|
||||
|
||||
Task.Run<'T>(fun () ->
|
||||
let mutable sm = sm // host local mutable copy of contents of state machine on this thread pool thread
|
||||
sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create()
|
||||
sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create ()
|
||||
sm.Data.MethodBuilder.Start(&sm)
|
||||
sm.Data.MethodBuilder.Task)))
|
||||
else
|
||||
else
|
||||
BackgroundTaskBuilder.RunDynamic(code)
|
||||
|
||||
module TaskBuilder =
|
||||
module TaskBuilder =
|
||||
|
||||
let task = TaskBuilder()
|
||||
let backgroundTask = BackgroundTaskBuilder()
|
||||
|
||||
namespace Microsoft.FSharp.Control.TaskBuilderExtensions
|
||||
namespace Microsoft.FSharp.Control.TaskBuilderExtensions
|
||||
|
||||
open Microsoft.FSharp.Control
|
||||
open System
|
||||
|
|
@ -251,112 +301,141 @@ open Microsoft.FSharp.Core.CompilerServices
|
|||
open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers
|
||||
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
|
||||
|
||||
module LowPriority =
|
||||
module LowPriority =
|
||||
// Low priority extensions
|
||||
type TaskBuilderBase with
|
||||
|
||||
[<NoEagerConstraintApplication>]
|
||||
static member inline BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter , 'TOverall
|
||||
when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter)
|
||||
and ^Awaiter :> ICriticalNotifyCompletion
|
||||
and ^Awaiter: (member get_IsCompleted: unit -> bool)
|
||||
and ^Awaiter: (member GetResult: unit -> 'TResult1)>
|
||||
(sm: byref<_>, task: ^TaskLike, continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)) : bool =
|
||||
static member inline BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall
|
||||
when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter)
|
||||
and ^Awaiter :> ICriticalNotifyCompletion
|
||||
and ^Awaiter: (member get_IsCompleted: unit -> bool)
|
||||
and ^Awaiter: (member GetResult: unit -> 'TResult1)>
|
||||
(
|
||||
sm: byref<_>,
|
||||
task: ^TaskLike,
|
||||
continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)
|
||||
) : bool =
|
||||
|
||||
let mutable awaiter = (^TaskLike: (member GetAwaiter : unit -> ^Awaiter)(task))
|
||||
let mutable awaiter = (^TaskLike: (member GetAwaiter: unit -> ^Awaiter) (task))
|
||||
|
||||
let cont =
|
||||
(TaskResumptionFunc<'TOverall>( fun sm ->
|
||||
let result = (^Awaiter : (member GetResult : unit -> 'TResult1)(awaiter))
|
||||
(continuation result).Invoke(&sm)))
|
||||
|
||||
// shortcut to continue immediately
|
||||
if (^Awaiter : (member get_IsCompleted : unit -> bool)(awaiter)) then
|
||||
cont.Invoke(&sm)
|
||||
else
|
||||
sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion)
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- cont
|
||||
false
|
||||
|
||||
[<NoEagerConstraintApplication>]
|
||||
member inline _.Bind< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter , 'TOverall
|
||||
when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter)
|
||||
and ^Awaiter :> ICriticalNotifyCompletion
|
||||
and ^Awaiter: (member get_IsCompleted: unit -> bool)
|
||||
and ^Awaiter: (member GetResult: unit -> 'TResult1)>
|
||||
(task: ^TaskLike, continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)) : TaskCode<'TOverall, 'TResult2> =
|
||||
|
||||
TaskCode<'TOverall, _>(fun sm ->
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
// Get an awaiter from the awaitable
|
||||
let mutable awaiter = (^TaskLike: (member GetAwaiter : unit -> ^Awaiter)(task))
|
||||
|
||||
let mutable __stack_fin = true
|
||||
if not (^Awaiter : (member get_IsCompleted : unit -> bool)(awaiter)) then
|
||||
// This will yield with __stack_yield_fin = false
|
||||
// This will resume with __stack_yield_fin = true
|
||||
let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm)
|
||||
__stack_fin <- __stack_yield_fin
|
||||
|
||||
if __stack_fin then
|
||||
let result = (^Awaiter : (member GetResult : unit -> 'TResult1)(awaiter))
|
||||
(continuation result).Invoke(&sm)
|
||||
else
|
||||
sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm)
|
||||
false
|
||||
else
|
||||
TaskBuilderBase.BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter , 'TOverall>(&sm, task, continuation)
|
||||
//-- RESUMABLE CODE END
|
||||
)
|
||||
|
||||
[<NoEagerConstraintApplication>]
|
||||
member inline this.ReturnFrom< ^TaskLike, ^Awaiter, 'T
|
||||
when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter)
|
||||
and ^Awaiter :> ICriticalNotifyCompletion
|
||||
and ^Awaiter: (member get_IsCompleted: unit -> bool)
|
||||
and ^Awaiter: (member GetResult: unit -> 'T)>
|
||||
(task: ^TaskLike) : TaskCode< 'T, 'T> =
|
||||
|
||||
this.Bind(task, (fun v -> this.Return v))
|
||||
|
||||
member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposable> (resource: 'Resource, body: 'Resource -> TaskCode<'TOverall, 'T>) =
|
||||
ResumableCode.Using(resource, body)
|
||||
|
||||
module HighPriority =
|
||||
// High priority extensions
|
||||
type TaskBuilderBase with
|
||||
static member BindDynamic (sm: byref<_>, task: Task<'TResult1>, continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)) : bool =
|
||||
let mutable awaiter = task.GetAwaiter()
|
||||
|
||||
let cont =
|
||||
(TaskResumptionFunc<'TOverall>(fun sm ->
|
||||
let result = awaiter.GetResult()
|
||||
let cont =
|
||||
(TaskResumptionFunc<'TOverall>(fun sm ->
|
||||
let result = (^Awaiter: (member GetResult: unit -> 'TResult1) (awaiter))
|
||||
(continuation result).Invoke(&sm)))
|
||||
|
||||
// shortcut to continue immediately
|
||||
if awaiter.IsCompleted then
|
||||
if (^Awaiter: (member get_IsCompleted: unit -> bool) (awaiter)) then
|
||||
cont.Invoke(&sm)
|
||||
else
|
||||
sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion)
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- cont
|
||||
false
|
||||
|
||||
member inline _.Bind (task: Task<'TResult1>, continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)) : TaskCode<'TOverall, 'TResult2> =
|
||||
[<NoEagerConstraintApplication>]
|
||||
member inline _.Bind< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall
|
||||
when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter)
|
||||
and ^Awaiter :> ICriticalNotifyCompletion
|
||||
and ^Awaiter: (member get_IsCompleted: unit -> bool)
|
||||
and ^Awaiter: (member GetResult: unit -> 'TResult1)>
|
||||
(
|
||||
task: ^TaskLike,
|
||||
continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)
|
||||
) : TaskCode<'TOverall, 'TResult2> =
|
||||
|
||||
TaskCode<'TOverall, _>(fun sm ->
|
||||
if __useResumableCode then
|
||||
TaskCode<'TOverall, _>(fun sm ->
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
// Get an awaiter from the awaitable
|
||||
let mutable awaiter = (^TaskLike: (member GetAwaiter: unit -> ^Awaiter) (task))
|
||||
|
||||
let mutable __stack_fin = true
|
||||
|
||||
if not (^Awaiter: (member get_IsCompleted: unit -> bool) (awaiter)) then
|
||||
// This will yield with __stack_yield_fin = false
|
||||
// This will resume with __stack_yield_fin = true
|
||||
let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm)
|
||||
__stack_fin <- __stack_yield_fin
|
||||
|
||||
if __stack_fin then
|
||||
let result = (^Awaiter: (member GetResult: unit -> 'TResult1) (awaiter))
|
||||
(continuation result).Invoke(&sm)
|
||||
else
|
||||
sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm)
|
||||
false
|
||||
else
|
||||
TaskBuilderBase.BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall>(
|
||||
&sm,
|
||||
task,
|
||||
continuation
|
||||
)
|
||||
//-- RESUMABLE CODE END
|
||||
)
|
||||
|
||||
[<NoEagerConstraintApplication>]
|
||||
member inline this.ReturnFrom< ^TaskLike, ^Awaiter, 'T
|
||||
when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter)
|
||||
and ^Awaiter :> ICriticalNotifyCompletion
|
||||
and ^Awaiter: (member get_IsCompleted: unit -> bool)
|
||||
and ^Awaiter: (member GetResult: unit -> 'T)>
|
||||
(task: ^TaskLike)
|
||||
: TaskCode<'T, 'T> =
|
||||
|
||||
this.Bind(task, (fun v -> this.Return v))
|
||||
|
||||
member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposable>
|
||||
(
|
||||
resource: 'Resource,
|
||||
body: 'Resource -> TaskCode<'TOverall, 'T>
|
||||
) =
|
||||
ResumableCode.Using(resource, body)
|
||||
|
||||
module HighPriority =
|
||||
// High priority extensions
|
||||
type TaskBuilderBase with
|
||||
|
||||
static member BindDynamic
|
||||
(
|
||||
sm: byref<_>,
|
||||
task: Task<'TResult1>,
|
||||
continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)
|
||||
) : bool =
|
||||
let mutable awaiter = task.GetAwaiter()
|
||||
|
||||
let cont =
|
||||
(TaskResumptionFunc<'TOverall>(fun sm ->
|
||||
let result = awaiter.GetResult()
|
||||
(continuation result).Invoke(&sm)))
|
||||
|
||||
// shortcut to continue immediately
|
||||
if awaiter.IsCompleted then
|
||||
cont.Invoke(&sm)
|
||||
else
|
||||
sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion)
|
||||
sm.ResumptionDynamicInfo.ResumptionFunc <- cont
|
||||
false
|
||||
|
||||
member inline _.Bind
|
||||
(
|
||||
task: Task<'TResult1>,
|
||||
continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)
|
||||
) : TaskCode<'TOverall, 'TResult2> =
|
||||
|
||||
TaskCode<'TOverall, _>(fun sm ->
|
||||
if __useResumableCode then
|
||||
//-- RESUMABLE CODE START
|
||||
// Get an awaiter from the task
|
||||
let mutable awaiter = task.GetAwaiter()
|
||||
|
||||
let mutable __stack_fin = true
|
||||
|
||||
if not awaiter.IsCompleted then
|
||||
// This will yield with __stack_yield_fin = false
|
||||
// This will resume with __stack_yield_fin = true
|
||||
let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm)
|
||||
__stack_fin <- __stack_yield_fin
|
||||
if __stack_fin then
|
||||
|
||||
if __stack_fin then
|
||||
let result = awaiter.GetResult()
|
||||
(continuation result).Invoke(&sm)
|
||||
else
|
||||
|
|
@ -364,21 +443,26 @@ module HighPriority =
|
|||
false
|
||||
else
|
||||
TaskBuilderBase.BindDynamic(&sm, task, continuation)
|
||||
//-- RESUMABLE CODE END
|
||||
//-- RESUMABLE CODE END
|
||||
)
|
||||
|
||||
member inline this.ReturnFrom (task: Task<'T>) : TaskCode<'T, 'T> =
|
||||
member inline this.ReturnFrom(task: Task<'T>) : TaskCode<'T, 'T> =
|
||||
this.Bind(task, (fun v -> this.Return v))
|
||||
|
||||
module MediumPriority =
|
||||
module MediumPriority =
|
||||
open HighPriority
|
||||
|
||||
// Medium priority extensions
|
||||
type TaskBuilderBase with
|
||||
member inline this.Bind (computation: Async<'TResult1>, continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)) : TaskCode<'TOverall, 'TResult2> =
|
||||
this.Bind (Async.StartAsTask computation, continuation)
|
||||
|
||||
member inline this.ReturnFrom (computation: Async<'T>) : TaskCode<'T, 'T> =
|
||||
this.ReturnFrom (Async.StartAsTask computation)
|
||||
member inline this.Bind
|
||||
(
|
||||
computation: Async<'TResult1>,
|
||||
continuation: ('TResult1 -> TaskCode<'TOverall, 'TResult2>)
|
||||
) : TaskCode<'TOverall, 'TResult2> =
|
||||
this.Bind(Async.StartAsTask computation, continuation)
|
||||
|
||||
member inline this.ReturnFrom(computation: Async<'T>) : TaskCode<'T, 'T> =
|
||||
this.ReturnFrom(Async.StartAsTask computation)
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -88,8 +88,8 @@ module internal ProjectFile =
|
|||
.ReadAllText(resolutionsFile)
|
||||
.Split([| '\r'; '\n' |], StringSplitOptions.None)
|
||||
|> Array.filter (fun line -> not (String.IsNullOrEmpty(line)))
|
||||
with
|
||||
| _ -> [||]
|
||||
with _ ->
|
||||
[||]
|
||||
|
||||
[|
|
||||
for line in lines do
|
||||
|
|
|
|||
|
|
@ -35,10 +35,7 @@ module internal Utilities =
|
|||
let pos = option.IndexOf('=')
|
||||
|
||||
let stringAsOpt text =
|
||||
if String.IsNullOrEmpty(text) then
|
||||
None
|
||||
else
|
||||
Some text
|
||||
if String.IsNullOrEmpty(text) then None else Some text
|
||||
|
||||
let nameOpt =
|
||||
if pos <= 0 then
|
||||
|
|
@ -48,12 +45,9 @@ module internal Utilities =
|
|||
|
||||
let valueOpt =
|
||||
let valueText =
|
||||
if pos < 0 then
|
||||
option
|
||||
else if pos < option.Length then
|
||||
option.Substring(pos + 1)
|
||||
else
|
||||
""
|
||||
if pos < 0 then option
|
||||
else if pos < option.Length then option.Substring(pos + 1)
|
||||
else ""
|
||||
|
||||
stringAsOpt (valueText.Trim(trimChars))
|
||||
|
||||
|
|
@ -210,6 +204,5 @@ module internal Utilities =
|
|||
// So strip off the flags
|
||||
let pos = source.IndexOf(" ")
|
||||
|
||||
if pos >= 0 then
|
||||
yield ("i", source.Substring(pos).Trim())
|
||||
if pos >= 0 then yield ("i", source.Substring(pos).Trim())
|
||||
}
|
||||
|
|
|
|||
|
|
@ -267,8 +267,8 @@ type FSharpDependencyManager(outputDirectory: string option) =
|
|||
Directory.CreateDirectory(directory) |> ignore
|
||||
|
||||
directory
|
||||
with
|
||||
| _ -> directory
|
||||
with _ ->
|
||||
directory
|
||||
|
||||
let deleteScripts () =
|
||||
try
|
||||
|
|
@ -279,16 +279,16 @@ type FSharpDependencyManager(outputDirectory: string option) =
|
|||
#else
|
||||
()
|
||||
#endif
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
let emitFile fileName (body: string) =
|
||||
try
|
||||
// Create a file to write to
|
||||
use sw = File.CreateText(fileName)
|
||||
sw.WriteLine(body)
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
let prepareDependencyResolutionFiles
|
||||
(
|
||||
|
|
|
|||
|
|
@ -81,8 +81,8 @@ let main (argv) =
|
|||
member _.Exit(n) =
|
||||
try
|
||||
exit n
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
failwithf "%s" (FSComp.SR.elSysEnvExitDidntExit ())
|
||||
}
|
||||
|
|
@ -116,8 +116,7 @@ let main (argv) =
|
|||
|
||||
0
|
||||
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
// Last-chance error recovery (note, with a poor error range)
|
||||
errorRecovery e Range.range0
|
||||
1
|
||||
|
|
|
|||
|
|
@ -76,8 +76,7 @@ module internal Utils =
|
|||
let guard (f) =
|
||||
try
|
||||
f ()
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
warning (
|
||||
Failure(
|
||||
sprintf
|
||||
|
|
@ -197,8 +196,8 @@ type internal ReadLineConsole() =
|
|||
|> Seq.iter (fun option -> optionsCache.Add(option))
|
||||
|
||||
optionsCache.Root <- root
|
||||
with
|
||||
| _ -> optionsCache.Clear()
|
||||
with _ ->
|
||||
optionsCache.Clear()
|
||||
|
||||
optionsCache, true
|
||||
else
|
||||
|
|
@ -210,10 +209,7 @@ type internal ReadLineConsole() =
|
|||
| _ -> "^?"
|
||||
|
||||
member x.GetCharacterSize(c) =
|
||||
if Char.IsControl(c) then
|
||||
x.MapCharacter(c).Length
|
||||
else
|
||||
1
|
||||
if Char.IsControl(c) then x.MapCharacter(c).Length else 1
|
||||
|
||||
static member TabSize = 4
|
||||
|
||||
|
|
@ -224,12 +220,7 @@ type internal ReadLineConsole() =
|
|||
|
||||
if currLeft < x.Inset then
|
||||
if currLeft = 0 then
|
||||
Console.Write(
|
||||
if prompt then
|
||||
x.Prompt2
|
||||
else
|
||||
String(' ', x.Inset)
|
||||
)
|
||||
Console.Write(if prompt then x.Prompt2 else String(' ', x.Inset))
|
||||
|
||||
Utils.guard (fun () ->
|
||||
Console.CursorTop <- min Console.CursorTop (Console.BufferHeight - 1)
|
||||
|
|
@ -287,8 +278,7 @@ type internal ReadLineConsole() =
|
|||
let mutable position = -1
|
||||
|
||||
for i = 0 to input.Length - 1 do
|
||||
if (i = curr) then
|
||||
position <- output.Length
|
||||
if (i = curr) then position <- output.Length
|
||||
|
||||
let c = input.Chars(i)
|
||||
|
||||
|
|
@ -297,8 +287,7 @@ type internal ReadLineConsole() =
|
|||
else
|
||||
output.Append(c) |> ignore
|
||||
|
||||
if (curr = input.Length) then
|
||||
position <- output.Length
|
||||
if (curr = input.Length) then position <- output.Length
|
||||
|
||||
// render the current text, computing a new value for "rendered"
|
||||
let old_rendered = rendered
|
||||
|
|
@ -377,11 +366,7 @@ type internal ReadLineConsole() =
|
|||
optionsCache <- opts
|
||||
|
||||
if (opts.Count > 0) then
|
||||
let part =
|
||||
if shift then
|
||||
opts.Previous()
|
||||
else
|
||||
opts.Next()
|
||||
let part = if shift then opts.Previous() else opts.Next()
|
||||
|
||||
setInput (opts.Root + part)
|
||||
else if (prefix) then
|
||||
|
|
@ -417,11 +402,7 @@ type internal ReadLineConsole() =
|
|||
// REVIEW: is this F6 rewrite required? 0x1A looks like Ctrl-Z.
|
||||
// REVIEW: the Ctrl-Z code is not recognised as EOF by the lexer.
|
||||
// REVIEW: looks like a relic of the port of readline, which is currently removable.
|
||||
let c =
|
||||
if (key.Key = ConsoleKey.F6) then
|
||||
'\x1A'
|
||||
else
|
||||
key.KeyChar
|
||||
let c = if (key.Key = ConsoleKey.F6) then '\x1A' else key.KeyChar
|
||||
|
||||
insertChar (c)
|
||||
|
||||
|
|
@ -438,8 +419,7 @@ type internal ReadLineConsole() =
|
|||
if (line = "\x1A") then
|
||||
null
|
||||
else
|
||||
if (line.Length > 0) then
|
||||
history.AddLast(line)
|
||||
if (line.Length > 0) then history.AddLast(line)
|
||||
|
||||
line
|
||||
|
||||
|
|
|
|||
|
|
@ -139,8 +139,7 @@ let internal TrySetUnhandledExceptionMode () =
|
|||
|
||||
try
|
||||
Application.SetUnhandledExceptionMode(UnhandledExceptionMode.CatchException)
|
||||
with
|
||||
| _ ->
|
||||
with _ ->
|
||||
decr i
|
||||
()
|
||||
|
||||
|
|
@ -155,8 +154,7 @@ let StartServer (fsiSession: FsiEvaluationSession) (fsiServerName) =
|
|||
//printf "FSI-SERVER: received CTRL-C request...\n"
|
||||
try
|
||||
fsiSession.Interrupt()
|
||||
with
|
||||
| _ ->
|
||||
with _ ->
|
||||
// Final sanity check! - catch all exns - but not expected
|
||||
assert false
|
||||
()
|
||||
|
|
@ -200,8 +198,7 @@ let evaluateSession (argv: string[]) =
|
|||
let _ = Console.ForegroundColor
|
||||
let _ = Console.CursorLeft <- Console.CursorLeft
|
||||
true
|
||||
with
|
||||
| _ ->
|
||||
with _ ->
|
||||
//if progress then fprintfn outWriter "probe failed, we have no console..."
|
||||
false
|
||||
else
|
||||
|
|
@ -248,8 +245,7 @@ let evaluateSession (argv: string[]) =
|
|||
lazy
|
||||
try
|
||||
Some(WinFormsEventLoop())
|
||||
with
|
||||
| e ->
|
||||
with e ->
|
||||
printfn "Your system doesn't seem to support WinForms correctly. You will"
|
||||
printfn "need to set fsi.EventLoop use GUI windows from F# Interactive."
|
||||
printfn "You can set different event loops for MonoMac, Gtk#, WinForms and other"
|
||||
|
|
@ -282,11 +278,7 @@ let evaluateSession (argv: string[]) =
|
|||
|
||||
member _.EventLoopRun() =
|
||||
#if !FX_NO_WINFORMS
|
||||
match (if fsiSession.IsGui then
|
||||
fsiWinFormsLoop.Value
|
||||
else
|
||||
None)
|
||||
with
|
||||
match (if fsiSession.IsGui then fsiWinFormsLoop.Value else None) with
|
||||
| Some l -> (l :> IEventLoop).Run()
|
||||
| _ ->
|
||||
#endif
|
||||
|
|
@ -294,11 +286,7 @@ let evaluateSession (argv: string[]) =
|
|||
|
||||
member _.EventLoopInvoke(f) =
|
||||
#if !FX_NO_WINFORMS
|
||||
match (if fsiSession.IsGui then
|
||||
fsiWinFormsLoop.Value
|
||||
else
|
||||
None)
|
||||
with
|
||||
match (if fsiSession.IsGui then fsiWinFormsLoop.Value else None) with
|
||||
| Some l -> (l :> IEventLoop).Invoke(f)
|
||||
| _ ->
|
||||
#endif
|
||||
|
|
@ -306,11 +294,7 @@ let evaluateSession (argv: string[]) =
|
|||
|
||||
member _.EventLoopScheduleRestart() =
|
||||
#if !FX_NO_WINFORMS
|
||||
match (if fsiSession.IsGui then
|
||||
fsiWinFormsLoop.Value
|
||||
else
|
||||
None)
|
||||
with
|
||||
match (if fsiSession.IsGui then fsiWinFormsLoop.Value else None) with
|
||||
| Some l -> (l :> IEventLoop).ScheduleRestart()
|
||||
| _ ->
|
||||
#endif
|
||||
|
|
@ -341,8 +325,8 @@ let evaluateSession (argv: string[]) =
|
|||
if fsiSession.IsGui then
|
||||
try
|
||||
Application.EnableVisualStyles()
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
// Route GUI application exceptions to the exception handlers
|
||||
Application.add_ThreadException (
|
||||
|
|
@ -352,14 +336,14 @@ let evaluateSession (argv: string[]) =
|
|||
let runningOnMono =
|
||||
try
|
||||
System.Type.GetType("Mono.Runtime") <> null
|
||||
with
|
||||
| e -> false
|
||||
with e ->
|
||||
false
|
||||
|
||||
if not runningOnMono then
|
||||
try
|
||||
TrySetUnhandledExceptionMode()
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
|
||||
fsiWinFormsLoop.Value |> Option.iter (fun l -> l.LCID <- fsiSession.LCID)
|
||||
#endif
|
||||
|
|
@ -400,8 +384,8 @@ let MainMain argv =
|
|||
member _.Dispose() =
|
||||
try
|
||||
Console.SetOut(savedOut)
|
||||
with
|
||||
| _ -> ()
|
||||
with _ ->
|
||||
()
|
||||
}
|
||||
|
||||
#if !FX_NO_APP_DOMAINS
|
||||
|
|
|
|||
Загрузка…
Ссылка в новой задаче