diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 49fb969ada9..0dd72130c0c 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -2,8 +2,8 @@ "version": 1, "isRoot": true, "tools": { - "fantomas-tool": { - "version": "4.7.5", + "fantomas": { + "version": "5.0.0-alpha-006", "commands": [ "fantomas" ] diff --git a/.editorconfig b/.editorconfig index f575c5df2ad..594dcb0ebde 100644 --- a/.editorconfig +++ b/.editorconfig @@ -2,6 +2,13 @@ root = true [*.fs] fsharp_newline_between_type_definition_and_members=true +fsharp_max_infix_operator_expression=80 +fsharp_max_array_or_list_width=80 +fsharp_max_array_or_list_number_of_items=5 +fsharp_max_dot_get_expression_width=80 +fsharp_multiline_block_brackets_on_same_column=true +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 diff --git a/.fantomasignore b/.fantomasignore index e723248b137..ae062afa069 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -1,33 +1,56 @@ -**/*.fs -**/*.fsx - -# absil (to investigate) -**/ilread.fsi - -# fsharp (to investigate) -**/range.fsi - -# utils (to investigate) -**/prim-parsing.fsi -**/TaggedCollections.fsi - -# https://github.com/fsprojects/fantomas/issues/1974 -**/ParseHalpers.fsi - -# service (to investigate) -**/ServiceDeclarationLists.fsi - -# FSharp.Core (to investigate) -**/fslib-extra-pervasives.fsi -**/Nullable.fsi -**/prim-types-prelude.fsi -**/prim-types.fsi -**/list.fsi -**/Query.fsi -**/resumable.fsi -**/async.fsi - -## https://github.com/fsprojects/fantomas/issues/2230 -**/array.fsi -**/tasks.fsi -**/seq.fsi \ No newline at end of file +# Explicitly unformatted directories + +buildtools/ +docs/ +eng/ +fcs-samples/ +scripts/ +service/ +setup/ +tests/ +vsintegration/ + +# Explicitly unformatted implementation files + +src/FSharp.Core/**/*.fs +src/Compiler/**/*.fs +src/Compiler/AbstractIL/**/*.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 +src/Compiler/Optimize/**/*.fs +src/Compiler/Service/**/*.fs +src/Compiler/Symbols/**/*.fs +src/Compiler/SyntaxTree/**/*.fs +src/Compiler/TypedTree/**/*.fs +src/Compiler/Utilities/**/*.fs +src/Microsoft.FSharp.Compiler/**/*.fs + +# Fantomas limitations on signature files (to investigate) + +src/Compiler/AbstractIL/ilread.fsi +src/Compiler/Utilities/range.fsi +src/Compiler/Facilities/prim-parsing.fsi +src/Compiler/Utilities/TaggedCollections.fsi +src/Compiler/Service/ServiceDeclarationLists.fsi + +# Fantomas limitations on signature files in FSharp.Core (to investigate) + +src/FSharp.Core/fslib-extra-pervasives.fsi +src/FSharp.Core/Nullable.fsi +src/FSharp.Core/prim-types-prelude.fsi +src/FSharp.Core/prim-types.fsi +src/FSharp.Core/list.fsi +src/FSharp.Core/Query.fsi +src/FSharp.Core/resumable.fsi +src/FSharp.Core/async.fsi + +# Fantomas limitations on signature files in FSharp.Core (https://github.com/fsprojects/fantomas/issues/2230) + +src/FSharp.Core/array.fsi +src/FSharp.Core/tasks.fsi +src/FSharp.Core/seq.fsi diff --git a/.vscode/launch.json b/.vscode/launch.json index 6e419cca327..652948c7999 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -11,51 +11,51 @@ ], "configurations": [ { - "name": "Launch FSI (Debug, .NET 5.0)", + "name": "Launch FSI (Debug, .NET 6.0)", "type": "coreclr", "request": "launch", // TODO: Shall we assume that it's already been built, or build it every time we debug? // "preLaunchTask": "Build (Debug)", // If you have changed target frameworks, make sure to update the program path. - "program": "${workspaceFolder}/artifacts/bin/fsi/Debug/net5.0/fsi.dll", + "program": "${workspaceFolder}/artifacts/bin/fsi/Debug/net6.0/fsi.dll", "cwd": "${workspaceFolder}/src", - "console": "integratedTerminal", + "console": "integratedTerminal", // This is the default to be able to run in Codespaces. "stopAtEntry": false, "justMyCode": false, - "enableStepFiltering": false, + "enableStepFiltering": true, "symbolOptions": { "searchMicrosoftSymbolServer": true, "searchNuGetOrgSymbolServer": true }, "sourceLinkOptions": { "*": { - "enabled": false + "enabled": true } }, }, { - "name": "Launch FSC (Debug, .NET 5.0)", + "name": "Launch FSC (Debug, .NET 6.0)", "type": "coreclr", "request": "launch", // TODO: Shall we assume that it's already been built, or build it every time we debug? // "preLaunchTask": "Build (Debug)", // If you have changed target frameworks, make sure to update the program path. - "program": "${workspaceFolder}/artifacts/bin/fsc/Debug/net5.0/fsc.dll", + "program": "${workspaceFolder}/artifacts/bin/fsc/Debug/net6.0/fsc.dll", "args": [ "${input:argsPrompt}" ], "cwd": "${workspaceFolder}", - "console": "integratedTerminal", + "console": "integratedTerminal", // This is the default to be able to run in Codespaces. "stopAtEntry": false, "justMyCode": false, - "enableStepFiltering": false, + "enableStepFiltering": true, "symbolOptions": { "searchMicrosoftSymbolServer": true, "searchNuGetOrgSymbolServer": true }, "sourceLinkOptions": { "*": { - "enabled": false + "enabled": true } }, }, diff --git a/.vscode/settings.json b/.vscode/settings.json index c3d00d8284e..12aeedba022 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -10,10 +10,16 @@ "*.vsixmanifest": "xml", "*.vstemplate": "xml", }, + "explorer.fileNesting.enabled": true, + "explorer.fileNesting.expand": false, + "explorer.fileNesting.patterns": { + "*.fs": "${capture}.fsi" + }, "FSharp.suggestGitignore": false, "FSharp.enableMSBuildProjectGraph": true, - "FSharp.workspacePath": "FSharp.sln", - "FSharp.workspaceModePeekDeepLevel": 1, + "FSharp.workspacePath": "service/FSharp.Compiler.Service.sln", + "FSharp.workspaceModePeekDeepLevel": 2, + "FSharp.enableBackgroundServices": false, "FSharp.excludeProjectDirectories": [ ".git", "eng", @@ -28,9 +34,13 @@ "csharp.suppressDotnetInstallWarning": true, "csharp.suppressDotnetRestoreNotification": true, "csharp.suppressHiddenDiagnostics": true, - "omnisharp.autoStart": true, + "omnisharp.autoStart": false, + "omnisharp.defaultLaunchSolution": "service/FSharp.Compiler.Service.sln", "omnisharp.enableMsBuildLoadProjectsOnDemand": true, "omnisharp.disableMSBuildDiagnosticWarning": true, + "omnisharp.enableRoslynAnalyzers": false, + "omnisharp.analyzeOpenDocumentsOnly": true, + "omnisharp.useModernNet": true, "razor.disabled": true, "powershell.promptToUpdatePowerShell": false, "powershell.integratedConsole.showOnStartup": false, diff --git a/release-notes.md b/release-notes.md index 4ff32eb62ae..3919cdf5641 100644 --- a/release-notes.md +++ b/release-notes.md @@ -27,6 +27,13 @@ These release notes track our current efforts to document changes to the F# proj is always implicit for this construct. * In FCS API, FSharpParsingOptions, `CompilingFsLib` --> `CompilingFSharpCore` * In FCS API, FSharpParsingOptions, `ErrorSeverityOptions` --> `DiagnosticOptions` +* [SynIdent](https://fsharp.github.io/fsharp-compiler-docs/reference/fsharp-compiler-syntax-synident.html#SynIdent) was introduced in the Untyped Syntax Tree. + This represent an `Ident` with potential additional information, stored as [IdentTrivia](https://fsharp.github.io/fsharp-compiler-docs/reference/fsharp-compiler-syntaxtrivia-identtrivia.html)). +* `LongIdentWithDots` was renamed to [SynLongIdent](https://fsharp.github.io/fsharp-compiler-docs/reference/fsharp-compiler-syntax-synlongident.html) and also could contain `IdentTrivia`. + Due to this change, infix operators are stored as `SynExpr.LongIdent` instead of `SynExpr.Ident`. + `a + b` is parsed as `SynLongIdent([op_Addition], [], [Some (OriginalNotation "+")])`. +* `SynMeasure` was extended with [SynMeasure.Paren](https://fsharp.github.io/fsharp-compiler-docs/reference/fsharp-compiler-syntax-synmeasure.html#Paren) case. +* Dynamic expressions (like `x?y`) are now represented as [SynExpr.Dynamic](https://fsharp.github.io/fsharp-compiler-docs/reference/fsharp-compiler-syntax-synexpr.html#Dynamic) in the Untyped Syntax Tree. ### F# 6.0 / Visual Studio 17.0 diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index c3d784a77e5..d205162b991 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -17,7 +17,7 @@ type internal PrimaryAssembly = member Name: string /// Represents guids -type ILGuid = byte [] +type ILGuid = byte[] [] type ILPlatform = @@ -49,14 +49,14 @@ type internal ILDebugPoint = [] type PublicKey = - | PublicKey of byte [] - | PublicKeyToken of byte [] + | PublicKey of byte[] + | PublicKeyToken of byte[] member IsKey: bool member IsKeyToken: bool - member Key: byte [] - member KeyToken: byte [] - static member KeyAsToken: byte [] -> PublicKey + member Key: byte[] + member KeyToken: byte[] + static member KeyAsToken: byte[] -> PublicKey [] type ILVersionInfo = @@ -72,7 +72,7 @@ type ILVersionInfo = type ILAssemblyRef = static member Create: name: string * - hash: byte [] option * + hash: byte[] option * publicKey: PublicKey option * retargetable: bool * version: ILVersionInfo option * @@ -86,7 +86,7 @@ type ILAssemblyRef = /// The fully qualified name of the assembly reference, e.g. mscorlib, Version=1.0.3705 etc. member QualifiedName: string - member Hash: byte [] option + member Hash: byte[] option member PublicKey: PublicKey option @@ -103,13 +103,13 @@ type ILAssemblyRef = [] type ILModuleRef = - static member Create: name: string * hasMetadata: bool * hash: byte [] option -> ILModuleRef + static member Create: name: string * hasMetadata: bool * hash: byte[] option -> ILModuleRef member Name: string member HasMetadata: bool - member Hash: byte [] option + member Hash: byte[] option interface System.IComparable @@ -630,7 +630,7 @@ type internal ILLocalDebugInfo = [] type internal ILCode = { Labels: Dictionary - Instrs: ILInstr [] + Instrs: ILInstr[] Exceptions: ILExceptionSpec list Locals: ILLocalDebugInfo list } @@ -707,7 +707,7 @@ type internal ILNativeVariant = [] type ILNativeType = | Empty - | Custom of ILGuid * nativeTypeName: string * custMarshallerName: string * cookieString: byte [] + | Custom of ILGuid * nativeTypeName: string * custMarshallerName: string * cookieString: byte[] | FixedSysString of int32 | FixedArray of int32 | Currency @@ -776,23 +776,25 @@ type ILDebugImport = /// Emitted to the PortablePDB format. type ILDebugImports = { Parent: ILDebugImports option - Imports: ILDebugImport [] } + Imports: ILDebugImport[] } /// IL method bodies [] type internal ILMethodBody = - { IsZeroInit: bool - MaxStack: int32 - NoInlining: bool - AggressiveInlining: bool - Locals: ILLocals - Code: ILCode + { + IsZeroInit: bool + MaxStack: int32 + NoInlining: bool + AggressiveInlining: bool + Locals: ILLocals + Code: ILCode - /// Indicates the entire range of the method. Emitted for full PDB but not currently for portable PDB. - /// Additionally, if the range is not set, then no debug points are emitted. - DebugRange: ILDebugPoint option + /// Indicates the entire range of the method. Emitted for full PDB but not currently for portable PDB. + /// Additionally, if the range is not set, then no debug points are emitted. + DebugRange: ILDebugPoint option - DebugImports: ILDebugImports option } + DebugImports: ILDebugImports option + } /// Member Access [] @@ -838,7 +840,7 @@ type ILAttributeNamedArg = string * ILType * bool * ILAttribElem type ILAttribute = /// Attribute with args encoded to a binary blob according to ECMA-335 II.21 and II.23.3. /// 'decodeILAttribData' is used to parse the byte[] blob to ILAttribElem's as best as possible. - | Encoded of method: ILMethodSpec * data: byte [] * elements: ILAttribElem list + | Encoded of method: ILMethodSpec * data: byte[] * elements: ILAttribElem list /// Attribute with args in decoded form. | Decoded of method: ILMethodSpec * fixedArgs: ILAttribElem list * namedArgs: ILAttributeNamedArg list @@ -853,7 +855,7 @@ type ILAttribute = [] type ILAttributes = - member AsArray: unit -> ILAttribute [] + member AsArray: unit -> ILAttribute[] member AsList: unit -> ILAttribute list @@ -864,16 +866,18 @@ type ILAttributesStored /// Method parameters and return values. [] type ILParameter = - { Name: string option - Type: ILType - Default: ILFieldInit option - /// Marshalling map for parameters. COM Interop only. - Marshal: ILNativeType option - IsIn: bool - IsOut: bool - IsOptional: bool - CustomAttrsStored: ILAttributesStored - MetadataIndex: int32 } + { + Name: string option + Type: ILType + Default: ILFieldInit option + /// Marshalling map for parameters. COM Interop only. + Marshal: ILNativeType option + IsIn: bool + IsOut: bool + IsOptional: bool + CustomAttrsStored: ILAttributesStored + MetadataIndex: int32 + } member CustomAttrs: ILAttributes @@ -914,7 +918,7 @@ type internal ILSecurityAction = | InheritanceDemandChoice | DemandChoice -type internal ILSecurityDecl = ILSecurityDecl of ILSecurityAction * byte [] +type internal ILSecurityDecl = ILSecurityDecl of ILSecurityAction * byte[] /// Abstract type equivalent to ILSecurityDecl list - use helpers /// below to construct/destruct these. @@ -983,28 +987,30 @@ type MethodBody = /// Generic parameters. Formal generic parameter declarations may include the bounds, if any, on the generic parameter. type ILGenericParameterDef = - { Name: string + { + Name: string - /// At most one is the parent type, the others are interface types. - Constraints: ILTypes + /// At most one is the parent type, the others are interface types. + Constraints: ILTypes - /// Variance of type parameters, only applicable to generic parameters for generic interfaces and delegates. - Variance: ILGenericVariance + /// Variance of type parameters, only applicable to generic parameters for generic interfaces and delegates. + Variance: ILGenericVariance - /// Indicates the type argument must be a reference type. - HasReferenceTypeConstraint: bool + /// Indicates the type argument must be a reference type. + HasReferenceTypeConstraint: bool - /// Indicates the type argument must be a value type, but not Nullable. - HasNotNullableValueTypeConstraint: bool + /// Indicates the type argument must be a value type, but not Nullable. + HasNotNullableValueTypeConstraint: bool - /// Indicates the type argument must have a public nullary constructor. - HasDefaultConstructorConstraint: bool + /// Indicates the type argument must have a public nullary constructor. + HasDefaultConstructorConstraint: bool - /// Do not use this - CustomAttrsStored: ILAttributesStored + /// Do not use this + CustomAttrsStored: ILAttributesStored - /// Do not use this - MetadataIndex: int32 } + /// Do not use this + MetadataIndex: int32 + } member CustomAttrs: ILAttributes @@ -1140,7 +1146,7 @@ type ILMethodDef = [] type ILMethodDefs = interface IEnumerable - member AsArray: unit -> ILMethodDef [] + member AsArray: unit -> ILMethodDef[] member AsList: unit -> ILMethodDef list member FindByName: string -> ILMethodDef list member TryFindInstanceByNameAndCallingSignature: string * ILCallingSignature -> ILMethodDef option @@ -1154,7 +1160,7 @@ type ILFieldDef = name: string * fieldType: ILType * attributes: FieldAttributes * - data: byte [] option * + data: byte[] option * literalValue: ILFieldInit option * offset: int32 option * marshal: ILNativeType option * @@ -1167,7 +1173,7 @@ type ILFieldDef = name: string * fieldType: ILType * attributes: FieldAttributes * - data: byte [] option * + data: byte[] option * literalValue: ILFieldInit option * offset: int32 option * marshal: ILNativeType option * @@ -1177,7 +1183,7 @@ type ILFieldDef = member Name: string member FieldType: ILType member Attributes: FieldAttributes - member Data: byte [] option + member Data: byte[] option member LiteralValue: ILFieldInit option /// The explicit offset in bytes when explicit layout is used. @@ -1196,7 +1202,7 @@ type ILFieldDef = ?name: string * ?fieldType: ILType * ?attributes: FieldAttributes * - ?data: byte [] option * + ?data: byte[] option * ?literalValue: ILFieldInit option * ?offset: int32 option * ?marshal: ILNativeType option * @@ -1396,12 +1402,12 @@ type ILTypeDefKind = type ILTypeDefs = interface IEnumerable - member internal AsArray: unit -> ILTypeDef [] + member internal AsArray: unit -> ILTypeDef[] member internal AsList: unit -> ILTypeDef list /// Get some information about the type defs, but do not force the read of the type defs themselves. - member internal AsArrayOfPreTypeDefs: unit -> ILPreTypeDef [] + member internal AsArrayOfPreTypeDefs: unit -> ILPreTypeDef[] /// Calls to FindByName will result in any laziness in the overall /// set of ILTypeDefs being read in in addition @@ -1529,7 +1535,6 @@ type ILPreTypeDef = /// Realise the actual full typedef abstract GetTypeDef: unit -> ILTypeDef - [] type internal ILPreTypeDefImpl = interface ILPreTypeDef @@ -1583,13 +1588,15 @@ type ILNestedExportedType = /// these are only found in the ILExportedTypesAndForwarders table in the manifest [] type ILExportedTypeOrForwarder = - { ScopeRef: ILScopeRef - /// [Namespace.]Name - Name: string - Attributes: TypeAttributes - Nested: ILNestedExportedTypes - CustomAttrsStored: ILAttributesStored - MetadataIndex: int32 } + { + ScopeRef: ILScopeRef + /// [Namespace.]Name + Name: string + Attributes: TypeAttributes + Nested: ILNestedExportedTypes + CustomAttrsStored: ILAttributesStored + MetadataIndex: int32 + } member Access: ILTypeDefAccess @@ -1655,52 +1662,53 @@ type ILAssemblyLongevity = /// The main module of an assembly is a module plus some manifest information. type ILAssemblyManifest = - { Name: string - /// This is the ID of the algorithm used for the hashes of auxiliary - /// files in the assembly. These hashes are stored in the - /// ILModuleRef.Hash fields of this assembly. These are not - /// cryptographic hashes: they are simple file hashes. The algorithm - /// is normally 0x00008004 indicating the SHA1 hash algorithm. - AuxModuleHashAlgorithm: int32 + { + Name: string + /// This is the ID of the algorithm used for the hashes of auxiliary + /// files in the assembly. These hashes are stored in the + /// ILModuleRef.Hash fields of this assembly. These are not + /// cryptographic hashes: they are simple file hashes. The algorithm + /// is normally 0x00008004 indicating the SHA1 hash algorithm. + AuxModuleHashAlgorithm: int32 - SecurityDeclsStored: ILSecurityDeclsStored + SecurityDeclsStored: ILSecurityDeclsStored - /// This is the public key used to sign this - /// assembly (the signature itself is stored elsewhere: see the - /// binary format, and may not have been written if delay signing - /// is used). (member Name, member PublicKey) forms the full - /// public name of the assembly. - PublicKey: byte [] option + /// This is the public key used to sign this + /// assembly (the signature itself is stored elsewhere: see the + /// binary format, and may not have been written if delay signing + /// is used). (member Name, member PublicKey) forms the full + /// public name of the assembly. + PublicKey: byte[] option - Version: ILVersionInfo option + Version: ILVersionInfo option - Locale: string option + Locale: string option - CustomAttrsStored: ILAttributesStored + CustomAttrsStored: ILAttributesStored - AssemblyLongevity: ILAssemblyLongevity + AssemblyLongevity: ILAssemblyLongevity - DisableJitOptimizations: bool + DisableJitOptimizations: bool - JitTracking: bool + JitTracking: bool - IgnoreSymbolStoreSequencePoints: bool + IgnoreSymbolStoreSequencePoints: bool - Retargetable: bool + Retargetable: bool - /// Records the types implemented by this assembly in auxiliary - /// modules. - ExportedTypes: ILExportedTypesAndForwarders + /// Records the types implemented by this assembly in auxiliary + /// modules. + ExportedTypes: ILExportedTypesAndForwarders - /// Records whether the entrypoint resides in another module. - EntrypointElsewhere: ILModuleRef option + /// Records whether the entrypoint resides in another module. + EntrypointElsewhere: ILModuleRef option - MetadataIndex: int32 } + MetadataIndex: int32 + } member CustomAttrs: ILAttributes member SecurityDecls: ILSecurityDecls - [] type ILNativeResource = internal @@ -1708,7 +1716,7 @@ type ILNativeResource = | In of fileName: string * linkedResourceBase: int * linkedResourceStart: int * linkedResourceLength: int /// Represents a native resource to be written in an output file - | Out of unlinkedResource: byte [] + | Out of unlinkedResource: byte[] /// One module in the "current" assembly, either a main-module or /// an auxiliary module. The main module will have a manifest. @@ -1716,28 +1724,30 @@ type ILNativeResource = /// An assembly is built by joining together a "main" module plus /// several auxiliary modules. type ILModuleDef = - { Manifest: ILAssemblyManifest option - Name: string - TypeDefs: ILTypeDefs - SubsystemVersion: int * int - UseHighEntropyVA: bool - SubSystemFlags: int32 - IsDLL: bool - IsILOnly: bool - Platform: ILPlatform option - StackReserveSize: int32 option - Is32Bit: bool - Is32BitPreferred: bool - Is64Bit: bool - VirtualAlignment: int32 - PhysicalAlignment: int32 - ImageBase: int32 - MetadataVersion: string - Resources: ILResources - /// e.g. win86 resources, as the exact contents of a .res or .obj file. Must be unlinked manually. - NativeResources: ILNativeResource list - CustomAttrsStored: ILAttributesStored - MetadataIndex: int32 } + { + Manifest: ILAssemblyManifest option + Name: string + TypeDefs: ILTypeDefs + SubsystemVersion: int * int + UseHighEntropyVA: bool + SubSystemFlags: int32 + IsDLL: bool + IsILOnly: bool + Platform: ILPlatform option + StackReserveSize: int32 option + Is32Bit: bool + Is32BitPreferred: bool + Is64Bit: bool + VirtualAlignment: int32 + PhysicalAlignment: int32 + ImageBase: int32 + MetadataVersion: string + Resources: ILResources + /// e.g. win86 resources, as the exact contents of a .res or .obj file. Must be unlinked manually. + NativeResources: ILNativeResource list + CustomAttrsStored: ILAttributesStored + MetadataIndex: int32 + } member ManifestOfAssembly: ILAssemblyManifest @@ -1766,7 +1776,7 @@ val internal resolveILMethodRefWithRescope: (ILType -> ILType) -> ILTypeDef -> I val internal splitNamespace: string -> string list -val internal splitNamespaceToArray: string -> string [] +val internal splitNamespaceToArray: string -> string[] /// The splitILTypeName utility helps you split a string representing /// a type name into the leading namespace elements (if any), the @@ -1775,7 +1785,7 @@ val internal splitNamespaceToArray: string -> string [] /// the type name. val internal splitILTypeName: string -> string list * string -val internal splitILTypeNameWithPossibleStaticArguments: string -> string [] * string +val internal splitILTypeNameWithPossibleStaticArguments: string -> string[] * string /// splitTypeNameRight is like splitILTypeName except the /// namespace is kept as a whole string, rather than split at dots. @@ -1941,7 +1951,7 @@ val internal mkILCustomAttribute: ILAttributeNamedArg list (* named args: values and flags indicating if they are fields or properties *) -> ILAttribute -val internal getCustomAttrData: ILAttribute -> byte [] +val internal getCustomAttrData: ILAttribute -> byte[] val internal mkPermissionSet: ILSecurityAction * (ILTypeRef * (string * ILType * ILAttribElem) list) list -> ILSecurityDecl @@ -2031,8 +2041,8 @@ val internal mkILNonGenericInstanceMethod: /// Make field definitions. val internal mkILInstanceField: string * ILType * ILFieldInit option * ILMemberAccess -> ILFieldDef -val internal mkILStaticField: string * ILType * ILFieldInit option * byte [] option * ILMemberAccess -> ILFieldDef -val internal mkILLiteralField: string * ILType * ILFieldInit * byte [] option * ILMemberAccess -> ILFieldDef +val internal mkILStaticField: string * ILType * ILFieldInit option * byte[] option * ILMemberAccess -> ILFieldDef +val internal mkILLiteralField: string * ILType * ILFieldInit * byte[] option * ILMemberAccess -> ILFieldDef /// Make a type definition. val internal mkILGenericClass: @@ -2125,15 +2135,15 @@ val internal mkILTypeForGlobalFunctions: ILScopeRef -> ILType /// Making tables of custom attributes, etc. val mkILCustomAttrs: ILAttribute list -> ILAttributes -val mkILCustomAttrsFromArray: ILAttribute [] -> ILAttributes +val mkILCustomAttrsFromArray: ILAttribute[] -> ILAttributes val storeILCustomAttrs: ILAttributes -> ILAttributesStored -val internal mkILCustomAttrsReader: (int32 -> ILAttribute []) -> ILAttributesStored +val internal mkILCustomAttrsReader: (int32 -> ILAttribute[]) -> ILAttributesStored val emptyILCustomAttrs: ILAttributes val mkILSecurityDecls: ILSecurityDecl list -> ILSecurityDecls val emptyILSecurityDecls: ILSecurityDecls val storeILSecurityDecls: ILSecurityDecls -> ILSecurityDeclsStored -val internal mkILSecurityDeclsReader: (int32 -> ILSecurityDecl []) -> ILSecurityDeclsStored +val internal mkILSecurityDeclsReader: (int32 -> ILSecurityDecl[]) -> ILSecurityDeclsStored val mkILEvents: ILEventDef list -> ILEventDefs val mkILEventsLazy: Lazy -> ILEventDefs @@ -2144,8 +2154,8 @@ val mkILPropertiesLazy: Lazy -> ILPropertyDefs val emptyILProperties: ILPropertyDefs val mkILMethods: ILMethodDef list -> ILMethodDefs -val mkILMethodsFromArray: ILMethodDef [] -> ILMethodDefs -val mkILMethodsComputed: (unit -> ILMethodDef []) -> ILMethodDefs +val mkILMethodsFromArray: ILMethodDef[] -> ILMethodDefs +val mkILMethodsComputed: (unit -> ILMethodDef[]) -> ILMethodDefs val emptyILMethods: ILMethodDefs val mkILFields: ILFieldDef list -> ILFieldDefs @@ -2157,7 +2167,7 @@ val mkILMethodImplsLazy: Lazy -> ILMethodImplDefs val emptyILMethodImpls: ILMethodImplDefs val mkILTypeDefs: ILTypeDef list -> ILTypeDefs -val mkILTypeDefsFromArray: ILTypeDef [] -> ILTypeDefs +val mkILTypeDefsFromArray: ILTypeDef[] -> ILTypeDefs val emptyILTypeDefs: ILTypeDefs /// Create table of types which is loaded/computed on-demand, and whose individual @@ -2168,7 +2178,7 @@ val emptyILTypeDefs: ILTypeDefs /// /// Note that individual type definitions may contain further delays /// in their method, field and other tables. -val mkILTypeDefsComputed: (unit -> ILPreTypeDef []) -> ILTypeDefs +val mkILTypeDefsComputed: (unit -> ILPreTypeDef[]) -> ILTypeDefs val internal addILTypeDef: ILTypeDef -> ILTypeDefs -> ILTypeDefs @@ -2267,7 +2277,7 @@ val internal unscopeILType: ILType -> ILType val internal buildILCode: string -> lab2pc: Dictionary -> - instrs: ILInstr [] -> + instrs: ILInstr[] -> ILExceptionSpec list -> ILLocalDebugInfo list -> ILCode @@ -2303,9 +2313,9 @@ val internal isILTypedReferenceTy: ILGlobals -> ILType -> bool val internal isILDoubleTy: ILGlobals -> ILType -> bool val internal isILSingleTy: ILGlobals -> ILType -> bool -val internal sha1HashInt64: byte [] -> int64 +val internal sha1HashInt64: byte[] -> int64 /// Get a public key token from a public key. -val internal sha1HashBytes: byte [] -> byte (* SHA1 hash *) [] +val internal sha1HashBytes: byte[] -> byte (* SHA1 hash *) [] /// Get a version number from a CLR version string, e.g. 1.0.3705.0 val internal parseILVersion: string -> ILVersionInfo @@ -2337,11 +2347,11 @@ type internal ILPropertyRef = interface System.IComparable type ILReferences = - { AssemblyReferences: ILAssemblyRef [] - ModuleReferences: ILModuleRef [] - TypeReferences: ILTypeRef [] - MethodReferences: ILMethodRef [] - FieldReferences: ILFieldRef [] } + { AssemblyReferences: ILAssemblyRef[] + ModuleReferences: ILModuleRef[] + TypeReferences: ILTypeRef[] + MethodReferences: ILMethodRef[] + FieldReferences: ILFieldRef[] } /// Find the full set of assemblies referenced by a module. val internal computeILRefs: ILGlobals -> ILModuleDef -> ILReferences diff --git a/src/Compiler/AbstractIL/ilbinary.fsi b/src/Compiler/AbstractIL/ilbinary.fsi index f7e55417bd3..28e4ff50f94 100644 --- a/src/Compiler/AbstractIL/ilbinary.fsi +++ b/src/Compiler/AbstractIL/ilbinary.fsi @@ -108,7 +108,6 @@ type HasFieldMarshalTag = val hfm_FieldDef: HasFieldMarshalTag val hfm_ParamDef: HasFieldMarshalTag - [] type HasDeclSecurityTag = member Tag: int32 @@ -117,7 +116,6 @@ val hds_TypeDef: HasDeclSecurityTag val hds_MethodDef: HasDeclSecurityTag val hds_Assembly: HasDeclSecurityTag - [] type MemberRefParentTag = member Tag: int32 @@ -127,7 +125,6 @@ val mrp_ModuleRef: MemberRefParentTag val mrp_MethodDef: MemberRefParentTag val mrp_TypeSpec: MemberRefParentTag - [] type HasSemanticsTag = member Tag: int32 @@ -135,7 +132,6 @@ type HasSemanticsTag = val hs_Event: HasSemanticsTag val hs_Property: HasSemanticsTag - [] type MethodDefOrRefTag = member Tag: int32 @@ -143,7 +139,6 @@ type MethodDefOrRefTag = val mdor_MethodDef: MethodDefOrRefTag val mdor_MemberRef: MethodDefOrRefTag - [] type MemberForwardedTag = member Tag: int32 @@ -151,7 +146,6 @@ type MemberForwardedTag = val mf_FieldDef: MemberForwardedTag val mf_MethodDef: MemberForwardedTag - [] type ImplementationTag = member Tag: int32 diff --git a/src/Compiler/AbstractIL/ilnativeres.fsi b/src/Compiler/AbstractIL/ilnativeres.fsi index 41ecc5ff491..d695d225b59 100644 --- a/src/Compiler/AbstractIL/ilnativeres.fsi +++ b/src/Compiler/AbstractIL/ilnativeres.fsi @@ -26,14 +26,14 @@ type RESOURCE = member LanguageId: WORD with get, set member Version: DWORD with get, set member Characteristics: DWORD with get, set - member data: byte [] with get, set + member data: byte[] with get, set type Win32Resource = new: - data: byte [] * codePage: DWORD * languageId: DWORD * id: int * name: string * typeId: int * typeName: string -> + data: byte[] * codePage: DWORD * languageId: DWORD * id: int * name: string * typeId: int * typeName: string -> Win32Resource member CodePage: DWORD - member Data: byte [] + member Data: byte[] member Id: int member LanguageId: DWORD member Name: string diff --git a/src/Compiler/AbstractIL/ilsign.fsi b/src/Compiler/AbstractIL/ilsign.fsi index 7e670b9e573..23a82daffca 100644 --- a/src/Compiler/AbstractIL/ilsign.fsi +++ b/src/Compiler/AbstractIL/ilsign.fsi @@ -12,13 +12,13 @@ module internal FSharp.Compiler.AbstractIL.StrongNameSign //--------------------------------------------------------------------- [] type ILStrongNameSigner = - member PublicKey: byte [] + member PublicKey: byte[] static member OpenPublicKeyOptions: string -> bool -> ILStrongNameSigner - static member OpenPublicKey: byte [] -> ILStrongNameSigner + static member OpenPublicKey: byte[] -> ILStrongNameSigner static member OpenKeyPairFile: string -> ILStrongNameSigner static member OpenKeyContainer: string -> ILStrongNameSigner member Close: unit -> unit member IsFullySigned: bool - member PublicKey: byte [] + member PublicKey: byte[] member SignatureSize: int member SignFile: string -> unit diff --git a/src/Compiler/AbstractIL/ilsupp.fs b/src/Compiler/AbstractIL/ilsupp.fs index 345a90057ad..83609883eb7 100644 --- a/src/Compiler/AbstractIL/ilsupp.fs +++ b/src/Compiler/AbstractIL/ilsupp.fs @@ -878,16 +878,13 @@ let pdbInitialize (binaryName: string) (pdbName: string) = { symWriter = writer } -[] -do() - let pdbCloseDocument(documentWriter: PdbDocumentWriter) = Marshal.ReleaseComObject (documentWriter.symDocWriter) |> ignore -[] let pdbClose (writer: PdbWriter) dllFilename pdbFilename = writer.symWriter.Close() + // CorSymWriter objects (ISymUnmanagedWriter) lock the files they're operating // on (both the pdb and the binary). The locks are released only when their ref // count reaches zero, but since we're dealing with RCWs, there's no telling when @@ -897,6 +894,7 @@ let pdbClose (writer: PdbWriter) dllFilename pdbFilename = // interface, which the SymWriter class, unfortunately, does not. // Right now, take the same approach as mdbg, and manually forcing a collection. let rc = Marshal.ReleaseComObject(writer.symWriter) + for i = 0 to (rc - 1) do Marshal.ReleaseComObject(writer.symWriter) |> ignore diff --git a/src/Compiler/AbstractIL/ilsupp.fsi b/src/Compiler/AbstractIL/ilsupp.fsi index e3a50a6d20b..a7b9ddefcfe 100644 --- a/src/Compiler/AbstractIL/ilsupp.fsi +++ b/src/Compiler/AbstractIL/ilsupp.fsi @@ -29,9 +29,9 @@ type IStream = System.Runtime.InteropServices.ComTypes.IStream /// The function may be called twice, once with a zero-RVA and /// arbitrary buffer, and once with the real buffer. The size of the /// required buffer is returned. -val linkNativeResources: unlinkedResources: byte [] list -> rva: int32 -> byte [] +val linkNativeResources: unlinkedResources: byte[] list -> rva: int32 -> byte[] -val unlinkResource: int32 -> byte [] -> byte [] +val unlinkResource: int32 -> byte[] -> byte[] #if !FX_NO_PDB_WRITER /// PDB reader and associated types @@ -55,12 +55,12 @@ val pdbReaderGetMethodFromDocumentPosition: PdbReader -> PdbDocument -> int (* l val pdbReaderGetDocuments: PdbReader -> PdbDocument array val pdbReaderGetDocument: - PdbReader -> string (* url *) -> byte (* guid *) [] -> byte (* guid *) [] -> byte (* guid *) [] -> PdbDocument + PdbReader -> string (* url *) -> byte (* guid *) [] -> byte (* guid *) [] -> byte (* guid *) [] -> PdbDocument val pdbDocumentGetURL: PdbDocument -> string -val pdbDocumentGetType: PdbDocument -> byte (* guid *) [] -val pdbDocumentGetLanguage: PdbDocument -> byte (* guid *) [] -val pdbDocumentGetLanguageVendor: PdbDocument -> byte (* guid *) [] +val pdbDocumentGetType: PdbDocument -> byte (* guid *) [] +val pdbDocumentGetLanguage: PdbDocument -> byte (* guid *) [] +val pdbDocumentGetLanguageVendor: PdbDocument -> byte (* guid *) [] val pdbDocumentFindClosestLine: PdbDocument -> int -> int val pdbMethodGetToken: PdbMethod -> int32 @@ -71,7 +71,7 @@ val pdbScopeGetOffsets: PdbMethodScope -> int * int val pdbScopeGetLocals: PdbMethodScope -> PdbVariable array val pdbVariableGetName: PdbVariable -> string -val pdbVariableGetSignature: PdbVariable -> byte [] +val pdbVariableGetSignature: PdbVariable -> byte[] val pdbVariableGetAddressAttributes: PdbVariable -> int32 (* kind *) * int32 (* addrField1 *) #endif @@ -87,7 +87,7 @@ type idd = iddMajorVersion: int32 (* actually u16 in IMAGE_DEBUG_DIRECTORY *) iddMinorVersion: int32 (* actually u16 in IMAGE_DEBUG_DIRECTORY *) iddType: int32 - iddData: byte [] } + iddData: byte[] } val pdbInitialize: string (* .exe/.dll already written and closed *) -> string (* .pdb to write *) -> PdbWriter val pdbClose: PdbWriter -> string -> string -> unit @@ -98,7 +98,7 @@ val pdbOpenMethod: PdbWriter -> int32 -> unit val pdbCloseMethod: PdbWriter -> unit val pdbOpenScope: PdbWriter -> int -> unit val pdbCloseScope: PdbWriter -> int -> unit -val pdbDefineLocalVariable: PdbWriter -> string -> byte [] -> int32 -> unit +val pdbDefineLocalVariable: PdbWriter -> string -> byte[] -> int32 -> unit val pdbSetMethodRange: PdbWriter -> PdbDocumentWriter -> int -> int -> PdbDocumentWriter -> int -> int -> unit val pdbDefineSequencePoints: PdbWriter -> PdbDocumentWriter -> (int * int * int * int * int) array -> unit val pdbWriteDebugInfo: PdbWriter -> idd diff --git a/src/Compiler/AbstractIL/ilwrite.fsi b/src/Compiler/AbstractIL/ilwrite.fsi index c8c8c3b23b8..252c3fcc6ff 100644 --- a/src/Compiler/AbstractIL/ilwrite.fsi +++ b/src/Compiler/AbstractIL/ilwrite.fsi @@ -32,4 +32,4 @@ val WriteILBinaryFile: options: options * inputModule: ILModuleDef * (ILAssembly /// Write a binary to an array of bytes auitable for dynamic loading. val WriteILBinaryInMemory: - options: options * inputModule: ILModuleDef * (ILAssemblyRef -> ILAssemblyRef) -> byte [] * byte [] option + options: options * inputModule: ILModuleDef * (ILAssemblyRef -> ILAssemblyRef) -> byte[] * byte[] option diff --git a/src/Compiler/AbstractIL/ilwritepdb.fsi b/src/Compiler/AbstractIL/ilwritepdb.fsi index 098d5828655..93db4b4f7e5 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fsi +++ b/src/Compiler/AbstractIL/ilwritepdb.fsi @@ -11,12 +11,14 @@ open System.Reflection.Metadata type PdbDocumentData = ILSourceDocument type PdbLocalVar = - { Name: string + { + Name: string - Signature: byte [] + Signature: byte[] - /// the local index the name corresponds to - Index: int32 } + /// the local index the name corresponds to + Index: int32 + } /// Defines the set of 'imports' - that is, opened namespaces, types etc. - at each code location /// @@ -34,13 +36,13 @@ type PdbImport = type PdbImports = { Parent: PdbImports option - Imports: PdbImport [] } + Imports: PdbImport[] } type PdbMethodScope = - { Children: PdbMethodScope [] + { Children: PdbMethodScope[] StartOffset: int EndOffset: int - Locals: PdbLocalVar [] + Locals: PdbLocalVar[] Imports: PdbImports option } type PdbSourceLoc = @@ -60,20 +62,22 @@ type PdbMethodData = { MethToken: int32 MethName: string LocalSignatureToken: int32 - Params: PdbLocalVar [] + Params: PdbLocalVar[] RootScope: PdbMethodScope option DebugRange: (PdbSourceLoc * PdbSourceLoc) option - DebugPoints: PdbDebugPoint [] } + DebugPoints: PdbDebugPoint[] } [] type PdbData = - { EntryPoint: int32 option - Timestamp: int32 - /// MVID of the generated .NET module (used by MDB files to identify debug info) - ModuleID: byte [] - Documents: PdbDocumentData [] - Methods: PdbMethodData [] - TableRowCounts: int [] } + { + EntryPoint: int32 option + Timestamp: int32 + /// MVID of the generated .NET module (used by MDB files to identify debug info) + ModuleID: byte[] + Documents: PdbDocumentData[] + Methods: PdbMethodData[] + TableRowCounts: int[] + } /// Takes the output file name and returns debug file name. val getDebugFileName: string -> bool -> string @@ -95,7 +99,7 @@ type idd = iddMinorVersion: int32 (* actually u16 in IMAGE_DEBUG_DIRECTORY *) iddType: int32 iddTimestamp: int32 - iddData: byte [] + iddData: byte[] iddChunk: BinaryChunk } type HashAlgorithm = @@ -110,7 +114,7 @@ val generatePortablePdb: showTimes: bool -> info: PdbData -> pathMap: PathMap -> - int64 * BlobContentId * MemoryStream * string * byte [] + int64 * BlobContentId * MemoryStream * string * byte[] val compressPortablePdbStream: stream: MemoryStream -> MemoryStream @@ -124,9 +128,9 @@ val getInfoForEmbeddedPortablePdb: deterministicPdbChunk: BinaryChunk -> checksumPdbChunk: BinaryChunk -> algorithmName: string -> - checksum: byte [] -> + checksum: byte[] -> deterministic: bool -> - idd [] + idd[] val getInfoForPortablePdb: contentId: BlobContentId -> @@ -136,14 +140,14 @@ val getInfoForPortablePdb: deterministicPdbChunk: BinaryChunk -> checksumPdbChunk: BinaryChunk -> algorithmName: string -> - checksum: byte [] -> + checksum: byte[] -> embeddedPdb: bool -> deterministic: bool -> - idd [] + idd[] #if !FX_NO_PDB_WRITER val writePdbInfo: - showTimes: bool -> outfile: string -> pdbfile: string -> info: PdbData -> cvChunk: BinaryChunk -> idd [] + showTimes: bool -> outfile: string -> pdbfile: string -> info: PdbData -> cvChunk: BinaryChunk -> idd[] #endif /// Check to see if a scope has a local with the same name as any of its children @@ -152,4 +156,4 @@ val writePdbInfo: /// 1. Emit a copy of 'scope' in each true gap, with all locals /// 2. Adjust each child scope to also contain the locals from 'scope', /// adding the text " (shadowed)" to the names of those with name conflicts. -val unshadowScopes: PdbMethodScope -> PdbMethodScope [] +val unshadowScopes: PdbMethodScope -> PdbMethodScope[] diff --git a/src/Compiler/AbstractIL/ilx.fsi b/src/Compiler/AbstractIL/ilx.fsi index 3543665640f..901117867b7 100644 --- a/src/Compiler/AbstractIL/ilx.fsi +++ b/src/Compiler/AbstractIL/ilx.fsi @@ -18,15 +18,14 @@ type IlxUnionCaseField = /// Union alternative type IlxUnionCase = { altName: string - altFields: IlxUnionCaseField [] + altFields: IlxUnionCaseField[] altCustomAttrs: ILAttributes } - member FieldDefs: IlxUnionCaseField [] + member FieldDefs: IlxUnionCaseField[] member FieldDef: int -> IlxUnionCaseField member Name: string member IsNullary: bool - member FieldTypes: ILType [] - + member FieldTypes: ILType[] type IlxUnionHasHelpers = | NoHelpers @@ -39,7 +38,7 @@ type IlxUnionRef = | IlxUnionRef of boxity: ILBoxity * ILTypeRef * - IlxUnionCase [] * + IlxUnionCase[] * bool (* IsNullPermitted *) * IlxUnionHasHelpers (* HasHelpers *) @@ -52,7 +51,7 @@ type IlxUnionSpec = member Alternatives: IlxUnionCase list - member AlternativesArray: IlxUnionCase [] + member AlternativesArray: IlxUnionCase[] member Boxity: ILBoxity @@ -80,7 +79,7 @@ type IlxClosureFreeVar = fvCompilerGenerated: bool fvType: ILType } -type IlxClosureRef = IlxClosureRef of ILTypeRef * IlxClosureLambdas * IlxClosureFreeVar [] +type IlxClosureRef = IlxClosureRef of ILTypeRef * IlxClosureLambdas * IlxClosureFreeVar[] /// Represents a usage of a closure type IlxClosureSpec = @@ -94,7 +93,7 @@ type IlxClosureSpec = member FormalLambdas: IlxClosureLambdas - member FormalFreeVars: IlxClosureFreeVar [] + member FormalFreeVars: IlxClosureFreeVar[] member GenericArgs: ILGenericArgs @@ -109,7 +108,6 @@ type IlxClosureSpec = /// Indicates if a static field being used to store an instance of this closure (because it has no free variables) member UseStaticField: bool - /// IlxClosureApps - i.e. types being applied at a callsite. type IlxClosureApps = | Apps_tyapp of ILType * IlxClosureApps @@ -119,34 +117,36 @@ type IlxClosureApps = /// Represents a closure prior to erasure type IlxClosureInfo = { cloStructure: IlxClosureLambdas - cloFreeVars: IlxClosureFreeVar [] + cloFreeVars: IlxClosureFreeVar[] cloCode: Lazy cloUseStaticField: bool } /// Represents a discriminated union type prior to erasure type IlxUnionInfo = - { /// Is the representation public? - UnionCasesAccessibility: ILMemberAccess + { + /// Is the representation public? + UnionCasesAccessibility: ILMemberAccess - /// Are the representation helpers public? - HelpersAccessibility: ILMemberAccess + /// Are the representation helpers public? + HelpersAccessibility: ILMemberAccess - /// Generate the helpers? - HasHelpers: IlxUnionHasHelpers + /// Generate the helpers? + HasHelpers: IlxUnionHasHelpers - GenerateDebugProxies: bool + GenerateDebugProxies: bool - DebugDisplayAttributes: ILAttribute list + DebugDisplayAttributes: ILAttribute list - UnionCases: IlxUnionCase [] + UnionCases: IlxUnionCase[] - IsNullPermitted: bool + IsNullPermitted: bool - /// Debug info for generated code for classunions. - DebugPoint: ILDebugPoint option + /// Debug info for generated code for classunions. + DebugPoint: ILDebugPoint option - /// Debug info for generated code for classunions - DebugImports: ILDebugImports option } + /// Debug info for generated code for classunions + DebugImports: ILDebugImports option + } // -------------------------------------------------------------------- // MS-ILX constructs: Closures, thunks, classunions diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index f575b6aa83e..cd69237ff78 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5969,6 +5969,10 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = TcExprThen cenv overallTy env tpenv isArg (SynExpr.LongIdent (isOpt, SynLongIdent([altId], [], [None]), None, mLongId)) delayed | _ -> TcLongIdentThen cenv overallTy env tpenv longId delayed + // f?x<-v + | SynExpr.Set(SynExpr.Dynamic(e1, _, e2, _) , rhsExpr, m) -> + TcExprThenSetDynamic cenv overallTy env tpenv isArg e1 e2 rhsExpr m delayed + // f x // f(x) // hpa=true // f[x] // hpa=true @@ -6004,6 +6008,10 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = TcExprThen cenv overallTy env tpenv false func ((DelayedApp (hpa, isInfix, Some func, arg, mFuncAndArg)) :: delayed) + // e1?e2 + | SynExpr.Dynamic(e1, mQmark, e2, _) -> + TcExprThenDynamic cenv overallTy env tpenv isArg e1 mQmark e2 delayed + // e | SynExpr.TypeApp (func, _, typeArgs, _, _, mTypeArgs, mFuncAndTypeArgs) -> TcExprThen cenv overallTy env tpenv false func ((DelayedTypeApp (typeArgs, mTypeArgs, mFuncAndTypeArgs)) :: delayed) @@ -6040,6 +6048,18 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = let expr, exprTy, tpenv = TcExprUndelayedNoType cenv env tpenv synExpr PropagateThenTcDelayed cenv overallTy env tpenv synExpr.Range (MakeApplicableExprNoFlex cenv expr) exprTy ExprAtomicFlag.NonAtomic delayed +and TcExprThenSetDynamic cenv overallTy env tpenv isArg e1 e2 rhsExpr m delayed = + let e2 = mkDynamicArgExpr e2 + let appExpr = mkSynQMarkSet m e1 e2 rhsExpr + TcExprThen cenv overallTy env tpenv isArg appExpr delayed + +and TcExprThenDynamic cenv overallTy env tpenv isArg e1 mQmark e2 delayed = + let appExpr = + let argExpr = mkDynamicArgExpr e2 + mkSynInfix mQmark e1 "?" argExpr + + TcExprThen cenv overallTy env tpenv isArg appExpr delayed + and TcExprsWithFlexes cenv env m tpenv flexes argTys args = if List.length args <> List.length argTys then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argTys), (List.length args)), m)) (tpenv, List.zip3 flexes argTys args) ||> List.mapFold (fun tpenv (flex, ty, e) -> @@ -6204,7 +6224,7 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = TcExpr cenv overallTy env tpenv expr2 | SynExpr.DotIndexedGet _ | SynExpr.DotIndexedSet _ - | SynExpr.TypeApp _ | SynExpr.Ident _ | SynExpr.LongIdent _ | SynExpr.App _ | SynExpr.DotGet _ -> error(Error(FSComp.SR.tcExprUndelayed(), synExpr.Range)) + | SynExpr.TypeApp _ | SynExpr.Ident _ | SynExpr.LongIdent _ | SynExpr.App _ | SynExpr.Dynamic _ | SynExpr.DotGet _ -> error(Error(FSComp.SR.tcExprUndelayed(), synExpr.Range)) | SynExpr.Const (SynConst.String (s, _, m), _) -> TcNonControlFlowExpr env <| fun env -> @@ -9217,7 +9237,8 @@ and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = | SynExpr.Null _ | SynExpr.Ident _ | SynExpr.Const _ - | SynExpr.LongIdent _ -> true + | SynExpr.LongIdent _ + | SynExpr.Dynamic _ -> true | SynExpr.Tuple (_, synExprs, _, _) | SynExpr.ArrayOrList (_, synExprs, _) -> synExprs |> List.forall isSimpleArgument diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 2a4c44c1d5f..84a83c5bf65 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -53,58 +53,60 @@ type UngeneralizableItem /// and other information about the scope. [] type TcEnv = - { /// Name resolution information - eNameResEnv: NameResolutionEnv + { + /// Name resolution information + eNameResEnv: NameResolutionEnv - /// The list of items in the environment that may contain free inference - /// variables (which may not be generalized). The relevant types may - /// change as a result of inference equations being asserted, hence may need to - /// be recomputed. - eUngeneralizableItems: UngeneralizableItem list + /// The list of items in the environment that may contain free inference + /// variables (which may not be generalized). The relevant types may + /// change as a result of inference equations being asserted, hence may need to + /// be recomputed. + eUngeneralizableItems: UngeneralizableItem list - // Two (!) versions of the current module path - // These are used to: - // - Look up the appropriate point in the corresponding signature - // see if an item is public or not - // - Change fslib canonical module type to allow compiler references to these items - // - Record the cpath for concrete modul_specs, tycon_specs and excon_specs so they can cache their generated IL representation where necessary - // - Record the pubpath of public, concrete {val, tycon, modul, excon}_specs. - // This information is used mainly when building non-local references - // to public items. - // - // Of the two, 'ePath' is the one that's barely used. It's only - // used by UpdateAccModuleOrNamespaceType to modify the CCU while compiling FSharp.Core - ePath: Ident list + // Two (!) versions of the current module path + // These are used to: + // - Look up the appropriate point in the corresponding signature + // see if an item is public or not + // - Change fslib canonical module type to allow compiler references to these items + // - Record the cpath for concrete modul_specs, tycon_specs and excon_specs so they can cache their generated IL representation where necessary + // - Record the pubpath of public, concrete {val, tycon, modul, excon}_specs. + // This information is used mainly when building non-local references + // to public items. + // + // Of the two, 'ePath' is the one that's barely used. It's only + // used by UpdateAccModuleOrNamespaceType to modify the CCU while compiling FSharp.Core + ePath: Ident list - eCompPath: CompilationPath + eCompPath: CompilationPath - eAccessPath: CompilationPath + eAccessPath: CompilationPath - /// This field is computed from other fields, but we amortize the cost of computing it. - eAccessRights: AccessorDomain + /// This field is computed from other fields, but we amortize the cost of computing it. + eAccessRights: AccessorDomain - /// Internals under these should be accessible - eInternalsVisibleCompPaths: CompilationPath list + /// Internals under these should be accessible + eInternalsVisibleCompPaths: CompilationPath list - /// Mutable accumulator for the current module type - eModuleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref + /// Mutable accumulator for the current module type + eModuleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref - /// Context information for type checker - eContextInfo: ContextInfo + /// Context information for type checker + eContextInfo: ContextInfo - /// Here Some tcref indicates we can access protected members in all super types - eFamilyType: TyconRef option + /// Here Some tcref indicates we can access protected members in all super types + eFamilyType: TyconRef option - // Information to enforce special restrictions on valid expressions - // for .NET constructors. - eCtorInfo: CtorInfo option + // Information to enforce special restrictions on valid expressions + // for .NET constructors. + eCtorInfo: CtorInfo option - eCallerMemberName: string option + eCallerMemberName: string option - // Active arg infos in iterated lambdas , allowing us to determine the attributes of arguments - eLambdaArgInfos: ArgReprInfo list list + // Active arg infos in iterated lambdas , allowing us to determine the attributes of arguments + eLambdaArgInfos: ArgReprInfo list list - eIsControlFlow: bool } + eIsControlFlow: bool + } member DisplayEnv: DisplayEnv @@ -223,87 +225,89 @@ type UnscopedTyparEnv /// Represents the compilation environment for typechecking a single file in an assembly. [] type TcFileState = - { g: TcGlobals + { + g: TcGlobals - /// Push an entry every time a recursive value binding is used, - /// in order to be able to fix up recursive type applications as - /// we infer type parameters - mutable recUses: ValMultiMap + /// Push an entry every time a recursive value binding is used, + /// in order to be able to fix up recursive type applications as + /// we infer type parameters + mutable recUses: ValMultiMap - /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached - stackGuard: StackGuard + /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached + stackGuard: StackGuard - /// Set to true if this file causes the creation of generated provided types. - mutable createsGeneratedProvidedTypes: bool + /// Set to true if this file causes the creation of generated provided types. + mutable createsGeneratedProvidedTypes: bool - /// Are we in a script? if so relax the reporting of discarded-expression warnings at the top level - isScript: bool + /// Are we in a script? if so relax the reporting of discarded-expression warnings at the top level + isScript: bool - /// Environment needed to convert IL types to F# types in the importer. - amap: ImportMap + /// Environment needed to convert IL types to F# types in the importer. + amap: ImportMap - /// Used to generate new syntactic argument names in post-parse syntactic processing - synArgNameGenerator: SynArgNameGenerator + /// Used to generate new syntactic argument names in post-parse syntactic processing + synArgNameGenerator: SynArgNameGenerator - tcSink: TcResultsSink + tcSink: TcResultsSink - /// Holds a reference to the component being compiled. - /// This field is very rarely used (mainly when fixing up forward references to fslib. - thisCcu: CcuThunk + /// Holds a reference to the component being compiled. + /// This field is very rarely used (mainly when fixing up forward references to fslib. + thisCcu: CcuThunk - /// Holds the current inference constraints - css: ConstraintSolverState + /// Holds the current inference constraints + css: ConstraintSolverState - /// Are we compiling the signature of a module from fslib? - compilingCanonicalFslibModuleType: bool + /// Are we compiling the signature of a module from fslib? + compilingCanonicalFslibModuleType: bool - /// Is this a .fsi file? - isSig: bool + /// Is this a .fsi file? + isSig: bool - /// Does this .fs file have a .fsi file? - haveSig: bool + /// Does this .fs file have a .fsi file? + haveSig: bool - /// Used to generate names - niceNameGen: NiceNameGenerator + /// Used to generate names + niceNameGen: NiceNameGenerator - /// Used to read and cache information about types and members - infoReader: InfoReader + /// Used to read and cache information about types and members + infoReader: InfoReader - /// Used to resolve names - nameResolver: NameResolver + /// Used to resolve names + nameResolver: NameResolver - /// The set of active conditional defines. The value is None when conditional erasure is disabled in tooling. - conditionalDefines: string list option + /// The set of active conditional defines. The value is None when conditional erasure is disabled in tooling. + conditionalDefines: string list option - namedDebugPointsForInlinedCode: Dictionary + namedDebugPointsForInlinedCode: Dictionary - isInternalTestSpanStackReferring: bool + isInternalTestSpanStackReferring: bool - // forward call - TcSequenceExpressionEntry: TcFileState - -> TcEnv - -> OverallTy - -> UnscopedTyparEnv - -> bool * SynExpr - -> range - -> Expr * UnscopedTyparEnv + // forward call + TcSequenceExpressionEntry: TcFileState + -> TcEnv + -> OverallTy + -> UnscopedTyparEnv + -> bool * SynExpr + -> range + -> Expr * UnscopedTyparEnv - // forward call - TcArrayOrListComputedExpression: TcFileState - -> TcEnv - -> OverallTy - -> UnscopedTyparEnv - -> bool * SynExpr - -> range - -> Expr * UnscopedTyparEnv + // forward call + TcArrayOrListComputedExpression: TcFileState + -> TcEnv + -> OverallTy + -> UnscopedTyparEnv + -> bool * SynExpr + -> range + -> Expr * UnscopedTyparEnv - // forward call - TcComputationExpression: TcFileState - -> TcEnv - -> OverallTy - -> UnscopedTyparEnv - -> range * Expr * TType * SynExpr - -> Expr * UnscopedTyparEnv } + // forward call + TcComputationExpression: TcFileState + -> TcEnv + -> OverallTy + -> UnscopedTyparEnv + -> range * Expr * TType * SynExpr + -> Expr * UnscopedTyparEnv + } static member Create: g: TcGlobals * diff --git a/src/Compiler/Checking/CheckFormatStrings.fsi b/src/Compiler/Checking/CheckFormatStrings.fsi index 9616f255a50..eb8120f712d 100644 --- a/src/Compiler/Checking/CheckFormatStrings.fsi +++ b/src/Compiler/Checking/CheckFormatStrings.fsi @@ -23,7 +23,7 @@ val ParseFormatString: printerArgTy: TType -> printerResidueTy: TType -> printerResultTy: TType -> - TType list * TType * TType * TType [] * (range * int) list * string + TType list * TType * TType * TType[] * (range * int) list * string val TryCountFormatStringArguments: m: range -> diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index c7e375d5042..5941702256a 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -1,6 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - /// Select members from a type by name, searching the type hierarchy if needed module internal FSharp.Compiler.InfoReader diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index 8eaa3c3a8f8..5a54954eeff 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -68,14 +68,16 @@ val CalledArg: /// Represents a match between a caller argument and a called argument, arising from either /// a named argument or an unnamed argument. type AssignedCalledArg<'T> = - { /// The identifier for a named argument, if any - NamedArgIdOpt: Ident option + { + /// The identifier for a named argument, if any + NamedArgIdOpt: Ident option - /// The called argument in the method - CalledArg: CalledArg + /// The called argument in the method + CalledArg: CalledArg - /// The argument on the caller side - CallerArg: CallerArg<'T> } + /// The argument on the caller side + CallerArg: CallerArg<'T> + } member Position: struct (int * int) @@ -159,20 +161,22 @@ val AdjustCalledArgType: TType * TypeDirectedConversionUsed * (TType * TType * (DisplayEnv -> unit)) option type CalledMethArgSet<'T> = - { /// The called arguments corresponding to "unnamed" arguments - UnnamedCalledArgs: CalledArg list + { + /// The called arguments corresponding to "unnamed" arguments + UnnamedCalledArgs: CalledArg list - /// Any unnamed caller arguments not otherwise assigned - UnnamedCallerArgs: CallerArg<'T> list + /// Any unnamed caller arguments not otherwise assigned + UnnamedCallerArgs: CallerArg<'T> list - /// The called "ParamArray" argument, if any - ParamArrayCalledArgOpt: CalledArg option + /// The called "ParamArray" argument, if any + ParamArrayCalledArgOpt: CalledArg option - /// Any unnamed caller arguments assigned to a "param array" argument - ParamArrayCallerArgs: CallerArg<'T> list + /// Any unnamed caller arguments assigned to a "param array" argument + ParamArrayCallerArgs: CallerArg<'T> list - /// Named args - AssignedNamedArgs: AssignedCalledArg<'T> list } + /// Named args + AssignedNamedArgs: AssignedCalledArg<'T> list + } member NumAssignedNamedArgs: int diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 3683d2846da..969e22c0207 100644 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -170,59 +170,60 @@ type ExtensionMember = /// The environment of information used to resolve names [] type NameResolutionEnv = - { /// Display environment information for output - eDisplayEnv: DisplayEnv + { + /// Display environment information for output + eDisplayEnv: DisplayEnv - /// Values and Data Tags available by unqualified name - eUnqualifiedItems: LayeredMap + /// Values and Data Tags available by unqualified name + eUnqualifiedItems: LayeredMap - /// Enclosing type instantiations that are associated with an unqualified type item - eUnqualifiedEnclosingTypeInsts: TyconRefMap + /// Enclosing type instantiations that are associated with an unqualified type item + eUnqualifiedEnclosingTypeInsts: TyconRefMap - /// Data Tags and Active Pattern Tags available by unqualified name - ePatItems: NameMap + /// Data Tags and Active Pattern Tags available by unqualified name + ePatItems: NameMap - /// Modules accessible via "." notation. Note this is a multi-map. - /// Adding a module abbreviation adds it a local entry to this List.map. - /// Likewise adding a ccu or opening a path adds entries to this List.map. - eModulesAndNamespaces: NameMultiMap + /// Modules accessible via "." notation. Note this is a multi-map. + /// Adding a module abbreviation adds it a local entry to this List.map. + /// Likewise adding a ccu or opening a path adds entries to this List.map. + eModulesAndNamespaces: NameMultiMap - /// Fully qualified modules and namespaces. 'open' does not change this. - eFullyQualifiedModulesAndNamespaces: NameMultiMap + /// Fully qualified modules and namespaces. 'open' does not change this. + eFullyQualifiedModulesAndNamespaces: NameMultiMap - /// RecdField labels in scope. RecdField labels are those where type are inferred - /// by label rather than by known type annotation. - /// Bools indicate if from a record, where no warning is given on indeterminate lookup - eFieldLabels: NameMultiMap + /// RecdField labels in scope. RecdField labels are those where type are inferred + /// by label rather than by known type annotation. + /// Bools indicate if from a record, where no warning is given on indeterminate lookup + eFieldLabels: NameMultiMap - /// Record or unions that may have type instantiations associated with them - /// when record labels or union cases are used in an unqualified context. - eUnqualifiedRecordOrUnionTypeInsts: TyconRefMap + /// Record or unions that may have type instantiations associated with them + /// when record labels or union cases are used in an unqualified context. + eUnqualifiedRecordOrUnionTypeInsts: TyconRefMap - /// Tycons indexed by the various names that may be used to access them, e.g. - /// "List" --> multiple TyconRef's for the various tycons accessible by this name. - /// "List`1" --> TyconRef - eTyconsByAccessNames: LayeredMultiMap + /// Tycons indexed by the various names that may be used to access them, e.g. + /// "List" --> multiple TyconRef's for the various tycons accessible by this name. + /// "List`1" --> TyconRef + eTyconsByAccessNames: LayeredMultiMap - eFullyQualifiedTyconsByAccessNames: LayeredMultiMap + eFullyQualifiedTyconsByAccessNames: LayeredMultiMap - /// Tycons available by unqualified, demangled names (i.e. (List,1) --> TyconRef) - eTyconsByDemangledNameAndArity: LayeredMap + /// Tycons available by unqualified, demangled names (i.e. (List,1) --> TyconRef) + eTyconsByDemangledNameAndArity: LayeredMap - /// Tycons available by unqualified, demangled names (i.e. (List,1) --> TyconRef) - eFullyQualifiedTyconsByDemangledNameAndArity: LayeredMap + /// Tycons available by unqualified, demangled names (i.e. (List,1) --> TyconRef) + eFullyQualifiedTyconsByDemangledNameAndArity: LayeredMap - /// Extension members by type and name - eIndexedExtensionMembers: TyconRefMultiMap + /// Extension members by type and name + eIndexedExtensionMembers: TyconRefMultiMap - /// Other extension members unindexed by type - eUnindexedExtensionMembers: ExtensionMember list + /// Other extension members unindexed by type + eUnindexedExtensionMembers: ExtensionMember list - /// Typars (always available by unqualified names). Further typars can be - /// in the tpenv, a structure folded through each top-level definition. - eTypars: NameMap + /// Typars (always available by unqualified names). Further typars can be + /// in the tpenv, a structure folded through each top-level definition. + eTypars: NameMap - } + } static member Empty: g: TcGlobals -> NameResolutionEnv member DisplayEnv: DisplayEnv @@ -430,24 +431,26 @@ type TcSymbolUseData = type internal TcSymbolUses = /// Get all the uses of a particular item within the file - member GetUsesOfSymbol: Item -> TcSymbolUseData [] + member GetUsesOfSymbol: Item -> TcSymbolUseData[] /// All the uses of all items within the file - member AllUsesOfSymbols: TcSymbolUseData [] [] + member AllUsesOfSymbols: TcSymbolUseData[][] /// Get the locations of all the printf format specifiers in the file - member GetFormatSpecifierLocationsAndArity: unit -> (range * int) [] + member GetFormatSpecifierLocationsAndArity: unit -> (range * int)[] /// Empty collection of symbol uses static member Empty: TcSymbolUses /// Source text and an array of line end positions, used for format string parsing type FormatStringCheckContext = - { /// Source text - SourceText: ISourceText + { + /// Source text + SourceText: ISourceText - /// Array of line start positions - LineStartPositions: int [] } + /// Array of line start positions + LineStartPositions: int[] + } /// An abstract type for reporting the results of name resolution and type checking type ITypecheckResultsSink = @@ -492,10 +495,10 @@ type internal TcResultsSinkImpl = member GetSymbolUses: unit -> TcSymbolUses /// Get all open declarations reported to the sink - member GetOpenDeclarations: unit -> OpenDeclaration [] + member GetOpenDeclarations: unit -> OpenDeclaration[] /// Get the format specifier locations - member GetFormatSpecifierLocations: unit -> (range * int) [] + member GetFormatSpecifierLocations: unit -> (range * int)[] interface ITypecheckResultsSink @@ -507,7 +510,6 @@ type TcResultsSink = static member NoSink: TcResultsSink static member WithSink: ITypecheckResultsSink -> TcResultsSink - /// Indicates if we only need one result or all possible results from a resolution. [] type ResultCollectionSettings = @@ -596,7 +598,6 @@ type LookupKind = | Type | Ctor - /// Indicates if a warning should be given for the use of upper-case identifiers in patterns type WarnOnUpperFlag = | WarnOnUpperCase diff --git a/src/Compiler/Checking/QuotationTranslator.fsi b/src/Compiler/Checking/QuotationTranslator.fsi index 9c80c86b74a..d82bfa32bc1 100644 --- a/src/Compiler/Checking/QuotationTranslator.fsi +++ b/src/Compiler/Checking/QuotationTranslator.fsi @@ -20,11 +20,13 @@ type IsReflectedDefinition = [] type QuotationSerializationFormat = - { /// Indicates that witness parameters are recorded - SupportsWitnesses: bool + { + /// Indicates that witness parameters are recorded + SupportsWitnesses: bool - /// Indicates that type references are emitted as integer indexes into a supplied table - SupportsDeserializeEx: bool } + /// Indicates that type references are emitted as integer indexes into a supplied table + SupportsDeserializeEx: bool + } [] type QuotationGenerationScope = diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index fd06a46c2d7..0208d8bf432 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.Import open System.Collections.Concurrent open System.Collections.Generic +open System.Collections.Immutable open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler @@ -586,25 +587,60 @@ let ImportILAssemblyTypeDefs (amap, m, auxModLoader, aref, mainmod: ILModuleDef) CombineCcuContentFragments m (mainmod :: mtypsForExportedTypes) /// Import the type forwarder table for an IL assembly -let ImportILAssemblyTypeForwarders (amap, m, exportedTypes: ILExportedTypesAndForwarders) = - // Note 'td' may be in another module or another assembly! - // Note: it is very important that we call auxModLoader lazily - [ //printfn "reading forwarders..." - for exportedType in exportedTypes.AsList() do +let ImportILAssemblyTypeForwarders (amap, m, exportedTypes: ILExportedTypesAndForwarders): CcuTypeForwarderTable = + let rec addToTree tree path item value = + match path with + | [] -> + { tree with + Children = + tree.Children.Add( + item, + { Value = Some value + Children = ImmutableDictionary.Empty } + ) } + | nodeKey :: rest -> + match tree.Children.TryGetValue(nodeKey) with + | true, subTree -> { tree with Children = tree.Children.SetItem(nodeKey, addToTree subTree rest item value) } + | false, _ -> { tree with Children = tree.Children.Add(nodeKey, mkTreeWith rest item value) } + + and mkTreeWith path item value = + match path with + | [] -> + { Value = None + Children = + ImmutableDictionary.Empty.Add( + item, + { Value = Some value + Children = ImmutableDictionary.Empty } + ) } + | nodeKey :: rest -> + { Value = None + Children = ImmutableDictionary.Empty.Add(nodeKey, mkTreeWith rest item value) } + + let rec addNested + (exportedType: ILExportedTypeOrForwarder) + (nets: ILNestedExportedTypes) + (enc: string list) + (tree: CcuTypeForwarderTree) + : CcuTypeForwarderTree = + (tree, nets.AsList()) + ||> List.fold(fun tree net -> + let tcref = lazy ImportILTypeRefUncached (amap ()) m (ILTypeRef.Create(exportedType.ScopeRef, enc, net.Name)) + addToTree tree enc exportedType.Name tcref + |> addNested exportedType net.Nested [yield! enc; yield net.Name]) + + match exportedTypes.AsList() with + | [] -> CcuTypeForwarderTable.Empty + | rootTypes -> + ({ Value = None; Children = ImmutableDictionary.Empty } , rootTypes) + ||> List.fold(fun tree exportedType -> let ns, n = splitILTypeName exportedType.Name - //printfn "found forwarder for %s..." n - let tcref = lazy ImportILTypeRefUncached (amap()) m (ILTypeRef.Create(exportedType.ScopeRef, [], exportedType.Name)) - yield (Array.ofList ns, n), tcref - let rec nested (nets: ILNestedExportedTypes) enc = - [ for net in nets.AsList() do - - //printfn "found nested forwarder for %s..." net.Name - let tcref = lazy ImportILTypeRefUncached (amap()) m (ILTypeRef.Create (exportedType.ScopeRef, enc, net.Name)) - yield (Array.ofList enc, exportedType.Name), tcref - yield! nested net.Nested (enc @ [ net.Name ]) ] - yield! nested exportedType.Nested (ns@[n]) - ] |> Map.ofList - + let tcref = lazy ImportILTypeRefUncached (amap ()) m (ILTypeRef.Create(exportedType.ScopeRef, [], exportedType.Name)) + addToTree tree ns n tcref + |> addNested exportedType exportedType.Nested [yield! ns; yield n] + ) + |> fun root -> { Root = root } + /// Import an IL assembly as a new TAST CCU let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoader: IXmlDocumentationInfoLoader option, ilScopeRef, sourceDir, fileName, ilModule: ILModuleDef, invalidateCcu: IEvent) = invalidateCcu |> ignore @@ -616,7 +652,7 @@ let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoad let mty = ImportILAssemblyTypeDefs(amap, m, auxModuleLoader, aref, ilModule) let forwarders = match ilModule.Manifest with - | None -> Map.empty + | None -> CcuTypeForwarderTable.Empty | Some manifest -> ImportILAssemblyTypeForwarders(amap, m, manifest.ExportedTypes) let ccuData: CcuData = diff --git a/src/Compiler/Checking/import.fsi b/src/Compiler/Checking/import.fsi index 0b40eef481d..830fd81b12d 100644 --- a/src/Compiler/Checking/import.fsi +++ b/src/Compiler/Checking/import.fsi @@ -96,7 +96,7 @@ val internal ImportILAssembly: /// Import the type forwarder table for an IL assembly val internal ImportILAssemblyTypeForwarders: - (unit -> ImportMap) * range * ILExportedTypesAndForwarders -> Map> + (unit -> ImportMap) * range * ILExportedTypesAndForwarders -> CcuTypeForwarderTable /// Import an IL type as an F# type, first rescoping to view the metadata from the current assembly /// being compiled. importInst gives the context for interpreting type variables. diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index fc5dd98ecc9..dba5200afb7 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -442,7 +442,7 @@ type MethInfo = #if NO_TYPEPROVIDERS member ProvidedStaticParameterInfo: obj option #else - member ProvidedStaticParameterInfo: (Tainted * Tainted []) option + member ProvidedStaticParameterInfo: (Tainted * Tainted[]) option #endif /// Get the TcGlobals value that governs the method declaration diff --git a/src/Compiler/CodeGen/IlxGen.fsi b/src/Compiler/CodeGen/IlxGen.fsi index 9f7f815ad80..d68463e9ca7 100644 --- a/src/Compiler/CodeGen/IlxGen.fsi +++ b/src/Compiler/CodeGen/IlxGen.fsi @@ -16,68 +16,72 @@ type IlxGenBackend = [] type internal IlxGenOptions = - { fragName: string + { + fragName: string - /// Indicates if we are generating filter blocks - generateFilterBlocks: bool + /// Indicates if we are generating filter blocks + generateFilterBlocks: bool - /// Indicates if we should workaround old reflection emit bugs - workAroundReflectionEmitBugs: bool + /// Indicates if we should workaround old reflection emit bugs + workAroundReflectionEmitBugs: bool - /// Indicates if static array data should be emitted using static blobs - emitConstantArraysUsingStaticDataBlobs: bool + /// Indicates if static array data should be emitted using static blobs + emitConstantArraysUsingStaticDataBlobs: bool - /// If this is set, then the last module becomes the "main" module - mainMethodInfo: Attribs option + /// If this is set, then the last module becomes the "main" module + mainMethodInfo: Attribs option - /// Indicates if local optimizations are active - localOptimizationsEnabled: bool + /// Indicates if local optimizations are active + localOptimizationsEnabled: bool - /// Indicates if we are generating debug symbols or not - generateDebugSymbols: bool + /// Indicates if we are generating debug symbols or not + generateDebugSymbols: bool - /// A flag to help test emit of debug information - testFlagEmitFeeFeeAs100001: bool + /// A flag to help test emit of debug information + testFlagEmitFeeFeeAs100001: bool - /// Indicates which backend we are generating code for - ilxBackend: IlxGenBackend + /// Indicates which backend we are generating code for + ilxBackend: IlxGenBackend - /// Is --multiemit enabled? - fsiMultiAssemblyEmit: bool + /// Is --multiemit enabled? + fsiMultiAssemblyEmit: bool - /// Indicates the code is being generated in FSI.EXE and is executed immediately after code generation - /// This includes all interactively compiled code, including #load, definitions, and expressions - isInteractive: bool + /// Indicates the code is being generated in FSI.EXE and is executed immediately after code generation + /// This includes all interactively compiled code, including #load, definitions, and expressions + isInteractive: bool - /// Indicates the code generated is an interactive 'it' expression. We generate a setter to allow clearing of the underlying - /// storage, even though 'it' is not logically mutable - isInteractiveItExpr: bool + /// Indicates the code generated is an interactive 'it' expression. We generate a setter to allow clearing of the underlying + /// storage, even though 'it' is not logically mutable + isInteractiveItExpr: bool - /// Suppress ToString emit - useReflectionFreeCodeGen: bool + /// Suppress ToString emit + useReflectionFreeCodeGen: bool - /// Indicates that, whenever possible, use callvirt instead of call - alwaysCallVirt: bool } + /// Indicates that, whenever possible, use callvirt instead of call + alwaysCallVirt: bool + } /// The results of the ILX compilation of one fragment of an assembly type public IlxGenResults = - { /// The generated IL/ILX type definitions - ilTypeDefs: ILTypeDef list + { + /// The generated IL/ILX type definitions + ilTypeDefs: ILTypeDef list - /// The generated IL/ILX assembly attributes - ilAssemAttrs: ILAttribute list + /// The generated IL/ILX assembly attributes + ilAssemAttrs: ILAttribute list - /// The generated IL/ILX .NET module attributes - ilNetModuleAttrs: ILAttribute list + /// The generated IL/ILX .NET module attributes + ilNetModuleAttrs: ILAttribute list - /// The attributes for the assembly in F# form - topAssemblyAttrs: Attribs + /// The attributes for the assembly in F# form + topAssemblyAttrs: Attribs - /// The security attributes to attach to the assembly - permissionSets: ILSecurityDecl list + /// The security attributes to attach to the assembly + permissionSets: ILSecurityDecl list - /// The generated IL/ILX resources associated with F# quotations - quotationResourceInfo: (ILTypeRef list * byte []) list } + /// The generated IL/ILX resources associated with F# quotations + quotationResourceInfo: (ILTypeRef list * byte[]) list + } /// Used to support the compilation-inversion operations "ClearGeneratedValue" and "LookupGeneratedValue" type ExecutionContext = diff --git a/src/Compiler/DependencyManager/DependencyProvider.fsi b/src/Compiler/DependencyManager/DependencyProvider.fsi index dd7dd9f80a0..4a35606a812 100644 --- a/src/Compiler/DependencyManager/DependencyProvider.fsi +++ b/src/Compiler/DependencyManager/DependencyProvider.fsi @@ -13,10 +13,10 @@ type IResolveDependenciesResult = abstract Success: bool /// The resolution output log - abstract StdOut: string [] + abstract StdOut: string[] /// The resolution error log (process stderr) - abstract StdError: string [] + abstract StdError: string[] /// The resolution paths - the full paths to selected resolved dll's. /// In scripts this is equivalent to #r @"c:\somepath\to\packages\ResolvedPackage\1.1.1\lib\netstandard2.0\ResolvedAssembly.dll" @@ -51,7 +51,7 @@ type IDependencyManagerProvider = abstract Key: string /// The help messages for this dependency manager inster - abstract HelpMessages: string [] + abstract HelpMessages: string[] /// Resolve the dependencies, for the given set of arguments, go find the .dll references, scripts and additional include values. abstract ResolveDependencies: @@ -92,7 +92,7 @@ type DependencyProvider = new: assemblyProbingPaths: AssemblyResolutionProbe * nativeProbingRoots: NativeResolutionProbe -> DependencyProvider /// Returns a formatted help messages for registered dependencymanagers for the host to present - member GetRegisteredDependencyManagerHelpText: string seq * string * ResolvingErrorReport -> string [] + member GetRegisteredDependencyManagerHelpText: string seq * string * ResolvingErrorReport -> string[] /// Returns a formatted error message for the host to present member CreatePackageManagerUnknownError: string seq * string * string * ResolvingErrorReport -> int * string diff --git a/src/Compiler/Driver/BinaryResourceFormats.fsi b/src/Compiler/Driver/BinaryResourceFormats.fsi index a723f005e9d..cb9384e01fa 100644 --- a/src/Compiler/Driver/BinaryResourceFormats.fsi +++ b/src/Compiler/Driver/BinaryResourceFormats.fsi @@ -10,12 +10,12 @@ module VersionResourceFormat = (ILVersionInfo * ILVersionInfo * int32 * int32 * int32 * int32 * int32 * int64) * seq> * seq -> - byte [] + byte[] module ManifestResourceFormat = - val VS_MANIFEST_RESOURCE: data: byte [] * isLibrary: bool -> byte [] + val VS_MANIFEST_RESOURCE: data: byte[] * isLibrary: bool -> byte[] module ResFileFormat = - val ResFileHeader: unit -> byte [] + val ResFileHeader: unit -> byte[] diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index 03c16f4f4fd..342fd3c9433 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -200,275 +200,278 @@ type MetadataAssemblyGeneration = [] type TcConfigBuilder = - { mutable primaryAssembly: PrimaryAssembly + { + mutable primaryAssembly: PrimaryAssembly - mutable noFeedback: bool + mutable noFeedback: bool - mutable stackReserveSize: int32 option + mutable stackReserveSize: int32 option - mutable implicitIncludeDir: string + mutable implicitIncludeDir: string - mutable openDebugInformationForLaterStaticLinking: bool + mutable openDebugInformationForLaterStaticLinking: bool - defaultFSharpBinariesDir: string + defaultFSharpBinariesDir: string - mutable compilingFSharpCore: bool + mutable compilingFSharpCore: bool - mutable useIncrementalBuilder: bool + mutable useIncrementalBuilder: bool - mutable includes: string list + mutable includes: string list - mutable implicitOpens: string list + mutable implicitOpens: string list - mutable useFsiAuxLib: bool + mutable useFsiAuxLib: bool - mutable implicitlyReferenceDotNetAssemblies: bool + mutable implicitlyReferenceDotNetAssemblies: bool - mutable resolutionEnvironment: LegacyResolutionEnvironment + mutable resolutionEnvironment: LegacyResolutionEnvironment - mutable implicitlyResolveAssemblies: bool + mutable implicitlyResolveAssemblies: bool - /// Set if the user has explicitly turned indentation-aware syntax on/off - mutable indentationAwareSyntax: bool option + /// Set if the user has explicitly turned indentation-aware syntax on/off + mutable indentationAwareSyntax: bool option - mutable conditionalDefines: string list + mutable conditionalDefines: string list - /// Sources added into the build with #load - mutable loadedSources: (range * string * string) list + /// Sources added into the build with #load + mutable loadedSources: (range * string * string) list - mutable compilerToolPaths: string list + mutable compilerToolPaths: string list - mutable referencedDLLs: AssemblyReference list + mutable referencedDLLs: AssemblyReference list - mutable packageManagerLines: Map + mutable packageManagerLines: Map - mutable projectReferences: IProjectReference list + mutable projectReferences: IProjectReference list - mutable knownUnresolvedReferences: UnresolvedAssemblyReference list + mutable knownUnresolvedReferences: UnresolvedAssemblyReference list - reduceMemoryUsage: ReduceMemoryFlag + reduceMemoryUsage: ReduceMemoryFlag - mutable subsystemVersion: int * int + mutable subsystemVersion: int * int - mutable useHighEntropyVA: bool + mutable useHighEntropyVA: bool - mutable inputCodePage: int option + mutable inputCodePage: int option - mutable embedResources: string list + mutable embedResources: string list - mutable diagnosticsOptions: FSharpDiagnosticOptions + mutable diagnosticsOptions: FSharpDiagnosticOptions - mutable mlCompatibility: bool + mutable mlCompatibility: bool - mutable checkOverflow: bool + mutable checkOverflow: bool - mutable showReferenceResolutions: bool + mutable showReferenceResolutions: bool - mutable outputDir: string option + mutable outputDir: string option - mutable outputFile: string option + mutable outputFile: string option - mutable platform: ILPlatform option + mutable platform: ILPlatform option - mutable prefer32Bit: bool + mutable prefer32Bit: bool - mutable useSimpleResolution: bool + mutable useSimpleResolution: bool - mutable target: CompilerTarget + mutable target: CompilerTarget - mutable debuginfo: bool + mutable debuginfo: bool - mutable testFlagEmitFeeFeeAs100001: bool + mutable testFlagEmitFeeFeeAs100001: bool - mutable dumpDebugInfo: bool + mutable dumpDebugInfo: bool - mutable debugSymbolFile: string option + mutable debugSymbolFile: string option - mutable typeCheckOnly: bool + mutable typeCheckOnly: bool - mutable parseOnly: bool + mutable parseOnly: bool - mutable importAllReferencesOnly: bool + mutable importAllReferencesOnly: bool - mutable simulateException: string option + mutable simulateException: string option - mutable printAst: bool + mutable printAst: bool - mutable tokenize: TokenizeOption + mutable tokenize: TokenizeOption - mutable testInteractionParser: bool + mutable testInteractionParser: bool - mutable reportNumDecls: bool + mutable reportNumDecls: bool - mutable printSignature: bool + mutable printSignature: bool - mutable printSignatureFile: string + mutable printSignatureFile: string - mutable printAllSignatureFiles: bool + mutable printAllSignatureFiles: bool - mutable xmlDocOutputFile: string option + mutable xmlDocOutputFile: string option - mutable stats: bool + mutable stats: bool - mutable generateFilterBlocks: bool + mutable generateFilterBlocks: bool - mutable signer: string option + mutable signer: string option - mutable container: string option + mutable container: string option - mutable delaysign: bool + mutable delaysign: bool - mutable publicsign: bool + mutable publicsign: bool - mutable version: VersionFlag + mutable version: VersionFlag - mutable metadataVersion: string option + mutable metadataVersion: string option - mutable standalone: bool + mutable standalone: bool - mutable extraStaticLinkRoots: string list + mutable extraStaticLinkRoots: string list - mutable noSignatureData: bool + mutable noSignatureData: bool - mutable onlyEssentialOptimizationData: bool + mutable onlyEssentialOptimizationData: bool - mutable useOptimizationDataFile: bool + mutable useOptimizationDataFile: bool - mutable jitTracking: bool + mutable jitTracking: bool - mutable portablePDB: bool + mutable portablePDB: bool - mutable embeddedPDB: bool + mutable embeddedPDB: bool - mutable embedAllSource: bool + mutable embedAllSource: bool - mutable embedSourceList: string list + mutable embedSourceList: string list - mutable sourceLink: string + mutable sourceLink: string - mutable ignoreSymbolStoreSequencePoints: bool + mutable ignoreSymbolStoreSequencePoints: bool - mutable internConstantStrings: bool + mutable internConstantStrings: bool - mutable extraOptimizationIterations: int + mutable extraOptimizationIterations: int - mutable win32icon: string + mutable win32icon: string - mutable win32res: string + mutable win32res: string - mutable win32manifest: string + mutable win32manifest: string - mutable includewin32manifest: bool + mutable includewin32manifest: bool - mutable linkResources: string list + mutable linkResources: string list - mutable legacyReferenceResolver: LegacyReferenceResolver + mutable legacyReferenceResolver: LegacyReferenceResolver - mutable showFullPaths: bool + mutable showFullPaths: bool - mutable diagnosticStyle: DiagnosticStyle + mutable diagnosticStyle: DiagnosticStyle - mutable utf8output: bool + mutable utf8output: bool - mutable flatErrors: bool + mutable flatErrors: bool - mutable maxErrors: int + mutable maxErrors: int - mutable abortOnError: bool + mutable abortOnError: bool - mutable baseAddress: int32 option + mutable baseAddress: int32 option - mutable checksumAlgorithm: HashAlgorithm + mutable checksumAlgorithm: HashAlgorithm #if DEBUG - mutable showOptimizationData: bool + mutable showOptimizationData: bool #endif - mutable showTerms: bool + mutable showTerms: bool - mutable writeTermsToFiles: bool + mutable writeTermsToFiles: bool - mutable doDetuple: bool + mutable doDetuple: bool - mutable doTLR: bool + mutable doTLR: bool - mutable doFinalSimplify: bool + mutable doFinalSimplify: bool - mutable optsOn: bool + mutable optsOn: bool - mutable optSettings: Optimizer.OptimizationSettings + mutable optSettings: Optimizer.OptimizationSettings - mutable emitTailcalls: bool + mutable emitTailcalls: bool - mutable deterministic: bool + mutable deterministic: bool - mutable concurrentBuild: bool + mutable concurrentBuild: bool - mutable emitMetadataAssembly: MetadataAssemblyGeneration + mutable emitMetadataAssembly: MetadataAssemblyGeneration - mutable preferredUiLang: string option + mutable preferredUiLang: string option - mutable lcid: int option + mutable lcid: int option - mutable productNameForBannerText: string + mutable productNameForBannerText: string - mutable showBanner: bool + mutable showBanner: bool - mutable showTimes: bool + mutable showTimes: bool - mutable showLoadedAssemblies: bool + mutable showLoadedAssemblies: bool - mutable continueAfterParseFailure: bool + mutable continueAfterParseFailure: bool #if !NO_TYPEPROVIDERS - mutable showExtensionTypeMessages: bool + mutable showExtensionTypeMessages: bool #endif - mutable pause: bool + mutable pause: bool - mutable alwaysCallVirt: bool + mutable alwaysCallVirt: bool - mutable noDebugAttributes: bool - mutable useReflectionFreeCodeGen: bool + mutable noDebugAttributes: bool - /// If true, indicates all type checking and code generation is in the context of fsi.exe - isInteractive: bool + mutable useReflectionFreeCodeGen: bool - isInvalidationSupported: bool + /// If true, indicates all type checking and code generation is in the context of fsi.exe + isInteractive: bool - mutable emitDebugInfoInQuotations: bool + isInvalidationSupported: bool - mutable exename: string option + mutable emitDebugInfoInQuotations: bool - mutable copyFSharpCore: CopyFSharpCoreFlag + mutable exename: string option - mutable shadowCopyReferences: bool + mutable copyFSharpCore: CopyFSharpCoreFlag - mutable useSdkRefs: bool + mutable shadowCopyReferences: bool - mutable fxResolver: FxResolver option + mutable useSdkRefs: bool - mutable fsiMultiAssemblyEmit: bool + mutable fxResolver: FxResolver option - rangeForErrors: range + mutable fsiMultiAssemblyEmit: bool - sdkDirOverride: string option + rangeForErrors: range - /// A function to call to try to get an object that acts as a snapshot of the metadata section of a .NET binary, - /// and from which we can read the metadata. Only used when metadataOnly=true. - mutable tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot + sdkDirOverride: string option - /// if true - 'let mutable x = Span.Empty', the value 'x' is a stack referring span. Used for internal testing purposes only until we get true stack spans. - mutable internalTestSpanStackReferring: bool + /// A function to call to try to get an object that acts as a snapshot of the metadata section of a .NET binary, + /// and from which we can read the metadata. Only used when metadataOnly=true. + mutable tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot - /// Prevent erasure of conditional attributes and methods so tooling is able analyse them. - mutable noConditionalErasure: bool + /// if true - 'let mutable x = Span.Empty', the value 'x' is a stack referring span. Used for internal testing purposes only until we get true stack spans. + mutable internalTestSpanStackReferring: bool - mutable pathMap: PathMap + /// Prevent erasure of conditional attributes and methods so tooling is able analyse them. + mutable noConditionalErasure: bool - mutable langVersion: LanguageVersion + mutable pathMap: PathMap - mutable xmlDocInfoLoader: IXmlDocumentationInfoLoader option } + mutable langVersion: LanguageVersion + + mutable xmlDocInfoLoader: IXmlDocumentationInfoLoader option + } static member CreateNew: legacyReferenceResolver: LegacyReferenceResolver * diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index e31970c55df..8f76210f91f 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -15,7 +15,7 @@ module internal CompilerService = /// For extra diagnostics val mutable showParserStackOnParseError: bool -#endif // DEBUG +#endif /// This exception is an old-style way of reporting a diagnostic exception HashIncludeNotAllowedInNonScript of range @@ -127,4 +127,4 @@ val CollectFormattedDiagnostics: severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> - FormattedDiagnostic [] + FormattedDiagnostic[] diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 75ac5f88ba6..79f364903eb 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -6,6 +6,7 @@ module internal FSharp.Compiler.CompilerImports open System open System.Collections.Generic +open System.Collections.Immutable open System.Diagnostics open System.IO @@ -1114,7 +1115,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse MemberSignatureEquality = (fun ty1 ty2 -> typeEquivAux EraseAll g ty1 ty2) ImportProvidedType = (fun ty -> ImportProvidedType (tcImports.GetImportMap()) m ty) TryGetILModuleDef = (fun () -> Some ilModule) - TypeForwarders = Map.empty + TypeForwarders = CcuTypeForwarderTable.Empty XmlDocumentationInfo = match tcConfig.xmlDocInfoLoader with | Some xmlDocInfoLoader -> xmlDocInfoLoader.TryLoad(fileName) diff --git a/src/Compiler/Driver/CompilerImports.fsi b/src/Compiler/Driver/CompilerImports.fsi index 61d8dc1d172..052835d45bc 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/src/Compiler/Driver/CompilerImports.fsi @@ -69,20 +69,22 @@ type ResolveAssemblyReferenceMode = | ReportErrors type AssemblyResolution = - { /// The original reference to the assembly. - originalReference: AssemblyReference + { + /// The original reference to the assembly. + originalReference: AssemblyReference - /// Path to the resolvedFile - resolvedPath: string + /// Path to the resolvedFile + resolvedPath: string - /// Create the tooltip text for the assembly reference - prepareToolTip: unit -> string + /// Create the tooltip text for the assembly reference + prepareToolTip: unit -> string - /// Whether or not this is an installed system assembly (for example, System.dll) - sysdir: bool + /// Whether or not this is an installed system assembly (for example, System.dll) + sysdir: bool - /// Lazily populated ilAssemblyRef for this reference. - mutable ilAssemblyRef: ILAssemblyRef option } + /// Lazily populated ilAssemblyRef for this reference. + mutable ilAssemblyRef: ILAssemblyRef option + } #if !NO_TYPEPROVIDERS type ResolvedExtensionReference = @@ -115,7 +117,6 @@ type ImportedAssembly = #endif FSharpOptimizationData: Lazy> } - /// Tables of assembly resolutions [] type TcAssemblyResolutions = diff --git a/src/Compiler/Driver/CompilerOptions.fsi b/src/Compiler/Driver/CompilerOptions.fsi index 1d95f65c377..e5951fa66e8 100644 --- a/src/Compiler/Driver/CompilerOptions.fsi +++ b/src/Compiler/Driver/CompilerOptions.fsi @@ -87,4 +87,4 @@ val ReportTime: TcConfig -> string -> unit val GetAbbrevFlagSet: TcConfigBuilder -> bool -> Set -val PostProcessCompilerArgs: Set -> string [] -> string list +val PostProcessCompilerArgs: Set -> string[] -> string list diff --git a/src/Compiler/Driver/FxResolver.fsi b/src/Compiler/Driver/FxResolver.fsi new file mode 100644 index 00000000000..2bca0a75d8c --- /dev/null +++ b/src/Compiler/Driver/FxResolver.fsi @@ -0,0 +1,40 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler + +open System.Collections.Generic + +/// Resolves the references for a chosen or currently-executing framework, for +/// - script execution +/// - script editing +/// - script compilation +/// - out-of-project sources editing +/// - default references for fsc.exe +/// - default references for fsi.exe +type internal FxResolver = + + new: + assumeDotNetFramework: bool * + projectDir: string * + useSdkRefs: bool * + isInteractive: bool * + rangeForErrors: Text.range * + sdkDirOverride: string option -> + FxResolver + + static member ClearStaticCaches: unit -> unit + + member GetDefaultReferences: useFsiAuxLib: bool -> string list * bool + + member GetFrameworkRefsPackDirectory: unit -> string option + + member GetSystemAssemblies: unit -> HashSet + + /// Gets the selected target framework moniker, e.g netcore3.0, net472, and the running rid of the current machine + member GetTfmAndRid: unit -> string * string + + member IsInReferenceAssemblyPackDirectory: fileName: string -> bool + + member TryGetDesiredDotNetSdkVersionForDirectory: unit -> Result + + member TryGetSdkDir: unit -> string option diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 582cbc8be26..b98425605d1 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.ParseAndCheckInputs open System open System.IO +open System.Collections.Generic open Internal.Utilities.Collections open Internal.Utilities.Library @@ -727,7 +728,7 @@ let CheckSimulateException(tcConfig: TcConfig) = | Some("tc-oe") -> raise(OverflowException()) | Some("tc-atmm") -> raise(ArrayTypeMismatchException()) | Some("tc-bif") -> raise(BadImageFormatException()) - | Some("tc-knf") -> raise(System.Collections.Generic.KeyNotFoundException()) + | Some("tc-knf") -> raise(KeyNotFoundException()) | Some("tc-ior") -> raise(IndexOutOfRangeException()) | Some("tc-ic") -> raise(InvalidCastException()) | Some("tc-ip") -> raise(InvalidProgramException()) @@ -808,7 +809,7 @@ let GetInitialTcState(m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcIm ILScopeRef=ILScopeRef.Local Contents=ccuContents MemberSignatureEquality= typeEquivAux EraseAll tcGlobals - TypeForwarders=Map.empty + TypeForwarders= CcuTypeForwarderTable.Empty XmlDocumentationInfo = None } let ccu = CcuThunk.Create(ccuName, ccuData) diff --git a/src/Compiler/Driver/ScriptClosure.fsi b/src/Compiler/Driver/ScriptClosure.fsi index dfdc34f9dcd..c5deec56b64 100644 --- a/src/Compiler/Driver/ScriptClosure.fsi +++ b/src/Compiler/Driver/ScriptClosure.fsi @@ -32,41 +32,43 @@ type LoadClosureInput = [] type LoadClosure = - { /// The source files along with the ranges of the #load positions in each file. - SourceFiles: (string * range list) list + { + /// The source files along with the ranges of the #load positions in each file. + SourceFiles: (string * range list) list - /// The resolved references along with the ranges of the #r positions in each file. - References: (string * AssemblyResolution list) list + /// The resolved references along with the ranges of the #r positions in each file. + References: (string * AssemblyResolution list) list - /// The resolved pacakge references along with the ranges of the #r positions in each file. - PackageReferences: (range * string list) [] + /// The resolved pacakge references along with the ranges of the #r positions in each file. + PackageReferences: (range * string list)[] - /// Whether we're decided to use .NET Framework analysis for this script - UseDesktopFramework: bool + /// Whether we're decided to use .NET Framework analysis for this script + UseDesktopFramework: bool - /// Was the SDK directory override given? - SdkDirOverride: string option + /// Was the SDK directory override given? + SdkDirOverride: string option - /// The list of references that were not resolved during load closure. - UnresolvedReferences: UnresolvedAssemblyReference list + /// The list of references that were not resolved during load closure. + UnresolvedReferences: UnresolvedAssemblyReference list - /// The list of all sources in the closure with inputs when available, with associated parse errors and warnings - Inputs: LoadClosureInput list + /// The list of all sources in the closure with inputs when available, with associated parse errors and warnings + Inputs: LoadClosureInput list - /// The original #load references, including those that didn't resolve - OriginalLoadReferences: (range * string * string) list + /// The original #load references, including those that didn't resolve + OriginalLoadReferences: (range * string * string) list - /// The #nowarns - NoWarns: (string * range list) list + /// The #nowarns + NoWarns: (string * range list) list - /// Diagnostics seen while processing resolutions - ResolutionDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list + /// Diagnostics seen while processing resolutions + ResolutionDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list - /// Diagnostics to show for root of closure (used by fsc.fs) - AllRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list + /// Diagnostics to show for root of closure (used by fsc.fs) + AllRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list - /// Diagnostics seen while processing the compiler options implied root of closure - LoadClosureRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list } + /// Diagnostics seen while processing the compiler options implied root of closure + LoadClosureRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list + } /// Analyze a script text and find the closure of its references. /// Used from FCS, when editing a script file. diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 7ab933dc80e..12ed13273da 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -46,7 +46,7 @@ type DiagnosticsLoggerUpToMaxErrors = /// The main (non-incremental) compilation entry point used by fsc.exe val CompileFromCommandLineArguments: ctok: CompilationThreadToken * - argv: string [] * + argv: string[] * legacyReferenceResolver: LegacyReferenceResolver * bannerAlreadyPrinted: bool * reduceMemoryUsage: ReduceMemoryFlag * diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index a7a9b3d0ecb..690cbc3c837 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -279,11 +279,17 @@ Facilities/SimulatedMSBuildReferenceResolver.fs - - Facilities\CompilerLocationUtils.fsi + + Facilities\CompilerLocation.fsi - - Facilities\CompilerLocationUtils.fs + + Facilities\CompilerLocation.fs + + + Facilities\BuildGraph.fsi + + + Facilities\BuildGraph.fs --unicode --lexlib Internal.Utilities.Text.Lexing @@ -501,6 +507,9 @@ TypedTree\CompilerGlobalState.fs + + TypedTree\TypedTree.fsi + TypedTree\TypedTree.fs @@ -723,6 +732,9 @@ CodeGen\IlxGen.fs + + Driver\FxResolver.fsi + Driver\FxResolver.fs @@ -744,12 +756,6 @@ Driver\DependencyProvider.fs - - Driver\BuildGraph.fsi - - - Driver\BuildGraph.fs - Driver\CompilerConfig.fsi diff --git a/src/Compiler/Driver/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs similarity index 100% rename from src/Compiler/Driver/BuildGraph.fs rename to src/Compiler/Facilities/BuildGraph.fs diff --git a/src/Compiler/Driver/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi similarity index 99% rename from src/Compiler/Driver/BuildGraph.fsi rename to src/Compiler/Facilities/BuildGraph.fsi index 169164d6ff5..ef0319fabec 100644 --- a/src/Compiler/Driver/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -63,7 +63,7 @@ type NodeCode = static member CancellationToken: NodeCode - static member Sequential: computations: NodeCode<'T> seq -> NodeCode<'T []> + static member Sequential: computations: NodeCode<'T> seq -> NodeCode<'T[]> /// Execute the cancellable computation synchronously using the ambient cancellation token of /// the NodeCode. diff --git a/src/Compiler/Facilities/CompilerLocationUtils.fs b/src/Compiler/Facilities/CompilerLocation.fs similarity index 100% rename from src/Compiler/Facilities/CompilerLocationUtils.fs rename to src/Compiler/Facilities/CompilerLocation.fs diff --git a/src/Compiler/Facilities/CompilerLocationUtils.fsi b/src/Compiler/Facilities/CompilerLocation.fsi similarity index 94% rename from src/Compiler/Facilities/CompilerLocationUtils.fsi rename to src/Compiler/Facilities/CompilerLocation.fsi index 6015caf2d81..cbf397883ac 100644 --- a/src/Compiler/Facilities/CompilerLocationUtils.fsi +++ b/src/Compiler/Facilities/CompilerLocation.fsi @@ -57,8 +57,8 @@ module internal FSharpEnvironment = val getDotnetHostPath: unit -> string option - val getDotnetHostDirectories: unit -> string [] + val getDotnetHostDirectories: unit -> string[] val getDotnetHostDirectory: unit -> string option - val getDotnetHostSubDirectories: string -> DirectoryInfo [] + val getDotnetHostSubDirectories: string -> DirectoryInfo[] diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index e95e6f10804..a5f2e8bb1fd 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -58,10 +58,10 @@ type LanguageVersion = member SupportsFeature: LanguageFeature -> bool /// Get the list of valid versions - member ValidVersions: string [] + member ValidVersions: string[] /// Get the list of valid options - member ValidOptions: string [] + member ValidOptions: string[] /// Get the specified LanguageVersion member SpecifiedVersion: decimal diff --git a/src/Compiler/Facilities/ReferenceResolver.fsi b/src/Compiler/Facilities/ReferenceResolver.fsi index 69d572818fb..619c21d423c 100644 --- a/src/Compiler/Facilities/ReferenceResolver.fsi +++ b/src/Compiler/Facilities/ReferenceResolver.fsi @@ -15,14 +15,16 @@ type internal LegacyResolutionEnvironment = | CompilationAndEvaluation type internal LegacyResolvedFile = - { /// Item specification. - itemSpec: string + { + /// Item specification. + itemSpec: string - /// Prepare textual information about where the assembly was resolved from, used for tooltip output - prepareToolTip: string * string -> string + /// Prepare textual information about where the assembly was resolved from, used for tooltip output + prepareToolTip: string * string -> string - /// Round-tripped baggage - baggage: string } + /// Round-tripped baggage + baggage: string + } [] type internal ILegacyReferenceResolver = @@ -37,7 +39,7 @@ type internal ILegacyReferenceResolver = /// Perform assembly resolution on the given references under the given conditions abstract Resolve: resolutionEnvironment: LegacyResolutionEnvironment * - references: (string * string) [] * + references: (string * string)[] * targetFrameworkVersion: string * targetFrameworkDirectories: string list * targetProcessorArchitecture: string * @@ -46,7 +48,7 @@ type internal ILegacyReferenceResolver = implicitIncludeDir: string * logMessage: (string -> unit) * logDiagnostic: (bool -> string -> string -> unit) -> - LegacyResolvedFile [] + LegacyResolvedFile[] /// Get the Reference Assemblies directory for the .NET Framework (on Windows) /// This is added to the default resolution path for diff --git a/src/Compiler/Facilities/TextLayoutRender.fsi b/src/Compiler/Facilities/TextLayoutRender.fsi index 59fd4f60266..1af7571cf75 100644 --- a/src/Compiler/Facilities/TextLayoutRender.fsi +++ b/src/Compiler/Facilities/TextLayoutRender.fsi @@ -26,7 +26,7 @@ type internal NoResult = NoResult module internal LayoutRender = - val internal toArray: Layout -> TaggedText [] + val internal toArray: Layout -> TaggedText[] val internal emitL: (TaggedText -> unit) -> Layout -> unit diff --git a/src/Compiler/Facilities/prim-lexing.fsi b/src/Compiler/Facilities/prim-lexing.fsi index 01cb909f371..290b48b53e8 100644 --- a/src/Compiler/Facilities/prim-lexing.fsi +++ b/src/Compiler/Facilities/prim-lexing.fsi @@ -33,7 +33,7 @@ type ISourceText = abstract ContentEquals: sourceText: ISourceText -> bool /// Copies a section of the input to the given destination ad the given index - abstract CopyTo: sourceIndex: int * destination: char [] * destinationIndex: int * count: int -> unit + abstract CopyTo: sourceIndex: int * destination: char[] * destinationIndex: int * count: int -> unit /// Functions related to ISourceText objects module SourceText = @@ -138,11 +138,11 @@ type internal LexBuffer<'Char> = /// Create a lex buffer suitable for Unicode lexing that reads characters from the given array. /// Important: does take ownership of the array. - static member FromChars: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * char [] -> LexBuffer + static member FromChars: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * char[] -> LexBuffer /// Create a lex buffer that reads character or byte inputs by using the given function. static member FromFunction: - reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * ('Char [] * int * int -> int) -> + reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * ('Char[] * int * int -> int) -> LexBuffer<'Char> /// Create a lex buffer backed by source text. @@ -154,7 +154,7 @@ type internal LexBuffer<'Char> = type internal UnicodeTables = /// Create the tables from raw data - static member Create: uint16 [] [] * uint16 [] -> UnicodeTables + static member Create: uint16[][] * uint16[] -> UnicodeTables /// Interpret tables for a unicode lexer generated by fslex.exe. member Interpret: initialState: int * LexBuffer -> int diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 70e56990e98..1a79a6e94f8 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -2309,7 +2309,6 @@ module internal MagicAssemblyResolution = // It is an explicit user trust decision to load an assembly with #r. Scripts are not run automatically (for example, by double-clicking in explorer). // We considered setting loadFromRemoteSources in fsi.exe.config but this would transitively confer unsafe loading to the code in the referenced // assemblies. Better to let those assemblies decide for themselves which is safer. - [] let private assemblyLoadFrom (path:string) = Assembly.UnsafeLoadFrom(path) let ResolveAssembly (ctok, m, tcConfigB, tcImports: TcImports, fsiDynamicCompiler: FsiDynamicCompiler, fsiConsoleOutput: FsiConsoleOutput, fullAssemName: string) = @@ -3591,7 +3590,6 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i /// /// A background thread is started by this thread to read from the inReader and/or console reader. - [] member x.Run() = progress <- condition "FSHARP_INTERACTIVE_PROGRESS" diff --git a/src/Compiler/Interactive/fsi.fsi b/src/Compiler/Interactive/fsi.fsi index 16b337c0d01..3288c379fe0 100644 --- a/src/Compiler/Interactive/fsi.fsi +++ b/src/Compiler/Interactive/fsi.fsi @@ -87,7 +87,7 @@ type public FsiEvaluationSessionHostConfig = /// The evaluation session calls this to report the preferred view of the command line arguments after /// stripping things like "/use:file.fsx", "-r:Foo.dll" etc. - abstract ReportUserCommandLineArgs: string [] -> unit + abstract ReportUserCommandLineArgs: string[] -> unit /// Hook for listening for evaluation bindings member OnEvaluation: IEvent @@ -132,8 +132,8 @@ type public FsiEvaluationSessionHostConfig = [] type FsiCompilationException = inherit Exception - new: string * FSharpDiagnostic [] option -> FsiCompilationException - member ErrorInfos: FSharpDiagnostic [] option + new: string * FSharpDiagnostic[] option -> FsiCompilationException + member ErrorInfos: FSharpDiagnostic[] option /// Represents an F# Interactive evaluation session. [] @@ -152,7 +152,7 @@ type FsiEvaluationSession = /// An optional resolver for legacy MSBuild references static member Create: fsiConfig: FsiEvaluationSessionHostConfig * - argv: string [] * + argv: string[] * inReader: TextReader * outWriter: TextWriter * errorWriter: TextWriter * @@ -186,7 +186,7 @@ type FsiEvaluationSession = /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered /// by input from 'stdin'. member EvalInteractionNonThrowing: - code: string * ?cancellationToken: CancellationToken -> Choice * FSharpDiagnostic [] + code: string * ?cancellationToken: CancellationToken -> Choice * FSharpDiagnostic[] /// Execute the given script. Stop on first error, discarding the rest /// of the script. Errors are sent to the output writer, a 'true' return value indicates there @@ -202,7 +202,7 @@ type FsiEvaluationSession = /// /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered /// by input from 'stdin'. - member EvalScriptNonThrowing: filePath: string -> Choice * FSharpDiagnostic [] + member EvalScriptNonThrowing: filePath: string -> Choice * FSharpDiagnostic[] /// Execute the code as if it had been entered as one or more interactions, with an /// implicit termination at the end of the input. Stop on first error, discarding the rest @@ -221,7 +221,7 @@ type FsiEvaluationSession = /// /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered /// by input from 'stdin'. - member EvalExpressionNonThrowing: code: string -> Choice * FSharpDiagnostic [] + member EvalExpressionNonThrowing: code: string -> Choice * FSharpDiagnostic[] /// Format a value to a string using the current PrintDepth, PrintLength etc settings provided by the active fsi configuration object member FormatValue: reflectionValue: obj * reflectionType: Type -> string @@ -251,7 +251,7 @@ type FsiEvaluationSession = member CurrentPartialAssemblySignature: FSharpAssemblySignature /// Get all the dynamically generated assemblies - member DynamicAssemblies: System.Reflection.Assembly [] + member DynamicAssemblies: System.Reflection.Assembly[] /// A host calls this to determine if the --gui parameter is active member IsGui: bool @@ -354,13 +354,12 @@ module Settings = member internal AddedPrinters: Choice string), Type * (obj -> obj)> list - /// The command line arguments after ignoring the arguments relevant to the interactive /// environment and replacing the first argument with the name of the last script file, /// if any. Thus 'fsi.exe test1.fs test2.fs -- hello goodbye' will give arguments /// 'test2.fs', 'hello', 'goodbye'. This value will normally be different to those /// returned by System.Environment.GetCommandLineArgs. - member CommandLineArgs: string [] with get, set + member CommandLineArgs: string[] with get, set /// Gets or sets a the current event loop being used to process interactions. member EventLoop: IEventLoop with get, set diff --git a/src/Compiler/Optimize/DetupleArgs.fsi b/src/Compiler/Optimize/DetupleArgs.fsi index cf59935ea6d..4dc7c1ac487 100644 --- a/src/Compiler/Optimize/DetupleArgs.fsi +++ b/src/Compiler/Optimize/DetupleArgs.fsi @@ -14,22 +14,24 @@ module GlobalUsageAnalysis = type accessor type Results = - { /// v -> context / APP inst args - Uses: Zmap + { + /// v -> context / APP inst args + Uses: Zmap - /// v -> binding repr - Defns: Zmap + /// v -> binding repr + Defns: Zmap - /// bound in a decision tree? - DecisionTreeBindings: Zset + /// bound in a decision tree? + DecisionTreeBindings: Zset - /// v -> recursive? * v list -- the others in the mutual binding - RecursiveBindings: Zmap + /// v -> recursive? * v list -- the others in the mutual binding + RecursiveBindings: Zmap - /// val not defined under lambdas - TopLevelBindings: Zset + /// val not defined under lambdas + TopLevelBindings: Zset - /// top of expr toplevel? (true) - IterationIsAtTopLevel: bool } + /// top of expr toplevel? (true) + IterationIsAtTopLevel: bool + } val GetUsageInfoOfImplFile: TcGlobals -> CheckedImplFile -> Results diff --git a/src/Compiler/Optimize/Optimizer.fsi b/src/Compiler/Optimize/Optimizer.fsi index 1fceb0d2b68..76b7881f487 100644 --- a/src/Compiler/Optimize/Optimizer.fsi +++ b/src/Compiler/Optimize/Optimizer.fsi @@ -10,36 +10,37 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreePickle type OptimizationSettings = - { abstractBigTargets: bool + { + abstractBigTargets: bool - jitOptUser: bool option + jitOptUser: bool option - localOptUser: bool option + localOptUser: bool option - debugPointsForPipeRight: bool option + debugPointsForPipeRight: bool option - crossAssemblyOptimizationUser: bool option + crossAssemblyOptimizationUser: bool option - /// size after which we start chopping methods in two, though only at match targets - bigTargetSize: int + /// size after which we start chopping methods in two, though only at match targets + bigTargetSize: int - /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations - veryBigExprSize: int + /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations + veryBigExprSize: int - /// The size after which we don't inline - lambdaInlineThreshold: int + /// The size after which we don't inline + lambdaInlineThreshold: int - /// For unit testing - reportingPhase: bool + /// For unit testing + reportingPhase: bool - reportNoNeedToTailcall: bool + reportNoNeedToTailcall: bool - reportFunctionSizes: bool + reportFunctionSizes: bool - reportHasEffect: bool - - reportTotalSizes: bool } + reportHasEffect: bool + reportTotalSizes: bool + } member JitOptimizationsEnabled: bool diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index b1e754f38e0..dd8a4aee65a 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -42,45 +42,46 @@ type public FSharpUnresolvedReferencesSet = internal FSharpUnresolvedReferencesS /// A set of information describing a project or script build configuration. type public FSharpProjectOptions = { - // Note that this may not reduce to just the project directory, because there may be two projects in the same directory. - ProjectFileName: string + // Note that this may not reduce to just the project directory, because there may be two projects in the same directory. + ProjectFileName: string - /// This is the unique identifier for the project, it is case sensitive. If it's None, will key off of ProjectFileName in our caching. - ProjectId: string option + /// This is the unique identifier for the project, it is case sensitive. If it's None, will key off of ProjectFileName in our caching. + ProjectId: string option - /// The files in the project - SourceFiles: string [] + /// The files in the project + SourceFiles: string[] - /// Additional command line argument options for the project. These can include additional files and references. - OtherOptions: string [] + /// Additional command line argument options for the project. These can include additional files and references. + OtherOptions: string[] - /// The command line arguments for the other projects referenced by this project, indexed by the - /// exact text used in the "-r:" reference in FSharpProjectOptions. - ReferencedProjects: FSharpReferencedProject [] + /// The command line arguments for the other projects referenced by this project, indexed by the + /// exact text used in the "-r:" reference in FSharpProjectOptions. + ReferencedProjects: FSharpReferencedProject[] - /// When true, the typechecking environment is known a priori to be incomplete, for - /// example when a .fs file is opened outside of a project. In this case, the number of error - /// messages reported is reduced. - IsIncompleteTypeCheckEnvironment: bool + /// When true, the typechecking environment is known a priori to be incomplete, for + /// example when a .fs file is opened outside of a project. In this case, the number of error + /// messages reported is reduced. + IsIncompleteTypeCheckEnvironment: bool - /// When true, use the reference resolution rules for scripts rather than the rules for compiler. - UseScriptResolutionRules: bool + /// When true, use the reference resolution rules for scripts rather than the rules for compiler. + UseScriptResolutionRules: bool - /// Timestamp of project/script load, used to differentiate between different instances of a project load. - /// This ensures that a complete reload of the project or script type checking - /// context occurs on project or script unload/reload. - LoadTime: DateTime + /// Timestamp of project/script load, used to differentiate between different instances of a project load. + /// This ensures that a complete reload of the project or script type checking + /// context occurs on project or script unload/reload. + LoadTime: DateTime - /// Unused in this API and should be 'None' when used as user-specified input - UnresolvedReferences: FSharpUnresolvedReferencesSet option + /// Unused in this API and should be 'None' when used as user-specified input + UnresolvedReferences: FSharpUnresolvedReferencesSet option - /// Unused in this API and should be '[]' when used as user-specified input - OriginalLoadReferences: (range * string * string) list + /// Unused in this API and should be '[]' when used as user-specified input + OriginalLoadReferences: (range * string * string) list - /// An optional stamp to uniquely identify this set of options - /// If two sets of options both have stamps, then they are considered equal - /// if and only if the stamps are equal - Stamp: int64 option } + /// An optional stamp to uniquely identify this set of options + /// If two sets of options both have stamps, then they are considered equal + /// if and only if the stamps are equal + Stamp: int64 option + } /// Whether the two parse options refer to the same project. static member internal UseSameProject: options1: FSharpProjectOptions * options2: FSharpProjectOptions -> bool @@ -199,7 +200,7 @@ type public FSharpProjectContext = /// Options used to determine active --define conditionals and other options relevant to parsing files in a project type public FSharpParsingOptions = - { SourceFiles: string [] + { SourceFiles: string[] ConditionalDefines: string list DiagnosticOptions: FSharpDiagnosticOptions LangVersionText: string @@ -211,16 +212,16 @@ type public FSharpParsingOptions = static member Default: FSharpParsingOptions static member internal FromTcConfig: - tcConfig: TcConfig * sourceFiles: string [] * isInteractive: bool -> FSharpParsingOptions + tcConfig: TcConfig * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions static member internal FromTcConfigBuilder: - tcConfigB: TcConfigBuilder * sourceFiles: string [] * isInteractive: bool -> FSharpParsingOptions + tcConfigB: TcConfigBuilder * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions /// A handle to the results of CheckFileInProject. [] type public FSharpCheckFileResults = /// The errors returned by parsing a source file. - member Diagnostics: FSharpDiagnostic [] + member Diagnostics: FSharpDiagnostic[] /// Get a view of the contents of the assembly up to and including the file just checked member PartialAssemblySignature: FSharpAssemblySignature @@ -238,7 +239,7 @@ type public FSharpCheckFileResults = /// Indicates the set of files which must be watched to accurately track changes that affect these results, /// Clients interested in reacting to updates to these files should watch these files and take actions as described /// in the documentation for compiler service. - member DependencyFiles: string [] + member DependencyFiles: string[] /// Get the items for a declaration list /// @@ -360,22 +361,22 @@ type public FSharpCheckFileResults = line: int * colAtEndOfNames: int * lineText: string * names: string list -> FSharpSymbolUse option /// Get any extra colorization info that is available after the typecheck - member GetSemanticClassification: range option -> SemanticClassificationItem [] + member GetSemanticClassification: range option -> SemanticClassificationItem[] /// Get the locations of format specifiers [] - member GetFormatSpecifierLocations: unit -> range [] + member GetFormatSpecifierLocations: unit -> range[] /// Get the locations of and number of arguments associated with format specifiers - member GetFormatSpecifierLocationsAndArity: unit -> (range * int) [] + member GetFormatSpecifierLocationsAndArity: unit -> (range * int)[] /// Get all textual usages of all symbols throughout the file member GetAllUsesOfAllSymbolsInFile: ?cancellationToken: CancellationToken -> seq /// Get the textual usages that resolved to the given symbol throughout the file - member GetUsesOfSymbolInFile: symbol: FSharpSymbol * ?cancellationToken: CancellationToken -> FSharpSymbolUse [] + member GetUsesOfSymbolInFile: symbol: FSharpSymbol * ?cancellationToken: CancellationToken -> FSharpSymbolUse[] - member internal GetVisibleNamespacesAndModulesAtPoint: pos -> ModuleOrNamespaceRef [] + member internal GetVisibleNamespacesAndModulesAtPoint: pos -> ModuleOrNamespaceRef[] /// Find the most precise display environment for the given line and column. member GetDisplayContextForPos: cursorPos: pos -> FSharpDisplayContext option @@ -390,14 +391,14 @@ type public FSharpCheckFileResults = member ImplementationFile: FSharpImplementationFileContents option /// Open declarations in the file, including auto open modules. - member OpenDeclarations: FSharpOpenDeclaration [] + member OpenDeclarations: FSharpOpenDeclaration[] /// Lays out and returns the formatted signature for the typechecked file as source text. member GenerateSignature: unit -> ISourceText option /// Internal constructor static member internal MakeEmpty: - fileName: string * creationErrors: FSharpDiagnostic [] * keepAssemblyContents: bool -> FSharpCheckFileResults + fileName: string * creationErrors: FSharpDiagnostic[] * keepAssemblyContents: bool -> FSharpCheckFileResults /// Internal constructor static member internal Make: @@ -408,10 +409,10 @@ type public FSharpCheckFileResults = isIncompleteTypeCheckEnvironment: bool * builder: IncrementalBuilder * projectOptions: FSharpProjectOptions * - dependencyFiles: string [] * - creationErrors: FSharpDiagnostic [] * - parseErrors: FSharpDiagnostic [] * - tcErrors: FSharpDiagnostic [] * + dependencyFiles: string[] * + creationErrors: FSharpDiagnostic[] * + parseErrors: FSharpDiagnostic[] * + tcErrors: FSharpDiagnostic[] * keepAssemblyContents: bool * ccuSigForFile: ModuleOrNamespaceType * thisCcu: CcuThunk * @@ -422,7 +423,7 @@ type public FSharpCheckFileResults = sFallback: NameResolutionEnv * loadClosure: LoadClosure option * implFileOpt: CheckedImplFile option * - openDeclarations: OpenDeclaration [] -> + openDeclarations: OpenDeclaration[] -> FSharpCheckFileResults /// Internal constructor - check a file and collect errors @@ -437,13 +438,13 @@ type public FSharpCheckFileResults = tcState: TcState * moduleNamesDict: ModuleNamesDict * loadClosure: LoadClosure option * - backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] * + backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[] * isIncompleteTypeCheckEnvironment: bool * projectOptions: FSharpProjectOptions * builder: IncrementalBuilder * - dependencyFiles: string [] * - creationErrors: FSharpDiagnostic [] * - parseErrors: FSharpDiagnostic [] * + dependencyFiles: string[] * + creationErrors: FSharpDiagnostic[] * + parseErrors: FSharpDiagnostic[] * keepAssemblyContents: bool * suggestNamesForErrors: bool -> Cancellable @@ -461,7 +462,7 @@ and [] public FSharpCheckFileAnswer = type public FSharpCheckProjectResults = /// The errors returned by processing the project - member Diagnostics: FSharpDiagnostic [] + member Diagnostics: FSharpDiagnostic[] /// Get a view of the overall signature of the assembly. Only valid to use if HasCriticalErrors is false. member AssemblySignature: FSharpAssemblySignature @@ -476,10 +477,10 @@ type public FSharpCheckProjectResults = member ProjectContext: FSharpProjectContext /// Get the textual usages that resolved to the given symbol throughout the project - member GetUsesOfSymbol: symbol: FSharpSymbol * ?cancellationToken: CancellationToken -> FSharpSymbolUse [] + member GetUsesOfSymbol: symbol: FSharpSymbol * ?cancellationToken: CancellationToken -> FSharpSymbolUse[] /// Get all textual usages of all symbols throughout the project - member GetAllUsesOfAllSymbols: ?cancellationToken: CancellationToken -> FSharpSymbolUse [] + member GetAllUsesOfAllSymbols: ?cancellationToken: CancellationToken -> FSharpSymbolUse[] /// Indicates if critical errors existed in the project options member HasCriticalErrors: bool @@ -487,15 +488,15 @@ type public FSharpCheckProjectResults = /// Indicates the set of files which must be watched to accurately track changes that affect these results, /// Clients interested in reacting to updates to these files should watch these files and take actions as described /// in the documentation for compiler service. - member DependencyFiles: string [] + member DependencyFiles: string[] // Internal constructor. internal new: projectFileName: string * tcConfigOption: TcConfig option * keepAssemblyContents: bool * - diagnostics: FSharpDiagnostic [] * - details: (TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * Choice * TopAttribs option * (unit -> IRawFSharpAssemblyData option) * ILAssemblyRef * AccessorDomain * CheckedImplFile list option * string [] * FSharpProjectOptions) option -> + diagnostics: FSharpDiagnostic[] * + details: (TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * Choice * TopAttribs option * (unit -> IRawFSharpAssemblyData option) * ILAssemblyRef * AccessorDomain * CheckedImplFile list option * string[] * FSharpProjectOptions) option -> FSharpCheckProjectResults module internal ParseAndCheckFile = @@ -506,7 +507,7 @@ module internal ParseAndCheckFile = options: FSharpParsingOptions * userOpName: string * suggestNamesForErrors: bool -> - FSharpDiagnostic [] * ParsedInput * bool + FSharpDiagnostic[] * ParsedInput * bool val matchBraces: sourceText: ISourceText * @@ -514,7 +515,7 @@ module internal ParseAndCheckFile = options: FSharpParsingOptions * userOpName: string * suggestNamesForErrors: bool -> - (range * range) [] + (range * range)[] // An object to typecheck source in a given typechecking environment. // Used internally to provide intellisense over F# Interactive. diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 9ee0e816b52..f1f49b911a5 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -531,7 +531,8 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | SynExpr.Null _ | SynExpr.Ident _ | SynExpr.ImplicitZero _ - | SynExpr.Const _ -> + | SynExpr.Const _ + | SynExpr.Dynamic _ -> () | SynExpr.Quote (_, _, e, _, _) diff --git a/src/Compiler/Service/FSharpParseFileResults.fsi b/src/Compiler/Service/FSharpParseFileResults.fsi index 55e4294342e..f160c7fa8fa 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fsi +++ b/src/Compiler/Service/FSharpParseFileResults.fsi @@ -74,14 +74,14 @@ type public FSharpParseFileResults = member ValidateBreakpointLocation: pos: pos -> range option /// When these files change then the build is invalid - member DependencyFiles: string [] + member DependencyFiles: string[] /// Get the errors and warnings for the parse - member Diagnostics: FSharpDiagnostic [] + member Diagnostics: FSharpDiagnostic[] /// Indicates if any errors occurred during the parse member ParseHadErrors: bool internal new: - diagnostics: FSharpDiagnostic [] * input: ParsedInput * parseHadErrors: bool * dependencyFiles: string [] -> + diagnostics: FSharpDiagnostic[] * input: ParsedInput * parseHadErrors: bool * dependencyFiles: string[] -> FSharpParseFileResults diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index dd678cc3bb3..317bc2b8c96 100755 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -46,41 +46,45 @@ module internal IncrementalBuilderEventTesting = /// Accumulated results of type checking. The minimum amount of state in order to continue type-checking following files. [] type internal TcInfo = - { tcState: TcState - tcEnvAtEndOfFile: CheckExpressions.TcEnv + { + tcState: TcState + tcEnvAtEndOfFile: CheckExpressions.TcEnv - /// Disambiguation table for module names - moduleNamesDict: ModuleNamesDict + /// Disambiguation table for module names + moduleNamesDict: ModuleNamesDict - topAttribs: TopAttribs option + topAttribs: TopAttribs option - latestCcuSigForFile: ModuleOrNamespaceType option + latestCcuSigForFile: ModuleOrNamespaceType option - /// Accumulated errors, last file first - tcDiagnosticsRev: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] list + /// Accumulated errors, last file first + tcDiagnosticsRev: (PhasedDiagnostic * FSharpDiagnosticSeverity)[] list - tcDependencyFiles: string list + tcDependencyFiles: string list - sigNameOpt: (string * QualifiedNameOfFile) option } + sigNameOpt: (string * QualifiedNameOfFile) option + } /// Accumulated diagnostics - member TcDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + member TcDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[] /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] type internal TcInfoExtras = - { tcResolutions: TcResolutions - tcSymbolUses: TcSymbolUses - tcOpenDeclarations: OpenDeclaration [] + { + tcResolutions: TcResolutions + tcSymbolUses: TcSymbolUses + tcOpenDeclarations: OpenDeclaration[] - /// Result of checking most recent file, if any - latestImplFile: CheckedImplFile option + /// Result of checking most recent file, if any + latestImplFile: CheckedImplFile option - /// If enabled, stores a linear list of ranges and strings that identify an Item(symbol) in a file. Used for background find all references. - itemKeyStore: ItemKeyStore option + /// If enabled, stores a linear list of ranges and strings that identify an Item(symbol) in a file. Used for background find all references. + itemKeyStore: ItemKeyStore option - /// If enabled, holds semantic classification information for Item(symbol)s in a file. - semanticClassificationKeyStore: SemanticClassificationKeyStore option } + /// If enabled, holds semantic classification information for Item(symbol)s in a file. + semanticClassificationKeyStore: SemanticClassificationKeyStore option + } member TcSymbolUses: TcSymbolUses @@ -160,7 +164,7 @@ type internal IncrementalBuilder = member IsReferencesInvalidated: bool /// The list of files the build depends on - member AllDependenciesDeprecated: string [] + member AllDependenciesDeprecated: string[] /// The project build. Return true if the background work is finished. member PopulatePartialCheckingResults: unit -> NodeCode @@ -237,7 +241,7 @@ type internal IncrementalBuilder = /// /// This may be a marginally long-running operation (parses are relatively quick, only one file needs to be parsed) member GetParseResultsForFile: - fileName: string -> ParsedInput * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + fileName: string -> ParsedInput * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity)[] /// Create the incremental builder static member TryCreateIncrementalBuilderForProjectOptions: @@ -258,7 +262,7 @@ type internal IncrementalBuilder = enableBackgroundItemKeyStoreAndSemanticClassification: bool * enablePartialTypeChecking: bool * dependencyProvider: DependencyProvider option -> - NodeCode + NodeCode /// Generalized Incremental Builder. This is exposed only for unit testing purposes. module internal IncrementalBuild = diff --git a/src/Compiler/Service/QuickParse.fsi b/src/Compiler/Service/QuickParse.fsi index 02c559861bd..c2ecb049da7 100644 --- a/src/Compiler/Service/QuickParse.fsi +++ b/src/Compiler/Service/QuickParse.fsi @@ -7,17 +7,19 @@ open Internal.Utilities.Library /// Qualified long name. type public PartialLongName = - { /// Qualifying idents, prior to the last dot, not including the last part. - QualifyingIdents: string list + { + /// Qualifying idents, prior to the last dot, not including the last part. + QualifyingIdents: string list - /// Last part of long ident. - PartialIdent: string + /// Last part of long ident. + PartialIdent: string - /// The column number at the end of full partial name. - EndColumn: int + /// The column number at the end of full partial name. + EndColumn: int - /// Position of the last dot. - LastDotPos: int option } + /// Position of the last dot. + LastDotPos: int option + } /// Empty partial long name. static member Empty: endColumn: int -> PartialLongName @@ -81,4 +83,4 @@ module public QuickParse = val GetPartialLongNameEx: lineStr: string MaybeNull * index: int -> PartialLongName /// Tests whether the user is typing something like "member x." or "override (*comment*) x." - val TestMemberOrOverrideDeclaration: tokens: FSharpTokenInfo [] -> bool + val TestMemberOrOverrideDeclaration: tokens: FSharpTokenInfo[] -> bool diff --git a/src/Compiler/Service/SemanticClassification.fsi b/src/Compiler/Service/SemanticClassification.fsi index 1180120d8c0..ce5d6d88aeb 100644 --- a/src/Compiler/Service/SemanticClassification.fsi +++ b/src/Compiler/Service/SemanticClassification.fsi @@ -65,5 +65,5 @@ module internal TcResolutionsExtensions = type TcResolutions with member GetSemanticClassification: - g: TcGlobals * amap: ImportMap * formatSpecifierLocations: (range * int) [] * range: range option -> - SemanticClassificationItem [] + g: TcGlobals * amap: ImportMap * formatSpecifierLocations: (range * int)[] * range: range option -> + SemanticClassificationItem[] diff --git a/src/Compiler/Service/SemanticClassificationKey.fsi b/src/Compiler/Service/SemanticClassificationKey.fsi index 6955895e950..7101fa80002 100644 --- a/src/Compiler/Service/SemanticClassificationKey.fsi +++ b/src/Compiler/Service/SemanticClassificationKey.fsi @@ -20,13 +20,12 @@ type internal SemanticClassificationKeyStore = /// Get a read only view on the semantic classification key store member GetView: unit -> SemanticClassificationView - /// A builder that will build an semantic classification key store based on the written Item and its associated range. [] type internal SemanticClassificationKeyStoreBuilder = new: unit -> SemanticClassificationKeyStoreBuilder - member WriteAll: SemanticClassificationItem [] -> unit + member WriteAll: SemanticClassificationItem[] -> unit member TryBuildAndReset: unit -> SemanticClassificationKeyStore option diff --git a/src/Compiler/Service/ServiceAnalysis.fsi b/src/Compiler/Service/ServiceAnalysis.fsi index 30d97c6c68b..672cf088759 100644 --- a/src/Compiler/Service/ServiceAnalysis.fsi +++ b/src/Compiler/Service/ServiceAnalysis.fsi @@ -15,11 +15,13 @@ module public SimplifyNames = /// Data for use in finding unnecessarily-qualified names and generating diagnostics to simplify them type SimplifiableRange = - { /// The range of a name that can be simplified - Range: range + { + /// The range of a name that can be simplified + Range: range - /// The relative name that can be applied to a simplifiable name - RelativeName: string } + /// The relative name that can be applied to a simplifiable name + RelativeName: string + } /// Get all ranges that can be simplified in a file val getSimplifiableNames: diff --git a/src/Compiler/Service/ServiceAssemblyContent.fsi b/src/Compiler/Service/ServiceAssemblyContent.fsi index cea1c47339d..09756eee2e5 100644 --- a/src/Compiler/Service/ServiceAssemblyContent.fsi +++ b/src/Compiler/Service/ServiceAssemblyContent.fsi @@ -25,44 +25,48 @@ type public AssemblyPath = string /// Represents type, module, member, function or value in a compiled assembly. [] type public AssemblySymbol = - { /// Full entity name as it's seen in compiled code (raw FSharpEntity.FullName, FSharpValueOrFunction.FullName). - FullName: string + { + /// Full entity name as it's seen in compiled code (raw FSharpEntity.FullName, FSharpValueOrFunction.FullName). + FullName: string - /// Entity name parts with removed module suffixes (Ns.M1Module.M2Module.M3.entity -> Ns.M1.M2.M3.entity) - /// and replaced compiled names with display names (FSharpEntity.DisplayName, FSharpValueOrFunction.DisplayName). - /// Note: *all* parts are cleaned, not the last one. - CleanedIdents: ShortIdents + /// Entity name parts with removed module suffixes (Ns.M1Module.M2Module.M3.entity -> Ns.M1.M2.M3.entity) + /// and replaced compiled names with display names (FSharpEntity.DisplayName, FSharpValueOrFunction.DisplayName). + /// Note: *all* parts are cleaned, not the last one. + CleanedIdents: ShortIdents - /// `FSharpEntity.Namespace`. - Namespace: ShortIdents option + /// `FSharpEntity.Namespace`. + Namespace: ShortIdents option - /// The most narrative parent module that has `RequireQualifiedAccess` attribute. - NearestRequireQualifiedAccessParent: ShortIdents option + /// The most narrative parent module that has `RequireQualifiedAccess` attribute. + NearestRequireQualifiedAccessParent: ShortIdents option - /// Parent module that has the largest scope and has `RequireQualifiedAccess` attribute. - TopRequireQualifiedAccessParent: ShortIdents option + /// Parent module that has the largest scope and has `RequireQualifiedAccess` attribute. + TopRequireQualifiedAccessParent: ShortIdents option - /// Parent module that has `AutoOpen` attribute. - AutoOpenParent: ShortIdents option + /// Parent module that has `AutoOpen` attribute. + AutoOpenParent: ShortIdents option - Symbol: FSharpSymbol + Symbol: FSharpSymbol - /// Function that returns `EntityKind` based of given `LookupKind`. - Kind: LookupType -> EntityKind + /// Function that returns `EntityKind` based of given `LookupKind`. + Kind: LookupType -> EntityKind - /// Cache display name and namespace, used for completion. - UnresolvedSymbol: UnresolvedSymbol } + /// Cache display name and namespace, used for completion. + UnresolvedSymbol: UnresolvedSymbol + } /// `RawEntity` list retrieved from an assembly. type internal AssemblyContentCacheEntry = - { /// Assembly file last write time. - FileWriteTime: DateTime + { + /// Assembly file last write time. + FileWriteTime: DateTime - /// Content type used to get assembly content. - ContentType: AssemblyContentType + /// Content type used to get assembly content. + ContentType: AssemblyContentType - /// Assembly content. - Symbols: AssemblySymbol list } + /// Assembly content. + Symbols: AssemblySymbol list + } /// Assembly content cache. [] diff --git a/src/Compiler/Service/ServiceInterfaceStubGenerator.fsi b/src/Compiler/Service/ServiceInterfaceStubGenerator.fsi index 065c1b07fdb..22af36a43f1 100644 --- a/src/Compiler/Service/ServiceInterfaceStubGenerator.fsi +++ b/src/Compiler/Service/ServiceInterfaceStubGenerator.fsi @@ -15,7 +15,7 @@ type InterfaceData = member Range: range - member TypeParameters: string [] + member TypeParameters: string[] module InterfaceStubGenerator = @@ -45,7 +45,7 @@ module InterfaceStubGenerator = val FormatInterface: startColumn: int -> indentation: int -> - typeInstances: string [] -> + typeInstances: string[] -> objectIdent: string -> methodBody: string -> displayContext: FSharpDisplayContext -> diff --git a/src/Compiler/Service/ServiceLexing.fsi b/src/Compiler/Service/ServiceLexing.fsi index 7f882ee3d62..5e2e5a9732d 100755 --- a/src/Compiler/Service/ServiceLexing.fsi +++ b/src/Compiler/Service/ServiceLexing.fsi @@ -272,28 +272,30 @@ module FSharpTokenTag = /// Information about a particular token from the tokenizer type FSharpTokenInfo = - { /// Left column of the token. - LeftColumn: int + { + /// Left column of the token. + LeftColumn: int - /// Right column of the token. - RightColumn: int + /// Right column of the token. + RightColumn: int - ColorClass: FSharpTokenColorKind + ColorClass: FSharpTokenColorKind - /// Gives an indication of the class to assign to the token an IDE - CharClass: FSharpTokenCharKind + /// Gives an indication of the class to assign to the token an IDE + CharClass: FSharpTokenCharKind - /// Actions taken when the token is typed - FSharpTokenTriggerClass: FSharpTokenTriggerClass + /// Actions taken when the token is typed + FSharpTokenTriggerClass: FSharpTokenTriggerClass - /// The tag is an integer identifier for the token - Tag: int + /// The tag is an integer identifier for the token + Tag: int - /// Provides additional information about the token - TokenName: string + /// Provides additional information about the token + TokenName: string - /// The full length consumed by this match, including delayed tokens (which can be ignored in naive lexers) - FullMatchedLength: int } + /// The full length consumed by this match, including delayed tokens (which can be ignored in naive lexers) + FullMatchedLength: int + } /// Object to tokenize a line of F# source code, starting with the given lexState. The lexState should be FSharpTokenizerLexState.Initial for /// the first line of text. Returns an array of ranges of the text and two enumerations categorizing the @@ -328,7 +330,7 @@ type FSharpSourceTokenizer = member CreateLineTokenizer: lineText: string -> FSharpLineTokenizer /// Create a tokenizer for a line of this source file using a buffer filler - member CreateBufferTokenizer: bufferFiller: (char [] * int * int -> int) -> FSharpLineTokenizer + member CreateBufferTokenizer: bufferFiller: (char[] * int * int -> int) -> FSharpLineTokenizer module internal TestExpose = val TokenInfo: Parser.token -> FSharpTokenColorKind * FSharpTokenCharKind * FSharpTokenTriggerClass diff --git a/src/Compiler/Service/ServiceNavigation.fsi b/src/Compiler/Service/ServiceNavigation.fsi index 30dfaad27d5..72f6e6c9fb6 100755 --- a/src/Compiler/Service/ServiceNavigation.fsi +++ b/src/Compiler/Service/ServiceNavigation.fsi @@ -62,14 +62,14 @@ type public NavigationItem = [] type public NavigationTopLevelDeclaration = { Declaration: NavigationItem - Nested: NavigationItem [] } + Nested: NavigationItem[] } /// Represents result of 'GetNavigationItems' operation - this contains /// all the members and currently selected indices. First level correspond to /// types & modules and second level are methods etc. [] type public NavigationItems = - member Declarations: NavigationTopLevelDeclaration [] + member Declarations: NavigationTopLevelDeclaration[] // Functionality to access navigable F# items. module public Navigation = @@ -110,4 +110,4 @@ type NavigableItem = Container: NavigableContainer } module public NavigateTo = - val GetNavigableItems: ParsedInput -> NavigableItem [] + val GetNavigableItems: ParsedInput -> NavigableItem[] diff --git a/src/Compiler/Service/ServiceParamInfoLocations.fsi b/src/Compiler/Service/ServiceParamInfoLocations.fsi index a4f5a79c3a8..272ab91d698 100755 --- a/src/Compiler/Service/ServiceParamInfoLocations.fsi +++ b/src/Compiler/Service/ServiceParamInfoLocations.fsi @@ -32,16 +32,16 @@ type public ParameterLocations = member OpenParenLocation: pos /// The locations of commas and close parenthesis (or, last char of last arg, if no final close parenthesis) - member TupleEndLocations: pos [] + member TupleEndLocations: pos[] /// Is false if either this is a call without parens "f x" or the parser recovered as in "f(x,y" member IsThereACloseParen: bool /// Either empty or a name if an actual named parameter; f(0,a=4,?b=None) would be [|None; Some "a"; Some "b"|] - member NamedParamNames: string option [] + member NamedParamNames: string option[] /// Array of locations for each argument, and a flag if that argument is named - member ArgumentLocations: TupledArgumentLocation [] + member ArgumentLocations: TupledArgumentLocation[] /// Find the information about parameter info locations at a particular source location static member Find: pos * ParsedInput -> ParameterLocations option diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 5e19aed8106..4fc616925e6 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -472,6 +472,8 @@ module SyntaxTraversal = | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr + | SynExpr.Dynamic _ -> None + | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> if isInfix then [dive synExpr2 synExpr2.Range traverseSynExpr diff --git a/src/Compiler/Service/ServiceParsedInputOps.fsi b/src/Compiler/Service/ServiceParsedInputOps.fsi index 9e4b52b75ab..07a1ac56fe6 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fsi +++ b/src/Compiler/Service/ServiceParsedInputOps.fsi @@ -76,11 +76,13 @@ type public ScopeKind = /// Insert open namespace context. [] type public InsertionContext = - { /// Current scope kind. - ScopeKind: ScopeKind + { + /// Current scope kind. + ScopeKind: ScopeKind - /// Current position (F# compiler line number). - Pos: pos } + /// Current position (F# compiler line number). + Pos: pos + } /// Where open statements should be added. [] @@ -92,27 +94,29 @@ type public OpenStatementInsertionPoint = type public ShortIdent = string /// An array of `ShortIdent`. -type public ShortIdents = ShortIdent [] +type public ShortIdents = ShortIdent[] /// `ShortIdent` with a flag indicating if it's resolved in some scope. type public MaybeUnresolvedIdent = { Ident: ShortIdent; Resolved: bool } /// Helper data structure representing a symbol, suitable for implementing unresolved identifiers resolution code fixes. type public InsertionContextEntity = - { /// Full name, relative to the current scope. - FullRelativeName: string + { + /// Full name, relative to the current scope. + FullRelativeName: string - /// Ident parts needed to append to the current ident to make it resolvable in current scope. - Qualifier: string + /// Ident parts needed to append to the current ident to make it resolvable in current scope. + Qualifier: string - /// Namespace that is needed to open to make the entity resolvable in the current scope. - Namespace: string option + /// Namespace that is needed to open to make the entity resolvable in the current scope. + Namespace: string option - /// Full display name (i.e. last ident plus modules with `RequireQualifiedAccess` attribute prefixed). - FullDisplayName: string + /// Full display name (i.e. last ident plus modules with `RequireQualifiedAccess` attribute prefixed). + FullDisplayName: string - /// Last part of the entity's full name. - LastIdent: ShortIdent } + /// Last part of the entity's full name. + LastIdent: ShortIdent + } /// Operations querying the entire syntax tree module public ParsedInput = @@ -126,15 +130,15 @@ module public ParsedInput = val GetEntityKind: pos: pos * parsedInput: ParsedInput -> EntityKind option - val GetFullNameOfSmallestModuleOrNamespaceAtPoint: pos: pos * parsedInput: ParsedInput -> string [] + val GetFullNameOfSmallestModuleOrNamespaceAtPoint: pos: pos * parsedInput: ParsedInput -> string[] /// Returns `InsertContext` based on current position and symbol idents. val TryFindInsertionContext: currentLine: int -> parsedInput: ParsedInput -> - partiallyQualifiedName: MaybeUnresolvedIdent [] -> + partiallyQualifiedName: MaybeUnresolvedIdent[] -> insertionPoint: OpenStatementInsertionPoint -> - (( (* requiresQualifiedAccessParent: *) ShortIdents option (* autoOpenParent: *) * ShortIdents option (* entityNamespace *) * ShortIdents option (* entity: *) * ShortIdents) -> (InsertionContextEntity * InsertionContext) []) + (( (* requiresQualifiedAccessParent: *) ShortIdents option (* autoOpenParent: *) * ShortIdents option (* entityNamespace *) * ShortIdents option (* entity: *) * ShortIdents) -> (InsertionContextEntity * InsertionContext)[]) /// Returns `InsertContext` based on current position and symbol idents. val FindNearestPointToInsertOpenDeclaration: diff --git a/src/Compiler/Service/ServiceStructure.fsi b/src/Compiler/Service/ServiceStructure.fsi index e668c8d161a..6c09e63e991 100644 --- a/src/Compiler/Service/ServiceStructure.fsi +++ b/src/Compiler/Service/ServiceStructure.fsi @@ -69,12 +69,14 @@ module public Structure = /// a tag for the construct type, and a tag for the collapse style [] type ScopeRange = - { Scope: Scope - Collapse: Collapse - /// HintSpan in BlockSpan - Range: range - /// TextSpan in BlockSpan - CollapseRange: range } + { + Scope: Scope + Collapse: Collapse + /// HintSpan in BlockSpan + Range: range + /// TextSpan in BlockSpan + CollapseRange: range + } /// Returns outlining ranges for given parsed input. - val getOutliningRanges: sourceLines: string [] -> parsedInput: ParsedInput -> seq + val getOutliningRanges: sourceLines: string[] -> parsedInput: ParsedInput -> seq diff --git a/src/Compiler/Service/ServiceUntypedParse.fsi b/src/Compiler/Service/ServiceUntypedParse.fsi index e73e0baa112..59586e51e70 100755 --- a/src/Compiler/Service/ServiceUntypedParse.fsi +++ b/src/Compiler/Service/ServiceUntypedParse.fsi @@ -40,16 +40,16 @@ type public FSharpParseFileResults = member ValidateBreakpointLocation: pos: pos -> range option /// When these files change then the build is invalid - member DependencyFiles: string [] + member DependencyFiles: string[] /// Get the errors and warnings for the parse - member Errors: FSharpErrorInfo [] + member Errors: FSharpErrorInfo[] /// Indicates if any errors occurred during the parse member ParseHadErrors: bool internal new: - errors: FSharpErrorInfo [] * input: ParsedInput option * parseHadErrors: bool * dependencyFiles: string [] -> + errors: FSharpErrorInfo[] * input: ParsedInput option * parseHadErrors: bool * dependencyFiles: string[] -> FSharpParseFileResults /// Information about F# source file names @@ -123,7 +123,7 @@ module public UntypedParseImpl = val GetEntityKind: pos * ParsedInput -> EntityKind option - val GetFullNameOfSmallestModuleOrNamespaceAtPoint: ParsedInput * pos -> string [] + val GetFullNameOfSmallestModuleOrNamespaceAtPoint: ParsedInput * pos -> string[] // implementation details used by other code in the compiler module internal SourceFileImpl = diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index 98aa389efbb..f9da3677f34 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -54,7 +54,7 @@ type public FSharpChecker = /// An optional string used for tracing compiler operations associated with this request. member MatchBraces: fileName: string * sourceText: ISourceText * options: FSharpParsingOptions * ?userOpName: string -> - Async<(range * range) []> + Async<(range * range)[]> /// /// Parse a source code file, returning information about brace matching in the file. @@ -68,7 +68,7 @@ type public FSharpChecker = [] member MatchBraces: fileName: string * source: string * options: FSharpProjectOptions * ?userOpName: string -> - Async<(range * range) []> + Async<(range * range)[]> /// /// Parses a source code for a file and caches the results. Returns an AST that can be traversed for various features. @@ -209,7 +209,7 @@ type public FSharpChecker = source: ISourceText * ?previewEnabled: bool * ?loadedTimeStamp: DateTime * - ?otherFlags: string [] * + ?otherFlags: string[] * ?useFsiAuxLib: bool * ?useSdkRefs: bool * ?assumeDotNetFramework: bool * @@ -228,7 +228,7 @@ type public FSharpChecker = /// so that an 'unload' and 'reload' action will cause the script to be considered as a new project, /// so that references are re-resolved. member GetProjectOptionsFromCommandLineArgs: - projectFileName: string * argv: string [] * ?loadedTimeStamp: DateTime * ?isInteractive: bool * ?isEditing: bool -> + projectFileName: string * argv: string[] * ?loadedTimeStamp: DateTime * ?isInteractive: bool * ?isEditing: bool -> FSharpProjectOptions /// @@ -325,7 +325,7 @@ type public FSharpChecker = /// /// The command line arguments for the project build. /// An optional string used for tracing compiler operations associated with this request. - member Compile: argv: string [] * ?userOpName: string -> Async + member Compile: argv: string[] * ?userOpName: string -> Async /// /// TypeCheck and compile provided AST @@ -348,7 +348,7 @@ type public FSharpChecker = ?executable: bool * ?noframework: bool * ?userOpName: string -> - Async + Async /// /// Compiles to a dynamic assembly using the given flags. @@ -367,8 +367,8 @@ type public FSharpChecker = /// An optional pair of output streams, enabling execution of the result. /// An optional string used for tracing compiler operations associated with this request. member CompileToDynamicAssembly: - otherFlags: string [] * execute: (TextWriter * TextWriter) option * ?userOpName: string -> - Async + otherFlags: string[] * execute: (TextWriter * TextWriter) option * ?userOpName: string -> + Async /// /// TypeCheck and compile provided AST @@ -389,7 +389,7 @@ type public FSharpChecker = ?debug: bool * ?noframework: bool * ?userOpName: string -> - Async + Async /// /// Try to get type check results for a file. This looks up the results of recent type checks of the @@ -468,10 +468,10 @@ type public FSharpChecker = member internal ReferenceResolver: LegacyReferenceResolver /// Tokenize a single line, returning token information and a tokenization state represented by an integer - member TokenizeLine: line: string * state: FSharpTokenizerLexState -> FSharpTokenInfo [] * FSharpTokenizerLexState + member TokenizeLine: line: string * state: FSharpTokenizerLexState -> FSharpTokenInfo[] * FSharpTokenizerLexState /// Tokenize an entire file, line by line - member TokenizeFile: source: string -> FSharpTokenInfo [] [] + member TokenizeFile: source: string -> FSharpTokenInfo[][] namespace FSharp.Compiler diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fsi b/src/Compiler/Symbols/FSharpDiagnostic.fsi index 1e50fd22d0f..2ebfcb71980 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fsi +++ b/src/Compiler/Symbols/FSharpDiagnostic.fsi @@ -109,7 +109,7 @@ type internal CompilationDiagnosticLogger = new: debugName: string * options: FSharpDiagnosticOptions -> CompilationDiagnosticLogger /// Get the captured diagnostics - member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity)[] module internal DiagnosticHelpers = @@ -129,4 +129,4 @@ module internal DiagnosticHelpers = mainInputFileName: string * seq * suggestNames: bool -> - FSharpDiagnostic [] + FSharpDiagnostic[] diff --git a/src/Compiler/Symbols/SymbolHelpers.fsi b/src/Compiler/Symbols/SymbolHelpers.fsi index b5ee20fa8b3..e862ba3dee6 100755 --- a/src/Compiler/Symbols/SymbolHelpers.fsi +++ b/src/Compiler/Symbols/SymbolHelpers.fsi @@ -31,7 +31,6 @@ type public FSharpXmlDoc = /// Indicates that the XML for the documentation can be found in a .xml documentation file for the given DLL, using the given signature key | FromXmlFile of dllName: string * xmlSig: string - // Implementation details used by other code in the compiler module internal SymbolHelpers = @@ -63,10 +62,10 @@ module internal SymbolHelpers = val (|ItemIsProvidedType|_|): TcGlobals -> Item -> TyconRef option val (|ItemIsWithStaticArguments|_|): - range -> TcGlobals -> Item -> Tainted [] option + range -> TcGlobals -> Item -> Tainted[] option val (|ItemIsProvidedTypeWithStaticArguments|_|): - range -> TcGlobals -> Item -> Tainted [] option + range -> TcGlobals -> Item -> Tainted[] option #endif val SimplerDisplayEnv: DisplayEnv -> DisplayEnv diff --git a/src/Compiler/Symbols/Symbols.fsi b/src/Compiler/Symbols/Symbols.fsi index 33873e91be6..5a296058eb3 100644 --- a/src/Compiler/Symbols/Symbols.fsi +++ b/src/Compiler/Symbols/Symbols.fsi @@ -487,7 +487,7 @@ type FSharpAnonRecordTypeDetails = member CompiledName: string /// The sorted labels of the anonymous type - member SortedFieldNames: string [] + member SortedFieldNames: string[] /// A subtype of FSharpSymbol that represents a record or union case field as seen by the F# language [] @@ -504,7 +504,7 @@ type FSharpField = member IsAnonRecordField: bool /// If the field is from an anonymous record type then get the details of the field including the index in the sorted array of fields - member AnonRecordFieldDetails: FSharpAnonRecordTypeDetails * FSharpType [] * int + member AnonRecordFieldDetails: FSharpAnonRecordTypeDetails * FSharpType[] * int /// Indicates if the field is declared in a union case member IsUnionCaseField: bool @@ -942,10 +942,10 @@ type FSharpMemberOrFunctionOrValue = member IsConstructor: bool /// Format the type using the rules of the given display context - member FormatLayout: displayContext: FSharpDisplayContext -> TaggedText [] + member FormatLayout: displayContext: FSharpDisplayContext -> TaggedText[] /// Format the type using the rules of the given display context - member GetReturnTypeLayout: displayContext: FSharpDisplayContext -> TaggedText [] option + member GetReturnTypeLayout: displayContext: FSharpDisplayContext -> TaggedText[] option /// Check if this method has an entrpoint that accepts witness arguments and if so return /// the name of that entrypoint and information about the additional witness arguments @@ -958,7 +958,7 @@ type FSharpMemberOrFunctionOrValue = member TryGetFullDisplayName: unit -> string option /// Full operator compiled name. - member TryGetFullCompiledOperatorNameIdents: unit -> string [] option + member TryGetFullCompiledOperatorNameIdents: unit -> string[] option /// A subtype of FSharpSymbol that represents a parameter [] @@ -990,7 +990,6 @@ type FSharpParameter = /// Indicate this is an optional argument member IsOptionalArg: bool - /// A subtype of FSharpSymbol that represents a single case within an active pattern [] type FSharpActivePatternCase = @@ -1089,10 +1088,10 @@ type FSharpType = member FormatWithConstraints: context: FSharpDisplayContext -> string /// Format the type using the rules of the given display context - member FormatLayout: context: FSharpDisplayContext -> TaggedText [] + member FormatLayout: context: FSharpDisplayContext -> TaggedText[] /// Format the type - with constraints - using the rules of the given display context - member FormatLayoutWithConstraints: context: FSharpDisplayContext -> TaggedText [] + member FormatLayoutWithConstraints: context: FSharpDisplayContext -> TaggedText[] /// Instantiate generic type parameters in a type member Instantiate: (FSharpGenericParameter * FSharpType) list -> FSharpType diff --git a/src/Compiler/SyntaxTree/LexFilter.fsi b/src/Compiler/SyntaxTree/LexFilter.fsi index 3fc6843eb1b..de98566ffe0 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fsi +++ b/src/Compiler/SyntaxTree/LexFilter.fsi @@ -10,7 +10,7 @@ open FSharp.Compiler.Parser /// Match the close of '>' of a set of type parameters. /// This is done for tokens such as '>>' by smashing the token -val (|TyparsCloseOp|_|): txt: string -> ((bool -> token) [] * token option) option +val (|TyparsCloseOp|_|): txt: string -> ((bool -> token)[] * token option) option /// A stateful filter over the token stream that adjusts it for indentation-aware syntax rules /// Process the token stream prior to parsing. Implements the offside rule and other lexical transformations. diff --git a/src/Compiler/SyntaxTree/LexHelpers.fsi b/src/Compiler/SyntaxTree/LexHelpers.fsi index 33f6bcf951d..0f88933dac1 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fsi +++ b/src/Compiler/SyntaxTree/LexHelpers.fsi @@ -84,7 +84,7 @@ val addByteChar: ByteBuffer -> char -> unit val stringBufferAsString: ByteBuffer -> string -val stringBufferAsBytes: ByteBuffer -> byte [] +val stringBufferAsBytes: ByteBuffer -> byte[] val stringBufferIsBytes: ByteBuffer -> bool diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fsi b/src/Compiler/SyntaxTree/ParseHelpers.fsi index a69f822b550..09133a9deb6 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fsi +++ b/src/Compiler/SyntaxTree/ParseHelpers.fsi @@ -148,7 +148,7 @@ type LexerContinuation = and LexCont = LexerContinuation val ParseAssemblyCodeInstructions: - s: string -> reportLibraryOnlyFeatures: bool -> langVersion: LanguageVersion -> m: range -> ILInstr [] + s: string -> reportLibraryOnlyFeatures: bool -> langVersion: LanguageVersion -> m: range -> ILInstr[] val grabXmlDocAtRangeStart: parseState: IParseState * optAttributes: SynAttributeList list * range: range -> PreXmlDoc diff --git a/src/Compiler/SyntaxTree/PrettyNaming.fsi b/src/Compiler/SyntaxTree/PrettyNaming.fsi index f82dc19fc4c..ea12bae0325 100644 --- a/src/Compiler/SyntaxTree/PrettyNaming.fsi +++ b/src/Compiler/SyntaxTree/PrettyNaming.fsi @@ -189,7 +189,7 @@ val internal FSharpModuleSuffix: string = "Module" [] val internal MangledGlobalName: string = "`global`" -val internal IllegalCharactersInTypeAndNamespaceNames: char [] +val internal IllegalCharactersInTypeAndNamespaceNames: char[] type internal ActivePatternInfo = | APInfo of bool * (string * range) list * range @@ -203,14 +203,14 @@ val internal ActivePatternInfoOfValName: nm: string -> m: range -> ActivePattern exception internal InvalidMangledStaticArg of string -val internal demangleProvidedTypeName: typeLogicalName: string -> string * (string * string) [] +val internal demangleProvidedTypeName: typeLogicalName: string -> string * (string * string)[] /// Mangle the static parameters for a provided type or method -val internal mangleProvidedTypeName: typeLogicalName: string * nonDefaultArgs: (string * string) [] -> string +val internal mangleProvidedTypeName: typeLogicalName: string * nonDefaultArgs: (string * string)[] -> string /// Mangle the static parameters for a provided type or method val internal computeMangledNameWithoutDefaultArgValues: - nm: string * staticArgs: 'a [] * defaultArgValues: (string * string option) [] -> string + nm: string * staticArgs: 'a[] * defaultArgValues: (string * string option)[] -> string val internal outArgCompilerGeneratedName: string diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index a51e83cd813..750a17580f6 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -888,6 +888,8 @@ type SynExpr = isControlFlow: bool * innerExpr: SynExpr + | Dynamic of funcExpr: SynExpr * qmark: range * argExpr: SynExpr * range: range + member e.Range = match e with | SynExpr.Paren (_, leftParenRange, rightParenRange, r) -> @@ -956,7 +958,8 @@ type SynExpr = | SynExpr.MatchBang (range=m) | SynExpr.DoBang (range=m) | SynExpr.Fixed (range=m) - | SynExpr.InterpolatedString (range=m) -> m + | SynExpr.InterpolatedString (range=m) + | SynExpr.Dynamic(range=m) -> m | SynExpr.Ident id -> id.idRange | SynExpr.DebugPoint (_, _, innerExpr) -> innerExpr.Range diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 73e2fafbaed..9f18a1488d1 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -163,11 +163,11 @@ type SynConst = /// /// Also used internally in the typechecker once an array of unit16 constants /// is detected, to allow more efficient processing of large arrays of uint16 constants. - | Bytes of bytes: byte [] * synByteStringKind: SynByteStringKind * range: range + | Bytes of bytes: byte[] * synByteStringKind: SynByteStringKind * range: range /// Used internally in the typechecker once an array of unit16 constants /// is detected, to allow more efficient processing of large arrays of uint16 constants. - | UInt16s of uint16 [] + | UInt16s of uint16[] /// Old comment: "we never iterate, so the const here is not another SynConst.Measure" | Measure of constant: SynConst * constantRange: range * SynMeasure @@ -896,6 +896,9 @@ type SynExpr = /// Debug points arising from computation expressions | DebugPoint of debugPoint: DebugPointAtLeafExpr * isControlFlow: bool * innerExpr: SynExpr + /// F# syntax: f?x + | Dynamic of funcExpr: SynExpr * qmark: range * argExpr: SynExpr * range: range + /// Gets the syntax range of this construct member Range: range @@ -1120,29 +1123,33 @@ type SynMatchClause = /// Represents an attribute [] type SynAttribute = - { /// The name of the type for the attribute - TypeName: SynLongIdent + { + /// The name of the type for the attribute + TypeName: SynLongIdent - /// The argument of the attribute, perhaps a tuple - ArgExpr: SynExpr + /// The argument of the attribute, perhaps a tuple + ArgExpr: SynExpr - /// Target specifier, e.g. "assembly", "module", etc. - Target: Ident option + /// Target specifier, e.g. "assembly", "module", etc. + Target: Ident option - /// Is this attribute being applied to a property getter or setter? - AppliesToGetterAndSetter: bool + /// Is this attribute being applied to a property getter or setter? + AppliesToGetterAndSetter: bool - /// The syntax range of the attribute - Range: range } + /// The syntax range of the attribute + Range: range + } /// List of attributes enclosed in [< ... >]. [] type SynAttributeList = - { /// The list of attributes - Attributes: SynAttribute list + { + /// The list of attributes + Attributes: SynAttribute list - /// The syntax range of the list of attributes - Range: range } + /// The syntax range of the list of attributes + Range: range + } type SynAttributes = SynAttributeList list @@ -1188,23 +1195,25 @@ type SynBindingReturnInfo = SynBindingReturnInfo of typeName: SynType * range: r /// Represents the flags for a 'member' declaration [] type SynMemberFlags = - { /// The member is an instance member (non-static) - IsInstance: bool + { + /// The member is an instance member (non-static) + IsInstance: bool - /// The member is a dispatch slot - IsDispatchSlot: bool + /// The member is a dispatch slot + IsDispatchSlot: bool - /// The member is an 'override' or explicit interface implementation - IsOverrideOrExplicitImpl: bool + /// The member is an 'override' or explicit interface implementation + IsOverrideOrExplicitImpl: bool - /// The member is 'final' - IsFinal: bool + /// The member is 'final' + IsFinal: bool - /// The kind of the member - MemberKind: SynMemberKind + /// The kind of the member + MemberKind: SynMemberKind - /// Additional information - Trivia: SynMemberFlagsTrivia } + /// Additional information + Trivia: SynMemberFlagsTrivia + } /// Note the member kind is actually computed partially by a syntax tree transformation in tc.fs [] diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 81a59c3dc92..98fe80ac938 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -773,7 +773,8 @@ let rec synExprContainsError inpExpr = | SynExpr.Null _ | SynExpr.Ident _ | SynExpr.ImplicitZero _ - | SynExpr.Const _ -> false + | SynExpr.Const _ + | SynExpr.Dynamic _ -> false | SynExpr.TypeTest (e, _, _) | SynExpr.Upcast (e, _, _) @@ -901,4 +902,12 @@ let (|ParsedHashDirectiveArguments|) (input: ParsedHashDirectiveArgument list) = let prependIdentInLongIdentWithTrivia (SynIdent(ident, identTrivia)) dotm lid = match lid with | SynLongIdent(lid, dots, trivia) -> - SynLongIdent(ident :: lid, dotm :: dots, identTrivia :: trivia) \ No newline at end of file + SynLongIdent(ident :: lid, dotm :: dots, identTrivia :: trivia) + +let mkDynamicArgExpr expr = + match expr with + | SynExpr.Ident ident -> + let con = SynConst.String (ident.idText, SynStringKind.Regular, ident.idRange) + SynExpr.Const (con, con.Range ident.idRange) + | SynExpr.Paren(expr = e) -> e + | e -> e \ No newline at end of file diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi index 7f66c937e75..dfff0392bcf 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi @@ -19,7 +19,7 @@ val textOfId: id: Ident -> string val pathOfLid: lid: Ident list -> string list -val arrPathOfLid: lid: Ident list -> string [] +val arrPathOfLid: lid: Ident list -> string[] val textOfPath: path: seq -> string @@ -338,3 +338,5 @@ val (|SynPipeRight2|_|): SynExpr -> (SynExpr * SynExpr * SynExpr) option val (|SynPipeRight3|_|): SynExpr -> (SynExpr * SynExpr * SynExpr * SynExpr) option val prependIdentInLongIdentWithTrivia: ident: SynIdent -> dotm: range -> lid: SynLongIdent -> SynLongIdent + +val mkDynamicArgExpr: expr: SynExpr -> SynExpr diff --git a/src/Compiler/SyntaxTree/SyntaxTrivia.fsi b/src/Compiler/SyntaxTree/SyntaxTrivia.fsi index b1e233d9aef..e9ba9b8929d 100644 --- a/src/Compiler/SyntaxTree/SyntaxTrivia.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTrivia.fsi @@ -42,236 +42,282 @@ type CommentTrivia = /// Represents additional information for ParsedImplFileInput [] type ParsedImplFileInputTrivia = - { /// Preprocessor directives of type #if, #else or #endif - ConditionalDirectives: ConditionalDirectiveTrivia list + { + /// Preprocessor directives of type #if, #else or #endif + ConditionalDirectives: ConditionalDirectiveTrivia list - /// Represent code comments found in the source file - CodeComments: CommentTrivia list } + /// Represent code comments found in the source file + CodeComments: CommentTrivia list + } /// Represents additional information for ParsedSigFileInputTrivia [] type ParsedSigFileInputTrivia = - { /// Preprocessor directives of type #if, #else or #endif - ConditionalDirectives: ConditionalDirectiveTrivia list + { + /// Preprocessor directives of type #if, #else or #endif + ConditionalDirectives: ConditionalDirectiveTrivia list - /// Represent code comments found in the source file - CodeComments: CommentTrivia list } + /// Represent code comments found in the source file + CodeComments: CommentTrivia list + } /// Represents additional information for SynExpr.TryWith [] type SynExprTryWithTrivia = - { /// The syntax range of the `try` keyword. - TryKeyword: range + { + /// The syntax range of the `try` keyword. + TryKeyword: range - /// The syntax range from the beginning of the `try` keyword till the end of the `with` keyword. - TryToWithRange: range + /// The syntax range from the beginning of the `try` keyword till the end of the `with` keyword. + TryToWithRange: range - /// The syntax range of the `with` keyword - WithKeyword: range + /// The syntax range of the `with` keyword + WithKeyword: range - /// The syntax range from the beginning of the `with` keyword till the end of the TryWith expression. - WithToEndRange: range } + /// The syntax range from the beginning of the `with` keyword till the end of the TryWith expression. + WithToEndRange: range + } /// Represents additional information for SynExpr.TryFinally [] type SynExprTryFinallyTrivia = - { /// The syntax range of the `try` keyword. - TryKeyword: range + { + /// The syntax range of the `try` keyword. + TryKeyword: range - /// The syntax range of the `finally` keyword - FinallyKeyword: range } + /// The syntax range of the `finally` keyword + FinallyKeyword: range + } /// Represents additional information for SynExpr.IfThenElse [] type SynExprIfThenElseTrivia = - { /// The syntax range of the `if` keyword. - IfKeyword: range + { + /// The syntax range of the `if` keyword. + IfKeyword: range - /// Indicates if the `elif` keyword was used - IsElif: bool + /// Indicates if the `elif` keyword was used + IsElif: bool - /// The syntax range of the `then` keyword. - ThenKeyword: range + /// The syntax range of the `then` keyword. + ThenKeyword: range - /// The syntax range of the `else` keyword. - ElseKeyword: range option + /// The syntax range of the `else` keyword. + ElseKeyword: range option - /// The syntax range from the beginning of the `if` keyword till the end of the `then` keyword. - IfToThenRange: range } + /// The syntax range from the beginning of the `if` keyword till the end of the `then` keyword. + IfToThenRange: range + } /// Represents additional information for SynExpr.Lambda [] type SynExprLambdaTrivia = - { /// The syntax range of the `->` token. - ArrowRange: range option } + { + /// The syntax range of the `->` token. + ArrowRange: range option + } static member Zero: SynExprLambdaTrivia /// Represents additional information for SynExpr.LetOrUse [] type SynExprLetOrUseTrivia = - { /// The syntax range of the `in` keyword. - InKeyword: range option } + { + /// The syntax range of the `in` keyword. + InKeyword: range option + } /// Represents additional information for SynExpr.LetOrUseBang [] type SynExprLetOrUseBangTrivia = - { /// The syntax range of the `=` token. - EqualsRange: range option } + { + /// The syntax range of the `=` token. + EqualsRange: range option + } static member Zero: SynExprLetOrUseBangTrivia /// Represents additional information for SynExpr.Match [] type SynExprMatchTrivia = - { /// The syntax range of the `match` keyword - MatchKeyword: range + { + /// The syntax range of the `match` keyword + MatchKeyword: range - /// The syntax range of the `with` keyword - WithKeyword: range } + /// The syntax range of the `with` keyword + WithKeyword: range + } /// Represents additional information for SynExpr.MatchBang [] type SynExprMatchBangTrivia = - { /// The syntax range of the `match!` keyword - MatchBangKeyword: range + { + /// The syntax range of the `match!` keyword + MatchBangKeyword: range - /// The syntax range of the `with` keyword - WithKeyword: range } + /// The syntax range of the `with` keyword + WithKeyword: range + } /// Represents additional information for SynMatchClause [] type SynMatchClauseTrivia = - { /// The syntax range of the `->` token. - ArrowRange: range option + { + /// The syntax range of the `->` token. + ArrowRange: range option - /// The syntax range of the `|` token. - BarRange: range option } + /// The syntax range of the `|` token. + BarRange: range option + } static member Zero: SynMatchClauseTrivia /// Represents additional information for [] type SynEnumCaseTrivia = - { /// The syntax range of the `|` token. - BarRange: range option + { + /// The syntax range of the `|` token. + BarRange: range option - /// The syntax range of the `=` token. - EqualsRange: range } + /// The syntax range of the `=` token. + EqualsRange: range + } /// Represents additional information for SynUnionCase [] type SynUnionCaseTrivia = - { /// The syntax range of the `|` token. - BarRange: range option } + { + /// The syntax range of the `|` token. + BarRange: range option + } /// Represents additional information for SynPat.Or [] type SynPatOrTrivia = - { /// The syntax range of the `|` token. - BarRange: range } + { + /// The syntax range of the `|` token. + BarRange: range + } /// Represents additional information for SynTypeDefn [] type SynTypeDefnTrivia = - { /// The syntax range of the `type` keyword. - TypeKeyword: range option + { + /// The syntax range of the `type` keyword. + TypeKeyword: range option - /// The syntax range of the `=` token. - EqualsRange: range option + /// The syntax range of the `=` token. + EqualsRange: range option - /// The syntax range of the `with` keyword - WithKeyword: range option } + /// The syntax range of the `with` keyword + WithKeyword: range option + } static member Zero: SynTypeDefnTrivia /// Represents additional information for SynBinding [] type SynBindingTrivia = - { /// The syntax range of the `let` keyword. - LetKeyword: range option + { + /// The syntax range of the `let` keyword. + LetKeyword: range option - /// The syntax range of the `=` token. - EqualsRange: range option } + /// The syntax range of the `=` token. + EqualsRange: range option + } static member Zero: SynBindingTrivia /// Represents additional information for SynMemberFlags [] type SynMemberFlagsTrivia = - { /// The syntax range of the `member` keyword - MemberRange: range option + { + /// The syntax range of the `member` keyword + MemberRange: range option - /// The syntax range of the `override` keyword - OverrideRange: range option + /// The syntax range of the `override` keyword + OverrideRange: range option - /// The syntax range of the `abstract` keyword - AbstractRange: range option + /// The syntax range of the `abstract` keyword + AbstractRange: range option - /// The syntax range of the `member` keyword - StaticRange: range option + /// The syntax range of the `member` keyword + StaticRange: range option - /// The syntax range of the `default` keyword - DefaultRange: range option } + /// The syntax range of the `default` keyword + DefaultRange: range option + } static member Zero: SynMemberFlagsTrivia /// Represents additional information for SynExprAndBang [] type SynExprAndBangTrivia = - { /// The syntax range of the `=` token. - EqualsRange: range + { + /// The syntax range of the `=` token. + EqualsRange: range - /// The syntax range of the `in` keyword. - InKeyword: range option } + /// The syntax range of the `in` keyword. + InKeyword: range option + } /// Represents additional information for SynModuleDecl.NestedModule [] type SynModuleDeclNestedModuleTrivia = - { /// The syntax range of the `module` keyword - ModuleKeyword: range option + { + /// The syntax range of the `module` keyword + ModuleKeyword: range option - /// The syntax range of the `=` token. - EqualsRange: range option } + /// The syntax range of the `=` token. + EqualsRange: range option + } static member Zero: SynModuleDeclNestedModuleTrivia /// Represents additional information for SynModuleSigDecl.NestedModule [] type SynModuleSigDeclNestedModuleTrivia = - { /// The syntax range of the `module` keyword - ModuleKeyword: range option + { + /// The syntax range of the `module` keyword + ModuleKeyword: range option - /// The syntax range of the `=` token. - EqualsRange: range option } + /// The syntax range of the `=` token. + EqualsRange: range option + } static member Zero: SynModuleSigDeclNestedModuleTrivia /// Represents additional information for SynModuleOrNamespace [] type SynModuleOrNamespaceTrivia = - { /// The syntax range of the `module` keyword - ModuleKeyword: range option + { + /// The syntax range of the `module` keyword + ModuleKeyword: range option - /// The syntax range of the `namespace` keyword - NamespaceKeyword: range option } + /// The syntax range of the `namespace` keyword + NamespaceKeyword: range option + } /// Represents additional information for SynModuleOrNamespaceSig [] type SynModuleOrNamespaceSigTrivia = - { /// The syntax range of the `module` keyword - ModuleKeyword: range option + { + /// The syntax range of the `module` keyword + ModuleKeyword: range option - /// The syntax range of the `namespace` keyword - NamespaceKeyword: range option } + /// The syntax range of the `namespace` keyword + NamespaceKeyword: range option + } /// Represents additional information for SynValSig [] type SynValSigTrivia = - { /// The syntax range of the `val` keyword - ValKeyword: range option + { + /// The syntax range of the `val` keyword + ValKeyword: range option - /// The syntax range of the `with` keyword - WithKeyword: range option } + /// The syntax range of the `with` keyword + WithKeyword: range option + } static member Zero: SynValSigTrivia diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fsi b/src/Compiler/SyntaxTree/UnicodeLexing.fsi index 29b30e74741..41bbc768ff5 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fsi +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fsi @@ -12,8 +12,7 @@ type Lexbuf = LexBuffer val StringAsLexbuf: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * string -> Lexbuf val FunctionAsLexbuf: - reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * bufferFiller: (char [] * int * int -> int) -> - Lexbuf + reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * bufferFiller: (char[] * int * int -> int) -> Lexbuf val SourceTextAsLexbuf: reportLibraryOnlyFeatures: bool * langVersion: LanguageVersion * sourceText: ISourceText -> Lexbuf diff --git a/src/Compiler/SyntaxTree/XmlDoc.fsi b/src/Compiler/SyntaxTree/XmlDoc.fsi index 8dab8dc0268..f736088be52 100644 --- a/src/Compiler/SyntaxTree/XmlDoc.fsi +++ b/src/Compiler/SyntaxTree/XmlDoc.fsi @@ -9,7 +9,7 @@ open FSharp.Compiler.AbstractIL.IL [] type public XmlDoc = - new: unprocessedLines: string [] * range: range -> XmlDoc + new: unprocessedLines: string[] * range: range -> XmlDoc /// Merge two XML documentation static member Merge: doc1: XmlDoc -> doc2: XmlDoc -> XmlDoc @@ -18,7 +18,7 @@ type public XmlDoc = member internal Check: paramNamesOpt: string list option -> unit /// Get the lines after insertion of implicit summary tags and encoding - member GetElaboratedXmlLines: unit -> string [] + member GetElaboratedXmlLines: unit -> string[] /// Get the elaborated XML documentation as XML text member GetXmlText: unit -> string @@ -33,7 +33,7 @@ type public XmlDoc = member Range: range /// Get the lines before insertion of implicit summary tags and encoding - member UnprocessedLines: string [] + member UnprocessedLines: string[] /// Get the empty XmlDoc static member Empty: XmlDoc @@ -54,7 +54,7 @@ type internal XmlDocCollector = member AddXmlDocLine: line: string * range: range -> unit /// Get the documentation lines before the given point - member LinesBefore: grabPointPos: pos -> (string * range) [] + member LinesBefore: grabPointPos: pos -> (string * range)[] /// Indicates it the given point has XmlDoc comments member HasComments: grabPointPos: pos -> bool @@ -72,7 +72,7 @@ type public PreXmlDoc = static member Merge: a: PreXmlDoc -> b: PreXmlDoc -> PreXmlDoc /// Create a PreXmlDoc from a collection of unprocessed lines - static member Create: unprocessedLines: string [] * range: range -> PreXmlDoc + static member Create: unprocessedLines: string[] * range: range -> PreXmlDoc /// Process and check the PreXmlDoc, checking with respect to the given parameter names member ToXmlDoc: check: bool * paramNamesOpt: string list option -> XmlDoc diff --git a/src/Compiler/TypedTree/QuotationPickler.fsi b/src/Compiler/TypedTree/QuotationPickler.fsi index b4c99699d26..648e9d0acf6 100644 --- a/src/Compiler/TypedTree/QuotationPickler.fsi +++ b/src/Compiler/TypedTree/QuotationPickler.fsi @@ -165,10 +165,10 @@ val mkMethodCallW: MethodData * MethodData * int * TypeData list * ExprData list val mkAttributedExpression: ExprData * ExprData -> ExprData -val pickle: (ExprData -> byte []) +val pickle: (ExprData -> byte[]) val isAttributedExpression: ExprData -> bool -val PickleDefns: ((MethodBaseData * ExprData) list -> byte []) +val PickleDefns: ((MethodBaseData * ExprData) list -> byte[]) val SerializedReflectedDefinitionsResourceNameBase: string diff --git a/src/Compiler/TypedTree/TypeProviders.fsi b/src/Compiler/TypedTree/TypeProviders.fsi index b76018c9494..5d014938ea3 100755 --- a/src/Compiler/TypedTree/TypeProviders.fsi +++ b/src/Compiler/TypedTree/TypeProviders.fsi @@ -26,20 +26,22 @@ val toolingCompatiblePaths: unit -> string list /// Carries information about the type provider resolution environment. type ResolutionEnvironment = - { /// The folder from which an extension provider is resolving from. This is typically the project folder. - ResolutionFolder: string + { + /// The folder from which an extension provider is resolving from. This is typically the project folder. + ResolutionFolder: string - /// Output file name - OutputFile: string option + /// Output file name + OutputFile: string option - /// Whether or not the --showextensionresolution flag was supplied to the compiler. - ShowResolutionMessages: bool + /// Whether or not the --showextensionresolution flag was supplied to the compiler. + ShowResolutionMessages: bool - /// All referenced assemblies, including the type provider itself, and possibly other type providers. - ReferencedAssemblies: string [] + /// All referenced assemblies, including the type provider itself, and possibly other type providers. + ReferencedAssemblies: string[] - /// The folder for temporary files - TemporaryFolder: string } + /// The folder for temporary files + TemporaryFolder: string + } /// Find and instantiate the set of ITypeProvider components for the given assembly reference val GetTypeProvidersOfAssembly: @@ -104,7 +106,7 @@ type ProvidedType = member IsArray: bool - member GetInterfaces: unit -> ProvidedType [] + member GetInterfaces: unit -> ProvidedType[] member Assembly: ProvidedAssembly @@ -112,27 +114,27 @@ type ProvidedType = member GetNestedType: string -> ProvidedType - member GetNestedTypes: unit -> ProvidedType [] + member GetNestedTypes: unit -> ProvidedType[] - member GetAllNestedTypes: unit -> ProvidedType [] + member GetAllNestedTypes: unit -> ProvidedType[] - member GetMethods: unit -> ProvidedMethodInfo [] + member GetMethods: unit -> ProvidedMethodInfo[] - member GetFields: unit -> ProvidedFieldInfo [] + member GetFields: unit -> ProvidedFieldInfo[] member GetField: string -> ProvidedFieldInfo - member GetProperties: unit -> ProvidedPropertyInfo [] + member GetProperties: unit -> ProvidedPropertyInfo[] member GetProperty: string -> ProvidedPropertyInfo - member GetEvents: unit -> ProvidedEventInfo [] + member GetEvents: unit -> ProvidedEventInfo[] member GetEvent: string -> ProvidedEventInfo - member GetConstructors: unit -> ProvidedConstructorInfo [] + member GetConstructors: unit -> ProvidedConstructorInfo[] - member GetStaticParameters: ITypeProvider -> ProvidedParameterInfo [] + member GetStaticParameters: ITypeProvider -> ProvidedParameterInfo[] member GetGenericTypeDefinition: unit -> ProvidedType @@ -166,7 +168,7 @@ type ProvidedType = member GetElementType: unit -> ProvidedType - member GetGenericArguments: unit -> ProvidedType [] + member GetGenericArguments: unit -> ProvidedType[] member GetArrayRank: unit -> int @@ -182,7 +184,7 @@ type ProvidedType = member MakeArrayType: rank: int -> ProvidedType - member MakeGenericType: args: ProvidedType [] -> ProvidedType + member MakeGenericType: args: ProvidedType[] -> ProvidedType member AsProvidedVar: name: string -> ProvidedVar @@ -209,7 +211,7 @@ type IProvidedCustomAttributeProvider = abstract GetDefinitionLocationAttribute: provider: ITypeProvider -> (string * int * int) option - abstract GetXmlDocAttributes: provider: ITypeProvider -> string [] + abstract GetXmlDocAttributes: provider: ITypeProvider -> string[] abstract GetAttributeConstructorArgs: provider: ITypeProvider * attribName: string -> (obj option list * (string * obj option) list) option @@ -221,7 +223,7 @@ type ProvidedAssembly = member FullName: string - member GetManifestModuleContents: ITypeProvider -> byte [] + member GetManifestModuleContents: ITypeProvider -> byte[] member Handle: System.Reflection.Assembly @@ -261,11 +263,11 @@ type ProvidedMethodBase = member IsConstructor: bool - member GetParameters: unit -> ProvidedParameterInfo [] + member GetParameters: unit -> ProvidedParameterInfo[] - member GetGenericArguments: unit -> ProvidedType [] + member GetGenericArguments: unit -> ProvidedType[] - member GetStaticParametersForMethod: ITypeProvider -> ProvidedParameterInfo [] + member GetStaticParametersForMethod: ITypeProvider -> ProvidedParameterInfo[] static member TaintedGetHashCode: Tainted -> int @@ -304,7 +306,6 @@ type ProvidedFieldInfo = inherit ProvidedMemberInfo - member IsInitOnly: bool member IsStatic: bool @@ -338,7 +339,7 @@ type ProvidedPropertyInfo = member GetSetMethod: unit -> ProvidedMethodInfo - member GetIndexParameters: unit -> ProvidedParameterInfo [] + member GetIndexParameters: unit -> ProvidedParameterInfo[] member CanRead: bool @@ -371,17 +372,17 @@ type ProvidedConstructorInfo = type ProvidedExprType = - | ProvidedNewArrayExpr of ProvidedType * ProvidedExpr [] + | ProvidedNewArrayExpr of ProvidedType * ProvidedExpr[] #if PROVIDED_ADDRESS_OF | ProvidedAddressOfExpr of ProvidedExpr #endif - | ProvidedNewObjectExpr of ProvidedConstructorInfo * ProvidedExpr [] + | ProvidedNewObjectExpr of ProvidedConstructorInfo * ProvidedExpr[] | ProvidedWhileLoopExpr of ProvidedExpr * ProvidedExpr - | ProvidedNewDelegateExpr of ProvidedType * ProvidedVar [] * ProvidedExpr + | ProvidedNewDelegateExpr of ProvidedType * ProvidedVar[] * ProvidedExpr | ProvidedForIntegerRangeLoopExpr of ProvidedVar * ProvidedExpr * ProvidedExpr * ProvidedExpr @@ -393,13 +394,13 @@ type ProvidedExprType = | ProvidedLambdaExpr of ProvidedVar * ProvidedExpr - | ProvidedCallExpr of ProvidedExpr option * ProvidedMethodInfo * ProvidedExpr [] + | ProvidedCallExpr of ProvidedExpr option * ProvidedMethodInfo * ProvidedExpr[] | ProvidedConstantExpr of obj * ProvidedType | ProvidedDefaultExpr of ProvidedType - | ProvidedNewTupleExpr of ProvidedExpr [] + | ProvidedNewTupleExpr of ProvidedExpr[] | ProvidedTupleGetExpr of ProvidedExpr * int @@ -439,30 +440,29 @@ type ProvidedVar = override GetHashCode: unit -> int /// Get the provided expression for a particular use of a method. -val GetInvokerExpression: ITypeProvider * ProvidedMethodBase * ProvidedVar [] -> ProvidedExpr +val GetInvokerExpression: ITypeProvider * ProvidedMethodBase * ProvidedVar[] -> ProvidedExpr /// Validate that the given provided type meets some of the rules for F# provided types val ValidateProvidedTypeAfterStaticInstantiation: - m: range * st: Tainted * expectedPath: string [] * expectedName: string -> unit + m: range * st: Tainted * expectedPath: string[] * expectedName: string -> unit /// Try to apply a provided type to the given static arguments. If successful also return a function /// to check the type name is as expected (this function is called by the caller of TryApplyProvidedType /// after other checks are made). val TryApplyProvidedType: - typeBeforeArguments: Tainted * optGeneratedTypePath: string list option * staticArgs: obj [] * range -> + typeBeforeArguments: Tainted * optGeneratedTypePath: string list option * staticArgs: obj[] * range -> (Tainted * (unit -> unit)) option /// Try to apply a provided method to the given static arguments. val TryApplyProvidedMethod: - methBeforeArgs: Tainted * staticArgs: obj [] * range -> Tainted option + methBeforeArgs: Tainted * staticArgs: obj[] * range -> Tainted option /// Try to resolve a type in the given extension type resolver -val TryResolveProvidedType: - Tainted * range * string [] * typeName: string -> Tainted option +val TryResolveProvidedType: Tainted * range * string[] * typeName: string -> Tainted option /// Try to resolve a type in the given extension type resolver val TryLinkProvidedType: - Tainted * string [] * typeLogicalName: string * range: range -> Tainted option + Tainted * string[] * typeLogicalName: string * range: range -> Tainted option /// Get the parts of a .NET namespace. Special rules: null means global, empty is not allowed. val GetProvidedNamespaceAsPath: range * Tainted * string -> string list @@ -488,9 +488,11 @@ type ProviderGeneratedType = /// The table of information recording remappings from type names in the provided assembly to type /// names in the statically linked, embedded assembly, plus what types are nested in side what types. type ProvidedAssemblyStaticLinkingMap = - { /// The table of remappings from type names in the provided assembly to type - /// names in the statically linked, embedded assembly. - ILTypeMap: Dictionary } + { + /// The table of remappings from type names in the provided assembly to type + /// names in the statically linked, embedded assembly. + ILTypeMap: Dictionary + } /// Create a new static linking map, ready to populate with data. static member CreateNew: unit -> ProvidedAssemblyStaticLinkingMap diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 3397632fc7a..191d658f371 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4,7 +4,8 @@ module internal rec FSharp.Compiler.TypedTree open System -open System.Collections.Generic +open System.Collections.Generic +open System.Collections.Immutable open System.Diagnostics open System.Reflection @@ -5291,8 +5292,39 @@ type CcuData = override x.ToString() = sprintf "CcuData(%A)" x.FileName +type CcuTypeForwarderTree = + { + Value : Lazy option + Children : ImmutableDictionary + } + + static member Empty = { Value = None; Children = ImmutableDictionary.Empty } + +module CcuTypeForwarderTable = + let rec findInTree (remainingPath: ArraySegment) (finalKey : string) (tree:CcuTypeForwarderTree): Lazy option = + let nodes = tree.Children + let searchTerm = + if remainingPath.Count = 0 then + finalKey + else + remainingPath.Array.[remainingPath.Offset] + match nodes.TryGetValue searchTerm with + | true, innerTree -> + if remainingPath.Count = 0 then + innerTree.Value + else + findInTree (ArraySegment(remainingPath.Array, remainingPath.Offset + 1, remainingPath.Count - 1)) finalKey innerTree + | false, _ -> None + /// Represents a table of .NET CLI type forwarders for an assembly -type CcuTypeForwarderTable = Map> +type CcuTypeForwarderTable = + { + Root : CcuTypeForwarderTree + } + + static member Empty : CcuTypeForwarderTable = { Root = CcuTypeForwarderTree.Empty } + member this.TryGetValue (path:string array) (item:string): Lazy option = + CcuTypeForwarderTable.findInTree (ArraySegment path) item this.Root type CcuReference = string // ILAssemblyRef @@ -5381,7 +5413,7 @@ type CcuThunk = member ccu.Contents = ccu.Deref.Contents /// The table of type forwarders for this assembly - member ccu.TypeForwarders: Map> = ccu.Deref.TypeForwarders + member ccu.TypeForwarders: CcuTypeForwarderTable = ccu.Deref.TypeForwarders /// The table of modules and namespaces at the "root" of the assembly member ccu.RootModulesAndNamespaces = ccu.Contents.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions @@ -5418,10 +5450,8 @@ type CcuThunk = /// Try to resolve a path into the CCU by referencing the .NET/CLI type forwarder table of the CCU member ccu.TryForward(nlpath: string[], item: string) : EntityRef option = ccu.EnsureDerefable nlpath - let key = nlpath, item - match ccu.TypeForwarders.TryGetValue key with - | true, entity -> Some(entity.Force()) - | _ -> None + ccu.TypeForwarders.TryGetValue nlpath item + |> Option.map (fun entity -> entity.Force()) /// Used to make forward calls into the type/assembly loader when comparing member signatures during linking member ccu.MemberSignatureEquality(ty1: TType, ty2: TType) = diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi new file mode 100644 index 00000000000..e7085c99a0b --- /dev/null +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -0,0 +1,4310 @@ +/// Defines the typed abstract syntax intermediate representation used throughout the F# compiler. +module internal rec FSharp.Compiler.TypedTree + +open System +open System.Diagnostics +open System.Collections.Generic +open System.Collections.Immutable +open Internal.Utilities.Collections +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras +open Internal.Utilities.Rational +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Syntax +open FSharp.Compiler.Text +open FSharp.Compiler.TypeProviders +open FSharp.Compiler.Xml +open FSharp.Core.CompilerServices + +type Stamp = int64 + +type StampMap<'T> = Map + +[] +type ValInline = + + /// Indicates the value is inlined but the .NET IL code for the function still exists, e.g. to satisfy interfaces on objects, but that it is also always inlined + | Always + + /// Indicates the value may optionally be inlined by the optimizer + | Optional + + /// Indicates the value must never be inlined by the optimizer + | Never + + /// Returns true if the implementation of a value must always be inlined + member MustInline: bool + +/// A flag associated with values that indicates whether the recursive scope of the value is currently being processed, type +/// if the value has been generalized or not as yet. +type ValRecursiveScopeInfo = + + /// Set while the value is within its recursive scope. The flag indicates if the value has been eagerly generalized type accepts generic-recursive calls + | ValInRecScope of bool + + /// The normal value for this flag when the value is not within its recursive scope + | ValNotInRecScope + +type ValMutability = + | Immutable + | Mutable + +/// Indicates if a type parameter is needed at runtime type may not be eliminated +[] +type TyparDynamicReq = + + /// Indicates the type parameter is not needed at runtime type may be eliminated + | No + + /// Indicates the type parameter is needed at runtime type may not be eliminated + | Yes + +type ValBaseOrThisInfo = + + /// Indicates a ref-cell holding 'this' or the implicit 'this' used throughout an + /// implicit constructor to access type set values + | CtorThisVal + + /// Indicates the value called 'base' available for calling base class members + | BaseVal + + /// Indicates a normal value + | NormalVal + + /// Indicates the 'this' value specified in a memberm e.g. 'x' in 'member x.M() = 1' + | MemberThisVal + +/// Flags on values +[] +type ValFlags = + + new: + recValInfo: ValRecursiveScopeInfo * + baseOrThis: ValBaseOrThisInfo * + isCompGen: bool * + inlineInfo: ValInline * + isMutable: ValMutability * + isModuleOrMemberBinding: bool * + isExtensionMember: bool * + isIncrClassSpecialMember: bool * + isTyFunc: bool * + allowTypeInst: bool * + isGeneratedEventVal: bool -> + ValFlags + + new: flags: int64 -> ValFlags + + member WithIsCompilerGenerated: isCompGen: bool -> ValFlags + + member WithRecursiveValInfo: recValInfo: ValRecursiveScopeInfo -> ValFlags + + member BaseOrThisInfo: ValBaseOrThisInfo + + member HasBeenReferenced: bool + + member IgnoresByrefScope: bool + + member InlineIfLambda: bool + + member InlineInfo: ValInline + + member IsCompiledAsStaticPropertyWithoutField: bool + + member IsCompilerGenerated: bool + + member IsExtensionMember: bool + + member IsFixed: bool + + member IsGeneratedEventVal: bool + + member IsIncrClassSpecialMember: bool + + member IsMemberOrModuleBinding: bool + + member IsTypeFunction: bool + + member MakesNoCriticalTailcalls: bool + + member MutabilityInfo: ValMutability + + member PermitsExplicitTypeInstantiation: bool + + /// Get the flags as included in the F# binary metadata + member PickledBits: int64 + + member RecursiveValInfo: ValRecursiveScopeInfo + + member WithHasBeenReferenced: ValFlags + + member WithIgnoresByrefScope: ValFlags + + member WithInlineIfLambda: ValFlags + + member WithIsCompiledAsStaticPropertyWithoutField: ValFlags + + member WithIsFixed: ValFlags + + member WithIsMemberOrModuleBinding: ValFlags + + member WithMakesNoCriticalTailcalls: ValFlags + +/// Represents the kind of a type parameter +[] +type TyparKind = + | Type + | Measure + + override ToString: unit -> string + + member AttrName: string voption + +/// Indicates if the type variable can be solved or given new constraints. The status of a type variable +/// evolves towards being either rigid or solved. +[] +type TyparRigidity = + + /// Indicates the type parameter can't be solved + | Rigid + + /// Indicates the type parameter can't be solved, but the variable is not set to "rigid" until after inference is complete + | WillBeRigid + + /// Indicates we give a warning if the type parameter is ever solved + | WarnIfNotRigid + + /// Indicates the type parameter is an inference variable may be solved + | Flexible + + /// Indicates the type parameter derives from an '_' anonymous type + /// For units-of-measure, we give a warning if this gets solved to '1' + | Anon + + member ErrorIfUnified: bool + + member WarnIfMissingConstraint: bool + + member WarnIfUnified: bool + +/// Encode typar flags into a bit field +[] +type TyparFlags = + + new: + kind: TyparKind * + rigidity: TyparRigidity * + isFromError: bool * + isCompGen: bool * + staticReq: Syntax.TyparStaticReq * + dynamicReq: TyparDynamicReq * + equalityDependsOn: bool * + comparisonDependsOn: bool -> + TyparFlags + + new: flags: int32 -> TyparFlags + + member WithCompatFlex: b: bool -> TyparFlags + + /// Indicates that whether or not a generic type definition satisfies the comparison constraint is dependent on whether this type variable satisfies the comparison constraint. + member ComparisonConditionalOn: bool + + /// Indicates if a type parameter is needed at runtime type may not be eliminated + member DynamicReq: TyparDynamicReq + + /// Indicates that whether or not a generic type definition satisfies the equality constraint is dependent on whether this type variable satisfies the equality constraint. + member EqualityConditionalOn: bool + + /// Indicates that whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning) + member IsCompatFlex: bool + + /// Indicates if the type variable is compiler generated, i.e. is an implicit type inference variable + member IsCompilerGenerated: bool + + /// Indicates if the type inference variable was generated after an error when type checking expressions or patterns + member IsFromError: bool + + /// Indicates whether a type variable can be instantiated by types or units-of-measure. + member Kind: TyparKind + + /// Get the flags as included in the F# binary metadata. We pickle this as int64 to allow for future expansion + member PickledBits: int32 + + /// Indicates if the type variable can be solved or given new constraints. The status of a type variable + /// generally always evolves towards being either rigid or solved. + member Rigidity: TyparRigidity + + /// Indicates if the type variable has a static "head type" requirement, i.e. ^a variables used in FSharp.Core type member constraints. + member StaticReq: Syntax.TyparStaticReq + +/// Encode entity flags into a bit field. We leave lots of space to allow for future expansion. +[] +type EntityFlags = + + new: + usesPrefixDisplay: bool * + isModuleOrNamespace: bool * + preEstablishedHasDefaultCtor: bool * + hasSelfReferentialCtor: bool * + isStructRecordOrUnionType: bool -> + EntityFlags + + new: flags: int64 -> EntityFlags + + /// Adjust the on-demand analysis about whether the entity is assumed to be a readonly struct + member WithIsAssumedReadOnly: flag: bool -> EntityFlags + + /// Adjust the on-demand analysis about whether the entity has the IsByRefLike attribute + member WithIsByRefLike: flag: bool -> EntityFlags + + /// Adjust the on-demand analysis about whether the entity has the IsReadOnly attribute + member WithIsReadOnly: flag: bool -> EntityFlags + + member HasSelfReferentialConstructor: bool + + /// Indicates the Entity is actually a module or namespace, not a type definition + member IsModuleOrNamespace: bool + + /// Indicates the type prefers the "tycon" syntax for display etc. + member IsPrefixDisplay: bool + + /// This bit represents a F# record that is a value type, or a struct record. + member IsStructRecordOrUnionType: bool + + /// Get the flags as included in the F# binary metadata + member PickledBits: int64 + + member PreEstablishedHasDefaultConstructor: bool + + /// These two bits represents the on-demand analysis about whether the entity is assumed to be a readonly struct + member TryIsAssumedReadOnly: bool voption + + /// These two bits represents the on-demand analysis about whether the entity has the IsByRefLike attribute + member TryIsByRefLike: bool voption + + /// These two bits represents the on-demand analysis about whether the entity has the IsReadOnly attribute + member TryIsReadOnly: bool voption + + /// This bit is reserved for us in the pickle format, see pickle.fs, it's being listed here to stop it ever being used for anything else + static member ReservedBitForPickleFormatTyconReprFlag: int64 + +exception UndefinedName of depth: int * error: (string -> string) * id: Ident * suggestions: Suggestions + +exception InternalUndefinedItemRef of (string * string * string -> int * string) * string * string * string + +type ModuleOrNamespaceKind = + + /// Indicates that a module is compiled to a class with the "Module" suffix added. + | FSharpModuleWithSuffix + + /// Indicates that a module is compiled to a class with the same name as the original module + | ModuleOrType + + /// Indicates that a 'module' is really a namespace + | Namespace + +/// A public path records where a construct lives within the global namespace +/// of a CCU. +type PublicPath = + | PubPath of string[] + + member EnclosingPath: string[] + +/// The information ILXGEN needs about the location of an item +type CompilationPath = + | CompPath of ILScopeRef * (string * ModuleOrNamespaceKind) list + + /// String 'Module' off an F# module name, if FSharpModuleWithSuffix is used + static member DemangleEntityName: nm: string -> k: ModuleOrNamespaceKind -> string + + member NestedCompPath: n: string -> moduleKind: ModuleOrNamespaceKind -> CompilationPath + + member NestedPublicPath: id: Syntax.Ident -> PublicPath + + member AccessPath: (string * ModuleOrNamespaceKind) list + + member DemangledPath: string list + + member ILScopeRef: ILScopeRef + + member MangledPath: string list + + member ParentCompPath: CompilationPath + +[] +type EntityOptionalData = + { + + /// The name of the type, possibly with `n mangling + mutable entity_compiled_name: string option + + /// If this field is populated, this is the implementation range for an item in a signature, otherwise it is + /// the signature range for an item in an implementation + mutable entity_other_range: (range * bool) option + + mutable entity_kind: TyparKind + + /// The declared documentation for the type or module + mutable entity_xmldoc: XmlDoc + + /// The XML document signature for this entity + mutable entity_xmldocsig: string + + /// If non-None, indicates the type is an abbreviation for another type. + mutable entity_tycon_abbrev: TType option + + /// The declared accessibility of the representation, not taking signatures into account + mutable entity_tycon_repr_accessibility: Accessibility + + /// Indicates how visible is the entity is. + mutable entity_accessibility: Accessibility + + /// Field used when the 'tycon' is really an exception definition + mutable entity_exn_info: ExceptionInfo + } + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents a type definition, exception definition, module definition or namespace definition. +[] +type Entity = + { + + /// The declared type parameters of the type + mutable entity_typars: LazyWithContext + + mutable entity_flags: EntityFlags + + /// The unique stamp of the "tycon blob". Note the same tycon in signature type implementation get different stamps + mutable entity_stamp: Stamp + + /// The name of the type, possibly with `n mangling + mutable entity_logical_name: string + + /// The declaration location for the type constructor + mutable entity_range: range + + /// The declared attributes for the type + mutable entity_attribs: Attribs + + /// The declared representation of the type, i.e. record, union, class etc. + mutable entity_tycon_repr: TyconRepresentation + + /// The methods type properties of the type + mutable entity_tycon_tcaug: TyconAugmentation + + /// This field is used when the 'tycon' is really a module definition. It holds statically nested type definitions type nested modules + mutable entity_modul_type: MaybeLazy + + /// The stable path to the type, e.g. Microsoft.FSharp.Core.FSharpFunc`2 + mutable entity_pubpath: PublicPath option + + /// The stable path to the type, e.g. Microsoft.FSharp.Core.FSharpFunc`2 + mutable entity_cpath: CompilationPath option + + /// Used during codegen to hold the ILX representation indicating how to access the type + mutable entity_il_repr_cache: cache + + mutable entity_opt_data: EntityOptionalData option + } + + /// Create a new entity with the given backing data. Only used during unpickling of F# metadata. + static member New: _reason: 'b -> data: Entity -> Entity + + static member NewEmptyEntityOptData: unit -> EntityOptionalData + + /// Create a new entity with empty, unlinked data. Only used during unpickling of F# metadata. + static member NewUnlinked: unit -> Entity + + member GetDisplayName: coreName: bool * ?withStaticParameters: bool * ?withUnderscoreTypars: bool -> string + + /// Get a field by index in definition order + member GetFieldByIndex: n: int -> RecdField + + /// Get a field by name. + member GetFieldByName: n: string -> RecdField option + + /// Get a union case of a type by name + member GetUnionCaseByName: n: string -> UnionCase option + + /// Link an entity based on empty, unlinked data to the given data. Only used during unpickling of F# metadata. + member Link: tg: EntityData -> unit + + /// Set the custom attributes on an F# type definition. + member SetAttribs: attribs: Attribs -> unit + + member SetCompiledName: name: string option -> unit + + member SetExceptionInfo: exn_info: ExceptionInfo -> unit + + /// Set the on-demand analysis about whether the entity is assumed to be a readonly struct + member SetIsAssumedReadOnly: b: bool -> unit + + /// Set the on-demand analysis about whether the entity has the IsByRefLike attribute + member SetIsByRefLike: b: bool -> unit + + /// Set the on-demand analysis about whether the entity has the IsReadOnly attribute + member SetIsReadOnly: b: bool -> unit + + /// Sets the structness of a record or union type definition + member SetIsStructRecordOrUnion: b: bool -> unit + + member SetOtherRange: m: (range * bool) -> unit + + member SetTypeAbbrev: tycon_abbrev: TType option -> unit + + member SetTypeOrMeasureKind: kind: TyparKind -> unit + + override ToString: unit -> string + + /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. + /// + /// Lazy because it may read metadata, must provide a context "range" in case error occurs reading metadata. + member Typars: m: range -> Typars + + /// Get the value representing the accessibility of an F# type definition or module. + member Accessibility: Accessibility + + /// Get a table of fields for all the F#-defined record, struct type class fields in this type definition, including + /// static fields, 'val' declarations type hidden fields from the compilation of implicit class constructions. + member AllFieldTable: TyconRecdFields + + /// Get an array of fields for all the F#-defined record, struct type class fields in this type definition, including + /// static fields, 'val' declarations type hidden fields from the compilation of implicit class constructions. + member AllFieldsArray: RecdField[] + + /// Get a list of fields for all the F#-defined record, struct type class fields in this type definition, including + /// static fields, 'val' declarations type hidden fields from the compilation of implicit class constructions. + member AllFieldsAsList: RecdField list + + /// Gets all implicit hash/equals/compare methods added to an F# record, union or struct type definition. + member AllGeneratedValues: ValRef list + + /// Get a list of all instance fields for F#-defined record, struct type class fields in this type definition. + /// including hidden fields from the compilation of implicit class constructions. + member AllInstanceFieldsAsList: RecdField list + + /// The F#-defined custom attributes of the entity, if any. If the entity is backed by Abstract IL or provided metadata + /// then this does not include any attributes from those sources. + member Attribs: Attribs + + /// Get a blob of data indicating how this type is nested inside other namespaces, modules type types. + member CompilationPath: CompilationPath + + /// Get a blob of data indicating how this type is nested inside other namespaces, modules type types. + member CompilationPathOpt: CompilationPath option + + /// The compiled name of the namespace, module or type, e.g. FSharpList`1, ListModule or FailureException + member CompiledName: string + + /// Get the cache of the compiled ILTypeRef representation of this module or type. + member CompiledReprCache: cache + + /// Gets the data indicating the compiled representation of a type or module in terms of Abstract IL data structures. + member CompiledRepresentation: CompiledTypeRepr + + /// Gets the data indicating the compiled representation of a named type or module in terms of Abstract IL data structures. + member CompiledRepresentationForNamedType: ILTypeRef + + [] + member DebugText: string + + /// The range in the implementation, adjusted for an item in a signature + member DefinitionRange: range + + /// Demangle the module name, if FSharpModuleWithSuffix is used + member DemangledModuleOrNamespaceName: string + + /// The display name of the namespace, module or type, e.g. List instead of List`1, type no static parameters + /// For modules the Module suffix is removed if FSharpModuleWithSuffix is used. + /// + /// Backticks are added implicitly for entities with non-identifier names + member DisplayName: string + + /// The display name of the namespace, module or type, e.g. List instead of List`1, type no static parameters. + /// For modules the Module suffix is removed if FSharpModuleWithSuffix is used. + /// + /// No backticks are added for entities with non-identifier names + member DisplayNameCore: string + + /// The display name of the namespace, module or type, e.g. List instead of List`1, including static parameters if any + /// For modules the Module suffix is removed if FSharpModuleWithSuffix is used. + /// + /// Backticks are added implicitly for entities with non-identifier names + member DisplayNameWithStaticParameters: string + + /// The display name of the namespace, module or type with <_, _, _> added for generic types, plus static parameters if any + /// For modules the Module suffix is removed if FSharpModuleWithSuffix is used. + /// + /// Backticks are added implicitly for entities with non-identifier names + member DisplayNameWithStaticParametersAndUnderscoreTypars: string + + member EntityCompiledName: string option + + /// The information about the r.h.s. of an F# exception definition, if any. + member ExceptionInfo: ExceptionInfo + + /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. + member FSharpObjectModelTypeInfo: TyconObjModelData + + /// Gets any implicit CompareTo methods added to an F# record, union or struct type definition. + member GeneratedCompareToValues: (ValRef * ValRef) option + + /// Gets any implicit CompareTo (with comparer argument) methods added to an F# record, union or struct type definition. + member GeneratedCompareToWithComparerValues: ValRef option + + /// Gets any implicit hash/equals methods added to an F# record, union or struct type definition. + member GeneratedHashAndEqualsValues: (ValRef * ValRef) option + + /// Gets any implicit hash/equals (with comparer argument) methods added to an F# record, union or struct type definition. + member GeneratedHashAndEqualsWithComparerValues: (ValRef * ValRef * ValRef) option + + /// Indicates if we have pre-determined that a type definition has a self-referential constructor using 'as x' + member HasSelfReferentialConstructor: bool + + /// Get the Abstract IL scope, nesting type metadata for this + /// type definition, assuming it is backed by Abstract IL metadata. + member ILTyconInfo: TILObjectReprData + + /// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata. + member ILTyconRawMetadata: ILTypeDef + + /// The identifier at the point of declaration of the type definition. + member Id: Syntax.Ident + + /// Gets the immediate interface types of an F# type definition. Further interfaces may be supported through class type interface inheritance. + member ImmediateInterfaceTypesOfFSharpTycon: TType list + + /// Gets the immediate interface definitions of an F# type definition. Further interfaces may be supported through class type interface inheritance. + member ImmediateInterfacesOfFSharpTycon: (TType * bool * range) list + + /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll which uses + /// an assembly-code representation for the type, e.g. the primitive array type constructor. + member IsAsmReprTycon: bool + + /// Indicates if this is an enum type definition + member IsEnumTycon: bool + + /// Indicates if the entity is erased, either a measure definition, or an erased provided type definition + member IsErased: bool + + /// Indicates if this is an F#-defined class type definition + member IsFSharpClassTycon: bool + + /// Indicates if this is an F#-defined delegate type definition + member IsFSharpDelegateTycon: bool + + /// Indicates if this is an F#-defined enum type definition + member IsFSharpEnumTycon: bool + + /// Indicates if the entity represents an F# exception declaration. + member IsFSharpException: bool + + /// Indicates if this is an F#-defined interface type definition + member IsFSharpInterfaceTycon: bool + + /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition + member IsFSharpObjectModelTycon: bool + + /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition + member IsFSharpStructOrEnumTycon: bool + + /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature, + /// which in F# is called a 'unknown representation' type). + member IsHiddenReprTycon: bool + + /// Indicates if this is a .NET-defined enum type definition + member IsILEnumTycon: bool + + /// Indicates if this is a .NET-defined struct or enum type definition, i.e. a value type definition + member IsILStructOrEnumTycon: bool + + /// Indicate if this is a type definition backed by Abstract IL metadata. + member IsILTycon: bool + + /// Indicates if the entity is linked to backing data. Only used during unpickling of F# metadata. + member IsLinked: bool + + /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll like 'float<_>' which + /// defines a measure type with a relation to an existing non-measure type as a representation. + member IsMeasureableReprTycon: bool + + /// Indicates if the entity is an F# module definition + member IsModule: bool + + /// Indicates the Entity is actually a module or namespace, not a type definition + member IsModuleOrNamespace: bool + + /// Indicates if the entity is a namespace + member IsNamespace: bool + + /// Indicates the type prefers the "tycon" syntax for display etc. + member IsPrefixDisplay: bool + + /// Indicates if the entity is a provided type or namespace definition + member IsProvided: bool + + /// Indicates if the entity is an erased provided type definition + member IsProvidedErasedTycon: bool + + /// Indicates if the entity is a generated provided type definition, i.e. not erased. + member IsProvidedGeneratedTycon: bool + + /// Indicates if the entity is a provided namespace fragment + member IsProvidedNamespace: bool + + /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition. + member IsRecordTycon: bool + + member IsStaticInstantiationTycon: bool + + /// Indicates if this is a struct or enum type definition, i.e. a value type definition + member IsStructOrEnumTycon: bool + + /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition that is a value type. + member IsStructRecordOrUnionTycon: bool + + /// Indicates if this entity is an F# type abbreviation definition + member IsTypeAbbrev: bool + + /// Indicate if this is a type whose r.h.s. is known to be a union type definition. + member IsUnionTycon: bool + + /// The name of the namespace, module or type, possibly with mangling, e.g. List`1, List or FailureException + member LogicalName: string + + /// Gets all immediate members of an F# type definition keyed by name, including compiler-generated ones. + /// Note: result is a indexed table, type for each name the results are in reverse declaration order + member MembersOfFSharpTyconByName: NameMultiMap + + /// Gets the immediate members of an F# type definition, excluding compiler-generated ones. + /// Note: result is alphabetically sorted, then for each name the results are in declaration order + member MembersOfFSharpTyconSorted: ValRef list + + /// The logical contents of the entity when it is a module or namespace fragment. + member ModuleOrNamespaceType: ModuleOrNamespaceType + + /// Indicates if we have pre-determined that a type definition has a default constructor. + member PreEstablishedHasDefaultConstructor: bool + + /// Get a blob of data indicating how this type is nested in other namespaces, modules or types. + member PublicPath: PublicPath option + + /// The code location where the module, namespace or type is defined. + member Range: range + + member SigRange: range + + /// A unique stamp for this module, namespace or type definition within the context of this compilation. + /// Note that because of signatures, there are situations where in a single compilation the "same" + /// module, namespace or type may have two distinct Entity objects that have distinct stamps. + member Stamp: Stamp + + /// Get a list of all fields for F#-defined record, struct type class fields in this type definition, + /// including static fields, but excluding compiler-generate fields. + member TrueFieldsAsList: RecdField list + + /// Get a list of all instance fields for F#-defined record, struct type class fields in this type definition, + /// excluding compiler-generate fields. + member TrueInstanceFieldsAsList: RecdField list + + /// These two bits represents the on-demand analysis about whether the entity is assumed to be a readonly struct + member TryIsAssumedReadOnly: bool voption + + /// The on-demand analysis about whether the entity has the IsByRefLike attribute + member TryIsByRefLike: bool voption + + /// These two bits represents the on-demand analysis about whether the entity has the IsReadOnly attribute + member TryIsReadOnly: bool voption + + /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. + member TyparsNoRange: Typars + + /// Get the type abbreviated by this type definition, if it is an F# type abbreviation definition + member TypeAbbrev: TType option + + /// The logical contents of the entity when it is a type definition. + member TypeContents: TyconAugmentation + + /// The kind of the type definition - is it a measure definition or a type definition? + member TypeOrMeasureKind: TyparKind + + /// Get the value representing the accessibility of the r.h.s. of an F# type definition. + member TypeReprAccessibility: Accessibility + + /// The information about the r.h.s. of a type definition, if any. For example, the r.h.s. of a union or record type. + member TypeReprInfo: TyconRepresentation + + /// Get the union cases for a type, if any + member UnionCasesArray: UnionCase[] + + /// Get the union cases for a type, if any, as a list + member UnionCasesAsList: UnionCase list + + /// Get the union cases type other union-type information for a type, if any + member UnionTypeInfo: TyconUnionData voption + + /// The XML documentation of the entity, if any. If the entity is backed by provided metadata + /// then this _does_ include this documentation. If the entity is backed by Abstract IL metadata + /// or comes from another F# assembly then it does not (because the documentation will get read from + /// an XML file). + member XmlDoc: XmlDoc + + /// The XML documentation sig-string of the entity, if any, to use to lookup an .xml doc file. This also acts + /// as a cache for this sig-string computation. + member XmlDocSig: string with get, set + +type EntityData = Entity + +/// Represents the parent entity of a type definition, if any +type ParentRef = + | Parent of parent: EntityRef + | ParentNone + +/// Specifies the compiled representations of type type exception definitions. Basically +/// just an ILTypeRef. Computed type cached by later phases. Stored in +/// type type exception definitions. Not pickled. Store an optional ILType object for +/// non-generic types. +[] +type CompiledTypeRepr = + + /// An AbstractIL type representation that is just the name of a type. + /// + /// CompiledTypeRepr.ILAsmNamed (ilTypeRef, ilBoxity, ilTypeOpt) + /// + /// The ilTypeOpt is present for non-generic types. It is an ILType corresponding to the first two elements of the case. This + /// prevents reallocation of the ILType each time we need to generate it. For generic types, it is None. + | ILAsmNamed of ilTypeRef: ILTypeRef * ilBoxity: ILBoxity * ilTypeOpt: ILType option + + /// An AbstractIL type representation that may include type variables + | ILAsmOpen of ilType: ILType + + override ToString: unit -> string + + [] + member DebugText: string + +[] +type TyconAugmentation = + { + + /// This is the value implementing the auto-generated comparison + /// semantics if any. It is not present if the type defines its own implementation + /// of IComparable or if the type doesn't implement IComparable implicitly. + mutable tcaug_compare: (ValRef * ValRef) option + + /// This is the value implementing the auto-generated comparison + /// semantics if any. It is not present if the type defines its own implementation + /// of IStructuralComparable or if the type doesn't implement IComparable implicitly. + mutable tcaug_compare_withc: ValRef option + + /// This is the value implementing the auto-generated equality + /// semantics if any. It is not present if the type defines its own implementation + /// of Object.Equals or if the type doesn't override Object.Equals implicitly. + mutable tcaug_equals: (ValRef * ValRef) option + + /// This is the value implementing the auto-generated comparison + /// semantics if any. It is not present if the type defines its own implementation + /// of IStructuralEquatable or if the type doesn't implement IComparable implicitly. + mutable tcaug_hash_and_equals_withc: (ValRef * ValRef * ValRef) option + + /// True if the type defined an Object.GetHashCode method. In this + /// case we give a warning if we auto-generate a hash method since the semantics may not match up + mutable tcaug_hasObjectGetHashCode: bool + + /// Properties, methods etc. in declaration order. The boolean flag for each indicates if the + /// member is known to be an explicit interface implementation. This must be computed and + /// saved prior to remapping assembly information. + tcaug_adhoc_list: ResizeArray + + /// Properties, methods etc. as lookup table + mutable tcaug_adhoc: NameMultiMap + + /// Interface implementations - boolean indicates compiler-generated + mutable tcaug_interfaces: (TType * bool * range) list + + /// Super type, if any + mutable tcaug_super: TType option + + /// Set to true at the end of the scope where proper augmentations are allowed + mutable tcaug_closed: bool + + /// Set to true if the type is determined to be abstract + mutable tcaug_abstract: bool + } + + static member Create: unit -> TyconAugmentation + + member SetCompare: x: (ValRef * ValRef) -> unit + + member SetCompareWith: x: ValRef -> unit + + member SetEquals: x: (ValRef * ValRef) -> unit + + member SetHasObjectGetHashCode: b: bool -> unit + + member SetHashAndEqualsWith: x: (ValRef * ValRef * ValRef) -> unit + + override ToString: unit -> string + + [] + member DebugText: string + +/// The information for the contents of a type. Also used for a provided namespace. +[] +type TyconRepresentation = + + /// Indicates the type is a class, struct, enum, delegate or interface + | TFSharpObjectRepr of TyconObjModelData + + /// Indicates the type is a record + | TFSharpRecdRepr of TyconRecdFields + + /// Indicates the type is a discriminated union + | TFSharpUnionRepr of TyconUnionData + + /// Indicates the type is a type from a .NET assembly without F# metadata. + | TILObjectRepr of TILObjectReprData + + /// Indicates the type is implemented as IL assembly code using the given closed Abstract IL type + | TAsmRepr of ILType + + /// Indicates the type is parameterized on a measure (e.g. float<_>) but erases to some other type (e.g. float) + | TMeasureableRepr of TType + + /// TProvidedTypeRepr + /// + /// Indicates the representation information for a provided type. + | TProvidedTypeRepr of TProvidedTypeInfo + + /// Indicates the representation information for a provided namespace. + | TProvidedNamespaceRepr of ResolutionEnvironment * Tainted list + + /// The 'NoRepr' value here has four meanings: + /// (1) it indicates 'not yet known' during the first 2 phases of establishing type definitions + /// (2) it indicates 'no representation', i.e. 'type X' in signatures + /// (3) it is the setting used for exception definitions (!) + /// (4) it is the setting used for modules type namespaces. + /// + /// It would be better to separate the "not yet known" type other cases out. + /// The information for exception definitions should be folded into here. + | TNoRepr + + override ToString: unit -> string + +[] +type TILObjectReprData = + | TILObjectReprData of scope: ILScopeRef * nesting: ILTypeDef list * definition: ILTypeDef + + override ToString: unit -> string + + [] + member DebugText: string + +/// The information kept about a provided type +[] +type TProvidedTypeInfo = + { + + /// The parameters given to the provider that provided to this type. + ResolutionEnvironment: ResolutionEnvironment + + /// The underlying System.Type (wrapped as a ProvidedType to make sure we don't call random things on + /// System.Type, type wrapped as Tainted to make sure we track which provider this came from, for reporting + /// error messages) + ProvidedType: Tainted + + /// The base type of the type. We use it to compute the compiled representation of the type for erased types. + /// Reading is delayed, since it does an import on the underlying type + LazyBaseType: LazyWithContext + + /// A flag read eagerly from the provided type type used to compute basic properties of the type definition. + IsClass: bool + + /// A flag read eagerly from the provided type type used to compute basic properties of the type definition. + IsSealed: bool + + /// A flag read eagerly from the provided type type used to compute basic properties of the type definition. + IsAbstract: bool + + /// A flag read eagerly from the provided type type used to compute basic properties of the type definition. + IsInterface: bool + + /// A flag read eagerly from the provided type type used to compute basic properties of the type definition. + IsStructOrEnum: bool + + /// A flag read eagerly from the provided type type used to compute basic properties of the type definition. + IsEnum: bool + + /// A type read from the provided type type used to compute basic properties of the type definition. + /// Reading is delayed, since it does an import on the underlying type + UnderlyingTypeOfEnum: unit -> TType + + /// A flag read from the provided type type used to compute basic properties of the type definition. + /// Reading is delayed, since it looks at the .BaseType + IsDelegate: unit -> bool + + /// Indicates the type is erased + IsErased: bool + + /// Indicates the type is generated, but type-relocation is suppressed + IsSuppressRelocate: bool + } + + /// Gets the base type of an erased provided type + member BaseTypeForErased: m: range * objTy: TType -> TType + + override ToString: unit -> string + + [] + member DebugText: string + + /// Indicates if the provided type is generated, i.e. not erased + member IsGenerated: bool + +type TyconFSharpObjModelKind = + + /// Indicates the type is an F#-declared class (also used for units-of-measure) + | TFSharpClass + + /// Indicates the type is an F#-declared interface + | TFSharpInterface + + /// Indicates the type is an F#-declared struct + | TFSharpStruct + + /// Indicates the type is an F#-declared delegate with the given Invoke signature + | TFSharpDelegate of slotSig: SlotSig + + /// Indicates the type is an F#-declared enumeration + | TFSharpEnum + + /// Indicates if the type definition is a value type + member IsValueType: bool + +/// Represents member values type class fields relating to the F# object model +[] +type TyconObjModelData = + { + + /// Indicates whether the type declaration is an F# class, interface, enum, delegate or struct + fsobjmodel_kind: TyconFSharpObjModelKind + + /// The declared abstract slots of the class, interface or struct + fsobjmodel_vslots: ValRef list + + /// The fields of the class, struct or enum + fsobjmodel_rfields: TyconRecdFields + } + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents record fields in an F# type definition +[] +type TyconRecdFields = + { + + /// The fields of the record, in declaration order. + FieldsByIndex: RecdField[] + + /// The fields of the record, indexed by name. + FieldsByName: NameMap + } + + /// Get a field by index + member FieldByIndex: n: int -> RecdField + + /// Get a field by name + member FieldByName: nm: string -> RecdField option + + override ToString: unit -> string + + /// Get all the fields as a list + member AllFieldsAsList: RecdField list + + [] + member DebugText: string + + /// Get all non-compiler-generated fields as a list + member TrueFieldsAsList: RecdField list + + /// Get all non-compiler-generated instance fields as a list + member TrueInstanceFieldsAsList: RecdField list + +/// Represents union cases in an F# type definition +[] +type TyconUnionCases = + { + + /// The cases of the discriminated union, in declaration order. + CasesByIndex: UnionCase[] + + /// The cases of the discriminated union, indexed by name. + CasesByName: NameMap + } + + /// Get a union case by index + member GetUnionCaseByIndex: n: int -> UnionCase + + override ToString: unit -> string + + [] + member DebugText: string + + /// Get the union cases as a list + member UnionCasesAsList: UnionCase list + +/// Represents the union cases type related information in an F# type definition +[] +type TyconUnionData = + { + + /// The cases contained in the discriminated union. + CasesTable: TyconUnionCases + + /// The ILX data structure representing the discriminated union. + CompiledRepresentation: cache + } + + override ToString: unit -> string + + [] + member DebugText: string + + /// Get the union cases as a list + member UnionCasesAsList: UnionCase list + +/// Represents a union case in an F# type definition +[] +type UnionCase = + { + + /// Data carried by the case. + FieldTable: TyconRecdFields + + /// Return type constructed by the case. Normally exactly the type of the enclosing type, sometimes an abbreviation of it + ReturnType: TType + + /// Documentation for the case + XmlDoc: XmlDoc + + /// XML documentation signature for the case + mutable XmlDocSig: string + + /// Name/range of the case + Id: Syntax.Ident + + /// If this field is populated, this is the implementation range for an item in a signature, otherwise it is + /// the signature range for an item in an implementation + mutable OtherRangeOpt: (range * bool) option + + /// Indicates the declared visibility of the union constructor, not taking signatures into account + Accessibility: Accessibility + + /// Attributes, attached to the generated static method to make instances of the case + mutable Attribs: Attribs + } + + /// Get a field of the union case by position + member GetFieldByIndex: n: int -> RecdField + + /// Get a field of the union case by name + member GetFieldByName: nm: string -> RecdField option + + override ToString: unit -> string + + /// Get the name of the case in generated IL code. + /// Note logical names `op_Nil` type `op_ConsCons` become `Empty` type `Cons` respectively. + /// This is because this is how ILX union code gen expects to see them. + member CompiledName: string + + [] + member DebugText: string + + /// Get the definition location of the union case + member DefinitionRange: range + + /// Get the display name of the union case + /// + /// Backticks type parens are added for non-identifiers. + /// + /// Note logical names op_Nil type op_ConsCons become ([]) type (::) respectively. + member DisplayName: string + + /// Get the core of the display name of the union case + /// + /// Backticks type parens are not added for non-identifiers. + /// + /// Note logical names op_Nil type op_ConsCons become [] type :: respectively. + member DisplayNameCore: string + + /// Indicates if the union case has no fields + member IsNullary: bool + + /// Get the logical name of the union case + member LogicalName: string + + /// Get the declaration location of the union case + member Range: range + + /// Get the full list of fields of the union case + member RecdFields: RecdField list + + /// Get the full array of fields of the union case + member RecdFieldsArray: RecdField[] + + /// Get the signature location of the union case + member SigRange: range + +/// Represents a class, struct, record or exception field in an F# type, exception or union-case definition. +/// This may represent a "field" in either a struct, class, record or union. +[] +type RecdField = + { + + /// Is the field declared mutable in F#? + rfield_mutable: bool + + /// Documentation for the field + rfield_xmldoc: XmlDoc + + /// XML Documentation signature for the field + mutable rfield_xmldocsig: string + + /// The type of the field, w.r.t. the generic parameters of the enclosing type constructor + rfield_type: TType + + /// Indicates a static field + rfield_static: bool + + /// Indicates a volatile field + rfield_volatile: bool + + /// Indicates a compiler generated field, not visible to Intellisense or name resolution + rfield_secret: bool + + /// The default initialization info, for static literals + rfield_const: Const option + + /// Indicates the declared visibility of the field, not taking signatures into account + rfield_access: Accessibility + + /// Attributes attached to generated property + mutable rfield_pattribs: Attribs + + /// Attributes attached to generated field + mutable rfield_fattribs: Attribs + + /// Name/declaration-location of the field + rfield_id: Syntax.Ident + rfield_name_generated: bool + + /// If this field is populated, this is the implementation range for an item in a signature, otherwise it is + /// the signature range for an item in an implementation + mutable rfield_other_range: (range * bool) option + } + + override ToString: unit -> string + + /// Indicates the declared visibility of the field, not taking signatures into account + member Accessibility: Accessibility + + [] + member DebugText: string + + /// Get the definition location of the field + member DefinitionRange: range + + /// Name of the field + member DisplayName: string + + /// Name of the field. For fields this is the same as the logical name. + member DisplayNameCore: string + + /// Attributes attached to generated field + member FieldAttribs: Attribs + + /// The type of the field, w.r.t. the generic parameters of the enclosing type constructor + member FormalType: TType + + /// Name/declaration-location of the field + member Id: Syntax.Ident + + /// Indicates a compiler generated field, not visible to Intellisense or name resolution + member IsCompilerGenerated: bool + + /// Is the field declared mutable in F#? + member IsMutable: bool + + /// Indicates a static field + member IsStatic: bool + + /// Indicates a volatile field + member IsVolatile: bool + + /// Indicates if the field is zero-initialized + member IsZeroInit: bool + + /// The default initialization info, for static literals + member LiteralValue: Const option + + /// Name of the field + member LogicalName: string + + /// Attributes attached to generated property + member PropertyAttribs: Attribs + + /// Get the declaration location of the field + member Range: range + + /// Get the signature location of the field + member SigRange: range + + /// XML Documentation signature for the field + member XmlDoc: XmlDoc + + /// Get or set the XML documentation signature for the field + member XmlDocSig: string with get, set + +/// Represents the implementation of an F# exception definition. +[] +type ExceptionInfo = + + /// Indicates that an exception is an abbreviation for the given exception + | TExnAbbrevRepr of TyconRef + + /// Indicates that an exception is shorthand for the given .NET exception type + | TExnAsmRepr of ILTypeRef + + /// Indicates that an exception carries the given record of values + | TExnFresh of TyconRecdFields + + /// Indicates that an exception is abstract, i.e. is in a signature file, type we do not know the representation + | TExnNone + + override ToString: unit -> string + +/// Represents the contents of of a module of namespace +[] +type ModuleOrNamespaceType = + + new: kind: ModuleOrNamespaceKind * vals: QueueList * entities: QueueList -> ModuleOrNamespaceType + + /// Return a new module or namespace type with an entity added. + member AddEntity: tycon: Tycon -> ModuleOrNamespaceType + + /// Mutation used during compilation of FSharp.Core.dll + member AddModuleOrNamespaceByMutation: modul: ModuleOrNamespace -> unit + + /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace + member AddProvidedTypeEntity: entity: Entity -> unit + + /// Return a new module or namespace type with a value added. + member AddVal: vspec: Val -> ModuleOrNamespaceType + + override ToString: unit -> string + + /// Try to find the member with the given linkage key in the given module. + member TryLinkVal: ccu: CcuThunk * key: ValLinkageFullKey -> Val voption + + /// Get a table of the active patterns defined in this module. + member ActivePatternElemRefLookupTable: NameMap option ref + + /// Type, mapping mangled name to Tycon, e.g. + member AllEntities: QueueList + + /// Get a table of entities indexed by both logical type compiled names + member AllEntitiesByCompiledAndLogicalMangledNames: NameMap + + /// Get a table of entities indexed by both logical name + member AllEntitiesByLogicalMangledName: NameMap + + /// Values, including members in F# types in this module-or-namespace-fragment. + member AllValsAndMembers: QueueList + + /// Compute a table of values type members indexed by logical name. + member AllValsAndMembersByLogicalNameUncached: MultiMap + + /// Get a table of values type members indexed by partial linkage key, which includes name, the mangled name of the parent type (if any), + /// type the method argument count (if any). + member AllValsAndMembersByPartialLinkageKey: MultiMap + + /// Get a table of values indexed by logical name + member AllValsByLogicalName: NameMap + + [] + member DebugText: string + + /// Get a list of F# exception definitions defined within this module, namespace or type. + member ExceptionDefinitions: Entity list + + /// Get a table of F# exception definitions indexed by demangled name, so 'FailureException' is indexed by 'Failure' + member ExceptionDefinitionsByDemangledName: NameMap + + /// Get a list of module type namespace definitions defined within this module, namespace or type. + member ModuleAndNamespaceDefinitions: Entity list + + /// Namespace or module-compiled-as-type? + member ModuleOrNamespaceKind: ModuleOrNamespaceKind + + /// Get a table of nested module type namespace fragments indexed by demangled name (so 'ListModule' becomes 'List') + member ModulesAndNamespacesByDemangledName: NameMap + + /// Get a list of type type exception definitions defined within this module, namespace or type. + member TypeAndExceptionDefinitions: Entity list + + /// Get a list of types defined within this module, namespace or type. + member TypeDefinitions: Entity list + + /// Get a table of types defined within this module, namespace or type. The + /// table is indexed by both name and, for generic types, also by mangled name. + member TypesByAccessNames: LayeredMultiMap + + /// Get a table of types defined within this module, namespace or type. The + /// table is indexed by both name type generic arity. This means that for generic + /// types "List`1", the entry (List, 1) will be present. + member TypesByDemangledNameAndArity: LayeredMap + + member TypesByMangledName: NameMap + +/// Represents a module or namespace definition in the typed AST +type ModuleOrNamespace = Entity + +/// Represents a type or exception definition in the typed AST +type Tycon = Entity + +/// Represents the constraint on access for a construct +[] +type Accessibility = + + /// Indicates the construct can only be accessed from any code in the given type constructor, module or assembly. [] indicates global scope. + | TAccess of compilationPaths: CompilationPath list + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents less-frequently-required data about a type parameter of type inference variable +[] +type TyparOptionalData = + { + + /// MUTABILITY: we set the names of generalized inference type parameters to make the look nice for IL code generation + /// The storage for the IL name for the type parameter. + mutable typar_il_name: string option + + /// The documentation for the type parameter. Empty for inference variables. + /// MUTABILITY: for linking when unpickling + mutable typar_xmldoc: XmlDoc + + /// The inferred constraints for the type parameter or inference variable. + mutable typar_constraints: TyparConstraint list + + /// The declared attributes of the type parameter. Empty for type inference variables. + mutable typar_attribs: Attribs + } + + override ToString: unit -> string + + [] + member DebugText: string + +type TyparData = Typar + +/// A declared generic type/measure parameter, or a type/measure inference variable. +[] +type Typar = + { + + /// MUTABILITY: we set the names of generalized inference type parameters to make the look nice for IL code generation + /// The identifier for the type parameter + mutable typar_id: Syntax.Ident + + /// The flag data for the type parameter + mutable typar_flags: TyparFlags + + /// The unique stamp of the type parameter + /// MUTABILITY: for linking when unpickling + mutable typar_stamp: Stamp + + /// An inferred equivalence for a type inference variable. + mutable typar_solution: TType option + + /// A cached TAST type used when this type variable is used as type. + mutable typar_astype: TType + + /// The optional data for the type parameter + mutable typar_opt_data: TyparOptionalData option + } + + /// Creates a type variable based on the given data. Only used during unpickling of F# metadata. + static member New: data: TyparData -> Typar + + /// Creates a type variable that contains empty data, type is not yet linked. Only used during unpickling of F# metadata. + static member NewUnlinked: unit -> Typar + + /// Links a previously unlinked type variable to the given data. Only used during unpickling of F# metadata. + member Link: tg: TyparData -> unit + + /// Set the attributes on the type parameter + member SetAttribs: attribs: Attrib list -> unit + + /// Sets whether the comparison constraint of a type definition depends on this type variable + member SetComparisonDependsOn: b: bool -> unit + + /// Sets whether a type variable is compiler generated + member SetCompilerGenerated: b: bool -> unit + + /// Adjusts the constraints associated with a type variable + member SetConstraints: cs: TyparConstraint list -> unit + + /// Sets whether a type variable is required at runtime + member SetDynamicReq: b: TyparDynamicReq -> unit + + /// Sets whether the equality constraint of a type definition depends on this type variable + member SetEqualityDependsOn: b: bool -> unit + + /// Set the IL name of the type parameter + member SetILName: il_name: string option -> unit + + /// Sets the identifier associated with a type variable + member SetIdent: id: Syntax.Ident -> unit + + /// Set whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning) + member SetIsCompatFlex: b: bool -> unit + + /// Sets the rigidity of a type variable + member SetRigidity: b: TyparRigidity -> unit + + /// Sets whether a type variable has a static requirement + member SetStaticReq: b: Syntax.TyparStaticReq -> unit + + override ToString: unit -> string + + /// Links a previously unlinked type variable to the given data. Only used during unpickling of F# metadata. + member AsType: TType + + /// The declared attributes of the type parameter. Empty for type inference variables type parameters from .NET. + member Attribs: Attribs + + /// Indicates that whether or not a generic type definition satisfies the comparison constraint is dependent on whether this type variable satisfies the comparison constraint. + member ComparisonConditionalOn: bool + + /// The inferred constraints for the type inference variable, if any + member Constraints: TyparConstraint list + + [] + member DebugText: string + + /// Indicates the display name of a type variable + member DisplayName: string + + /// Indicates if a type parameter is needed at runtime type may not be eliminated + member DynamicReq: TyparDynamicReq + + /// Indicates that whether or not a generic type definition satisfies the equality constraint is dependent on whether this type variable satisfies the equality constraint. + member EqualityConditionalOn: bool + + /// Get the IL name of the type parameter + member ILName: string option + + /// The identifier for a type parameter definition + member Id: Syntax.Ident + + /// Indicates that whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning) + member IsCompatFlex: bool + + /// Indicates if the type variable is compiler generated, i.e. is an implicit type inference variable + member IsCompilerGenerated: bool + + /// Indicates whether a type variable is erased in compiled .NET IL code, i.e. whether it is a unit-of-measure variable + member IsErased: bool + + /// Indicates if the type inference variable was generated after an error when type checking expressions or patterns + member IsFromError: bool + + /// Indicates if a type variable has been linked. Only used during unpickling of F# metadata. + member IsLinked: bool + + /// Indicates if a type variable has been solved. + member IsSolved: bool + + /// Indicates whether a type variable can be instantiated by types or units-of-measure. + member Kind: TyparKind + + /// The name of the type parameter + member Name: string + + /// The range of the identifier for the type parameter definition + member Range: range + + /// Indicates if the type variable can be solved or given new constraints. The status of a type variable + /// generally always evolves towards being either rigid or solved. + member Rigidity: TyparRigidity + + /// The inferred equivalence for the type inference variable, if any. + member Solution: TType option + + /// The unique stamp of the type parameter + member Stamp: Stamp + + /// Indicates if the type variable has a static "head type" requirement, i.e. ^a variables used in FSharp.Core type member constraints. + member StaticReq: Syntax.TyparStaticReq + + /// Get the XML documetnation for the type parameter + member XmlDoc: XmlDoc + +/// Represents a constraint on a type parameter or type +[] +type TyparConstraint = + + /// A constraint that a type is a subtype of the given type + | CoercesTo of ty: TType * range: range + + /// A constraint for a default value for an inference type variable should it be neither generalized nor solved + | DefaultsTo of priority: int * ty: TType * range: range + + /// A constraint that a type has a 'null' value + | SupportsNull of range: range + + /// A constraint that a type has a member with the given signature + | MayResolveMember of constraintInfo: TraitConstraintInfo * range: range + + /// A constraint that a type is a non-Nullable value type + /// These are part of .NET's model of generic constraints, type in order to + /// generate verifiable code we must attach them to F# generalized type variables as well. + | IsNonNullableStruct of range: range + + /// A constraint that a type is a reference type + | IsReferenceType of range: range + + /// A constraint that a type is a simple choice between one of the given ground types. Only arises from 'printf' format strings. See format.fs + | SimpleChoice of tys: TTypes * range: range + + /// A constraint that a type has a parameterless constructor + | RequiresDefaultConstructor of range: range + + /// A constraint that a type is an enum with the given underlying + | IsEnum of ty: TType * range: range + + /// A constraint that a type implements IComparable, with special rules for some known structural container types + | SupportsComparison of range: range + + /// A constraint that a type does not have the Equality(false) attribute, or is not a structural type with this attribute, with special rules for some known structural container types + | SupportsEquality of range: range + + /// A constraint that a type is a delegate from the given tuple of args to the given return type + | IsDelegate of aty: TType * bty: TType * range: range + + /// A constraint that a type is .NET unmanaged type + | IsUnmanaged of range: range + + override ToString: unit -> string + +[] +type TraitWitnessInfo = + | TraitWitnessInfo of TTypes * string * Syntax.SynMemberFlags * TTypes * TType option + + override ToString: unit -> string + + [] + member DebugText: string + + /// Get the member name associated with the member constraint. + member MemberName: string + + /// Get the return type recorded in the member constraint. + member ReturnType: TType option + +/// The specification of a member constraint that must be solved +[] +type TraitConstraintInfo = + + /// Indicates the signature of a member constraint. Contains a mutable solution cell + /// to store the inferred solution of the constraint. + | TTrait of + tys: TTypes * + memberName: string * + _memFlags: Syntax.SynMemberFlags * + argTys: TTypes * + returnTy: TType option * + solution: TraitConstraintSln option ref + + override ToString: unit -> string + + /// Get the argument types recorded in the member constraint. This includes the object instance type for + /// instance members. + member ArgumentTypes: TTypes + + [] + member DebugText: string + + /// Get the member flags associated with the member constraint. + member MemberFlags: Syntax.SynMemberFlags + + /// Get the member name associated with the member constraint. + member MemberName: string + + /// Get the return type recorded in the member constraint. + member ReturnType: TType option + + /// Get or set the solution of the member constraint during inference + member Solution: TraitConstraintSln option with get, set + + /// Get the key associated with the member constraint. + member TraitKey: TraitWitnessInfo + +/// Represents the solution of a member constraint during inference. +[] +type TraitConstraintSln = + + /// FSMethSln(ty, vref, minst) + /// + /// Indicates a trait is solved by an F# method. + /// ty -- the type type its instantiation + /// vref -- the method that solves the trait constraint + /// minst -- the generic method instantiation + | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst + + /// FSRecdFieldSln(tinst, rfref, isSetProp) + /// + /// Indicates a trait is solved by an F# record field. + /// tinst -- the instantiation of the declaring type + /// rfref -- the reference to the record field + /// isSetProp -- indicates if this is a set of a record field + | FSRecdFieldSln of tinst: TypeInst * rfref: RecdFieldRef * isSetProp: bool + + /// Indicates a trait is solved by an F# anonymous record field. + | FSAnonRecdFieldSln of anonInfo: AnonRecdTypeInfo * tinst: TypeInst * index: int + + /// ILMethSln(ty, extOpt, ilMethodRef, minst) + /// + /// Indicates a trait is solved by a .NET method. + /// ty -- the type type its instantiation + /// extOpt -- information about an extension member, if any + /// ilMethodRef -- the method that solves the trait constraint + /// minst -- the generic method instantiation + | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst + + /// ClosedExprSln expr + /// + /// Indicates a trait is solved by an erased provided expression + | ClosedExprSln of expr: Expr + + /// Indicates a trait is solved by a 'fake' instance of an operator, like '+' on integers + | BuiltInSln + + override ToString: unit -> string + +/// The partial information used to index the methods of all those in a ModuleOrNamespace. +[] +type ValLinkagePartialKey = + { + + /// The name of the type with which the member is associated. None for non-member values. + MemberParentMangledName: string option + + /// Indicates if the member is an override. + MemberIsOverride: bool + + /// Indicates the logical name of the member. + LogicalName: string + + /// Indicates the total argument count of the member. + TotalArgCount: int + } + + override ToString: unit -> string + + [] + member DebugText: string + +/// The full information used to identify a specific overloaded method +/// amongst all those in a ModuleOrNamespace. +[] +type ValLinkageFullKey = + + new: partialKey: ValLinkagePartialKey * typeForLinkage: TType option -> ValLinkageFullKey + + override ToString: unit -> string + + [] + member DebugText: string + + /// The partial information used to index the value in a ModuleOrNamespace. + member PartialKey: ValLinkagePartialKey + + /// The full type of the value for the purposes of linking. May be None for non-members, since they can't be overloaded. + member TypeForLinkage: TType option + +[] +type ValOptionalData = + { + + /// MUTABILITY: for unpickle linkage + mutable val_compiled_name: string option + + /// If this field is populated, this is the implementation range for an item in a signature, otherwise it is + /// the signature range for an item in an implementation + mutable val_other_range: (range * bool) option + mutable val_const: Const option + + /// What is the original, unoptimized, closed-term definition, if any? + /// Used to implement [] + mutable val_defn: Expr option + mutable val_repr_info: ValReprInfo option + + /// How visible is this? + /// MUTABILITY: for unpickle linkage + mutable val_access: Accessibility + + /// XML documentation attached to a value. + /// MUTABILITY: for unpickle linkage + mutable val_xmldoc: XmlDoc + + /// Is the value actually an instance method/property/event that augments + /// a type, type if so what name does it take in the IL? + /// MUTABILITY: for unpickle linkage + mutable val_member_info: ValMemberInfo option + mutable val_declaring_entity: ParentRef + + /// XML documentation signature for the value + mutable val_xmldocsig: string + + /// Custom attributes attached to the value. These contain references to other values (i.e. constructors in types). Mutable to fixup + /// these value references after copying a collection of values. + mutable val_attribs: Attribs + } + + override ToString: unit -> string + + [] + member DebugText: string + +type ValData = Val + +[] +type Val = + { + + /// Mutable for unpickle linkage + mutable val_logical_name: string + + /// Mutable for unpickle linkage + mutable val_range: range + mutable val_type: TType + + /// Mutable for unpickle linkage + mutable val_stamp: Stamp + + /// See vflags section further below for encoding/decodings here + mutable val_flags: ValFlags + mutable val_opt_data: ValOptionalData option + } + + /// Create a new value with the given backing data. Only used during unpickling of F# metadata. + static member New: data: Val -> Val + + static member NewEmptyValOptData: unit -> ValOptionalData + + /// Create a new value with empty, unlinked data. Only used during unpickling of F# metadata. + static member NewUnlinked: unit -> Val + + /// The name of the method in compiled code (with some exceptions where ilxgen.fs decides not to use a method impl) + /// - If this is a property then this is 'get_Foo' or 'set_Foo' + /// - If this is an implementation of an abstract slot then this may be a mangled name + /// - If this is an extension member then this will be a mangled name + /// - If this is an operator then this is 'op_Addition' + member CompiledName: compilerGlobalState: CompilerGlobalState.CompilerGlobalState option -> string + + /// The full information used to identify a specific overloaded method amongst all those in a ModuleOrNamespace. + member GetLinkageFullKey: unit -> ValLinkageFullKey + + /// The partial information used to index the methods of all those in a ModuleOrNamespace. + member GetLinkagePartialKey: unit -> ValLinkagePartialKey + + /// Link a value based on empty, unlinked data to the given data. Only used during unpickling of F# metadata. + member Link: tg: ValData -> unit + + member SetAttribs: attribs: Attribs -> unit + + /// Set all the data on a value + member SetData: tg: ValData -> unit + + member SetDeclaringEntity: parent: ParentRef -> unit + + member SetHasBeenReferenced: unit -> unit + + member SetIgnoresByrefScope: unit -> unit + + member SetInlineIfLambda: unit -> unit + + member SetIsCompiledAsStaticPropertyWithoutField: unit -> unit + + member SetIsCompilerGenerated: v: bool -> unit + + member SetIsFixed: unit -> unit + + member SetIsMemberOrModuleBinding: unit -> unit + + member SetLogicalName: nm: string -> unit + + member SetMakesNoCriticalTailcalls: unit -> unit + + member SetMemberInfo: member_info: ValMemberInfo -> unit + + member SetOtherRange: m: (range * bool) -> unit + + member SetType: ty: TType -> unit + + member SetValDefn: val_defn: Expr -> unit + + member SetValRec: b: ValRecursiveScopeInfo -> unit + + member SetValReprInfo: info: ValReprInfo option -> unit + + override ToString: unit -> string + + /// How visible is this value, function or member? + member Accessibility: Accessibility + + /// Get the apparent parent entity for the value, i.e. the entity under with which the + /// value is associated. For extension members this is the nominal type the member extends. + /// For other values it is just the actual parent. + member ApparentEnclosingEntity: ParentRef + + /// Get the declared attributes for the value + member Attribs: Attrib list + + /// Indicates if this is a 'base' or 'this' value? + member BaseOrThisInfo: ValBaseOrThisInfo + + [] + member DebugText: string + + /// The parent type or module, if any (None for expression bindings type parameters) + member DeclaringEntity: ParentRef + + /// Range of the definition (implementation) of the value, used by Visual Studio + member DefinitionRange: range + + /// The full text for the value to show in error messages type to use in code. + /// This includes backticks, parens etc. + /// + /// - If this is a property --> Foo + /// - If this is an implementation of an abstract slot then this is the name of the method implemented by the abstract slot + /// - If this is an active pattern --> (|A|_|) + /// - If this is an operator --> (+) + /// - If this is an identifier needing backticks --> ``A-B`` + /// - If this is a base value --> base + /// - If this is a value named ``base`` --> ``base`` + member DisplayName: string + + /// The display name of the value or method with operator names decompiled but without backticks etc. + /// + /// Note: here "Core" means "without added backticks or parens" + member DisplayNameCore: string + + /// The display name of the value or method but without operator names decompiled type without backticks etc. + /// This is very close to LogicalName except that properties have get_ removed. + /// + /// Note: here "Core" means "without added backticks or parens" + /// Note: here "Mangled" means "op_Addition" + /// + /// - If this is a property --> Foo + /// - If this is an implementation of an abstract slot then this is the name of the method implemented by the abstract slot + /// - If this is an active pattern --> |A|_| + /// - If this is an operator --> op_Addition + /// - If this is an identifier needing backticks --> A-B + member DisplayNameCoreMangled: string + + /// Get the type of the value including any generic type parameters + member GeneralizedType: Typars * TType + + /// Indicates if this is ever referenced? + member HasBeenReferenced: bool + + member HasDeclaringEntity: bool + + member Id: Syntax.Ident + + /// Indicates if the value will ignore byref scoping rules + member IgnoresByrefScope: bool + + /// Gets the dispatch slots implemented by this method + member ImplementedSlotSigs: SlotSig list + + /// Get the inline declaration on a parameter or other non-function-declaration value, used for optimization + member InlineIfLambda: bool + + /// Get the inline declaration on the value + member InlineInfo: ValInline + + /// Indicates if this is a 'base' value? + member IsBaseVal: bool + + /// Indicates if this is a compiler-generated class constructor member + member IsClassConstructor: bool + + /// Indicates if the backing field for a static value is suppressed. + member IsCompiledAsStaticPropertyWithoutField: bool + + /// Is this represented as a "top level" static binding (i.e. a static field, static member, + /// instance member), rather than an "inner" binding that may result in a closure. + /// + /// This is implied by IsMemberOrModuleBinding, however not vice versa, for two reasons. + /// Some optimizations mutate this value when they decide to change the representation of a + /// binding to be IsCompiledAsTopLevel. Second, even immediately after type checking we expect + /// some non-module, non-member bindings to be marked IsCompiledAsTopLevel, e.g. 'y' in + /// 'let x = let y = 1 in y + y' (NOTE: check this, don't take it as gospel) + member IsCompiledAsTopLevel: bool + + /// Indicates if this is something compiled into a module, i.e. a user-defined value, an extension member or a compiler-generated value + member IsCompiledIntoModule: bool + + /// Indicates whether this value was generated by the compiler. + /// + /// Note: this is true for the overrides generated by hash/compare augmentations + member IsCompilerGenerated: bool + + /// Indicates if this is an F#-defined 'new' constructor member + member IsConstructor: bool + + /// Indicates if this is a 'this' value for an implicit ctor? + member IsCtorThisVal: bool + + /// Indicates if this member is an F#-defined dispatch slot. + member IsDispatchSlot: bool + + /// Indicates if this is an F#-defined extension member + member IsExtensionMember: bool + + /// Indicates if the value is pinned/fixed + member IsFixed: bool + + /// Indicates if this is a constructor member generated from the de-sugaring of implicit constructor for a class type? + member IsIncrClassConstructor: bool + + /// Indicates if this is a member generated from the de-sugaring of 'let' function bindings in the implicit class syntax? + member IsIncrClassGeneratedMember: bool + + /// Indicates if this is an F#-defined instance member. + /// + /// Note, the value may still be (a) an extension member or (b) type abstract slot without + /// a true body. These cases are often causes of bugs in the compiler. + member IsInstanceMember: bool + + /// Indicates if this is a member, excluding extension members + member IsIntrinsicMember: bool + + /// Indicates if a value is linked to backing data yet. Only used during unpickling of F# metadata. + member IsLinked: bool + + /// Indicates if this is a member + member IsMember: bool + + /// Is this a member definition or module definition? + member IsMemberOrModuleBinding: bool + + /// Indicates if this is a 'this' value for a member? + member IsMemberThisVal: bool + + /// Indicates if this is an F#-defined value in a module, or an extension member, but excluding compiler generated bindings from optimizations + member IsModuleBinding: bool + + /// Indicates if this is declared 'mutable' + member IsMutable: bool + + /// Indicates if this value was a member declared 'override' or an implementation of an interface slot + member IsOverrideOrExplicitImpl: bool + + member IsTypeFunction: bool + + /// The value of a value or member marked with [] + member LiteralValue: Const option + + /// The name of the method. + /// - If this is a property then this is 'get_Foo' or 'set_Foo' + /// - If this is an implementation of an abstract slot then this is the name of the method implemented by the abstract slot + /// - If this is an extension member then this will be the simple name + member LogicalName: string + + /// Indicates if this is inferred to be a method or function that definitely makes no critical tailcalls? + member MakesNoCriticalTailcalls: bool + + /// Get the apparent parent entity for a member + member MemberApparentEntity: TyconRef + + /// Is this a member, if so some more data about the member. + /// + /// Note, the value may still be (a) an extension member or (b) type abstract slot without + /// a true body. These cases are often causes of bugs in the compiler. + member MemberInfo: ValMemberInfo option + + /// Indicates whether the inline declaration for the value indicate that the value must be inlined? + member MustInline: bool + + /// Get the number of 'this'/'self' object arguments for the member. Instance extension members return '1'. + member NumObjArgs: int + + /// Indicates if this value allows the use of an explicit type instantiation (i.e. does it itself have explicit type arguments, + /// or does it have a signature?) + member PermitsExplicitTypeInstantiation: bool + + /// The name of the property. + /// - If this is a property then this is 'Foo' + member PropertyName: string + + /// Get the public path to the value, if any? Should be set if type only if + /// IsMemberOrModuleBinding is set. + member PublicPath: ValPublicPath option + + /// The place where the value was defined. + member Range: range + + /// Get the information about the value used during type inference + member RecursiveValInfo: ValRecursiveScopeInfo + + /// The quotation expression associated with a value given the [] tag + member ReflectedDefinition: Expr option + + /// Range of the definition (signature) of the value, used by Visual Studio + member SigRange: range + + /// A unique stamp within the context of this invocation of the compiler process + member Stamp: Stamp + + /// Get the type of the value after removing any generic type parameters + member TauType: TType + + /// Get the actual parent entity for the value (a module or a type), i.e. the entity under which the + /// value will appear in compiled code. For extension members this is the module where the extension member + /// is declared. + member TopValDeclaringEntity: EntityRef + + /// Get the generic type parameters for the value + member Typars: Typars + + /// The type of the value. + /// May be a TType_forall for a generic value. + /// May be a type variable or type containing type variables during type inference. + member Type: TType + + member ValCompiledName: string option + + /// Records the "extra information" for a value compiled as a method. + /// + /// This indicates the number of arguments in each position for a curried + /// functions, type relates to the F# spec for arity analysis. + /// For module-defined values, the currying is based + /// on the number of lambdas, type in each position the elements are + /// based on attempting to deconstruct the type of the argument as a + /// tuple-type. + /// + /// The field is mutable because arities for recursive + /// values are only inferred after the r.h.s. is analyzed, but the + /// value itself is created before the r.h.s. is analyzed. + /// + /// TLR also sets this for inner bindings that it wants to + /// represent as "top level" bindings. + member ValReprInfo: ValReprInfo option + + /// Get the declared documentation for the value + member XmlDoc: XmlDoc + + ///Get the signature for the value's XML documentation + member XmlDocSig: string with get, set + +/// Represents the extra information stored for a member +[] +type ValMemberInfo = + { + + /// The parent type. For an extension member this is the type being extended + ApparentEnclosingEntity: TyconRef + + /// Updated with the full implemented slotsig after interface implementation relation is checked + mutable ImplementedSlotSigs: SlotSig list + + /// Gets updated with 'true' if an abstract slot is implemented in the file being typechecked. Internal only. + mutable IsImplemented: bool + MemberFlags: Syntax.SynMemberFlags + } + + override ToString: unit -> string + + [] + member DebugText: string + +[] +type NonLocalValOrMemberRef = + { + + /// A reference to the entity containing the value or member. This will always be a non-local reference + EnclosingEntity: EntityRef + + /// The name of the value, or the full signature of the member + ItemKey: ValLinkageFullKey + } + + /// For debugging + override ToString: unit -> string + + /// Get the name of the assembly referred to + member AssemblyName: string + + /// Get the thunk for the assembly referred to + member Ccu: CcuThunk + + /// For debugging + [] + member DebugText: string + +/// Represents the path information for a reference to a value or member in another assembly, disassociated +/// from any particular reference. +[] +type ValPublicPath = + | ValPubPath of PublicPath * ValLinkageFullKey + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents an index into the namespace/module structure of an assembly +[] +type NonLocalEntityRef = + | NonLocalEntityRef of CcuThunk * string[] + + /// Try to find the entity corresponding to the given path in the given CCU + static member TryDerefEntityPath: ccu: CcuThunk * path: string[] * i: int * entity: Entity -> Entity voption + + /// Try to find the entity corresponding to the given path, using type-providers to link the data + static member TryDerefEntityPathViaProvidedType: + ccu: CcuThunk * path: string[] * i: int * entity: Entity -> Entity voption + + override ToString: unit -> string + + /// Try to link a non-local entity reference to an actual entity + member TryDeref: canError: bool -> Entity voption + + /// Get the name of the assembly referenced by the nonlocal reference. + member AssemblyName: string + + /// Get the CCU referenced by the nonlocal reference. + member Ccu: CcuThunk + + [] + member DebugText: string + + /// Dereference the nonlocal reference, type raise an error if this fails. + member Deref: Entity + + member DisplayName: string + + /// Get the all-but-last names of the path of the nonlocal reference. + member EnclosingMangledPath: string[] + + /// Get the mangled name of the last item in the path of the nonlocal reference. + member LastItemMangledName: string + + /// Get the details of the module or namespace fragment for the entity referred to by this non-local reference. + member ModuleOrNamespaceType: ModuleOrNamespaceType + + /// Get the path into the CCU referenced by the nonlocal reference. + member Path: string[] + +[] +type EntityRef = + { + + /// Indicates a reference to something bound in this CCU + mutable binding: NonNullSlot + + /// Indicates a reference to something bound in another CCU + nlr: NonLocalEntityRef + } + + /// Get a field by index in definition order + member GetFieldByIndex: n: int -> RecdField + + /// Get a field by name. + member GetFieldByName: n: string -> RecdField option + + /// Get a union case of a type by name + member GetUnionCaseByName: n: string -> UnionCase option + + member MakeNestedRecdFieldRef: rf: RecdField -> RecdFieldRef + + member MakeNestedUnionCaseRef: uc: UnionCase -> UnionCaseRef + + /// Resolve the reference + member private Resolve: canError: bool -> unit + + /// Set the on-demand analysis about whether the entity is assumed to be a readonly struct + member SetIsAssumedReadOnly: b: bool -> unit + + /// Set the on-demand analysis about whether the entity has the IsByRefLike attribute + member SetIsByRefLike: b: bool -> unit + + /// Set the on-demand analysis about whether the entity has the IsReadOnly attribute + member SetIsReadOnly: b: bool -> unit + + override ToString: unit -> string + + /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. + /// + /// Lazy because it may read metadata, must provide a context "range" in case error occurs reading metadata. + member Typars: m: range -> Typars + + /// Get the value representing the accessibility of an F# type definition or module. + member Accessibility: Accessibility + + member AllFieldAsRefList: RecdFieldRef list + + /// Get a table of fields for all the F#-defined record, struct type class fields in this type definition, including + /// static fields, 'val' declarations type hidden fields from the compilation of implicit class constructions. + member AllFieldTable: TyconRecdFields + + /// Get an array of fields for all the F#-defined record, struct type class fields in this type definition, including + /// static fields, 'val' declarations type hidden fields from the compilation of implicit class constructions. + member AllFieldsArray: RecdField[] + + /// Get a list of fields for all the F#-defined record, struct type class fields in this type definition, including + /// static fields, 'val' declarations type hidden fields from the compilation of implicit class constructions. + member AllFieldsAsList: RecdField list + + /// Get a list of all instance fields for F#-defined record, struct type class fields in this type definition. + /// including hidden fields from the compilation of implicit class constructions. + member AllInstanceFieldsAsList: RecdField list + + /// The F#-defined custom attributes of the entity, if any. If the entity is backed by Abstract IL or provided metadata + /// then this does not include any attributes from those sources. + member Attribs: Attribs + + /// Is the destination assembly available? + member CanDeref: bool + + /// Get a blob of data indicating how this type is nested inside other namespaces, modules type types. + member CompilationPath: CompilationPath + + /// Get a blob of data indicating how this type is nested inside other namespaces, modules type types. + member CompilationPathOpt: CompilationPath option + + /// The compiled name of the namespace, module or type, e.g. FSharpList`1, ListModule or FailureException + member CompiledName: string + + /// Get the cache of the compiled ILTypeRef representation of this module or type. + member CompiledReprCache: cache + + /// Gets the data indicating the compiled representation of a type or module in terms of Abstract IL data structures. + member CompiledRepresentation: CompiledTypeRepr + + /// Gets the data indicating the compiled representation of a named type or module in terms of Abstract IL data structures. + member CompiledRepresentationForNamedType: ILTypeRef + + [] + member DebugText: string + + /// The implementation definition location of the namespace, module or type + member DefinitionRange: range + + /// Demangle the module name, if FSharpModuleWithSuffix is used + member DemangledModuleOrNamespaceName: string + + /// Dereference the TyconRef to a Tycon. Amortize the cost of doing this. + /// This path should not allocate in the amortized case + member Deref: Entity + + /// The display name of the namespace, module or type, e.g. List instead of List`1, not including static parameters + /// + /// Backticks are added implicitly for entities with non-identifier names + member DisplayName: string + + /// The display name of the namespace, module or type, e.g. List instead of List`1, not including static parameters + /// + /// No backticks are added for entities with non-identifier names + member DisplayNameCore: string + + /// The display name of the namespace, module or type, e.g. List instead of List`1, including static parameters + /// + /// Backticks are added implicitly for entities with non-identifier names + member DisplayNameWithStaticParameters: string + + /// The display name of the namespace, module or type with <_, _, _> added for generic types, including static parameters + /// + /// Backticks are added implicitly for entities with non-identifier names + member DisplayNameWithStaticParametersAndUnderscoreTypars: string + + /// The information about the r.h.s. of an F# exception definition, if any. + member ExceptionInfo: ExceptionInfo + + /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. + member FSharpObjectModelTypeInfo: TyconObjModelData + + /// Gets any implicit CompareTo methods added to an F# record, union or struct type definition. + member GeneratedCompareToValues: (ValRef * ValRef) option + + /// Gets any implicit CompareTo (with comparer argument) methods added to an F# record, union or struct type definition. + member GeneratedCompareToWithComparerValues: ValRef option + + /// Gets any implicit hash/equals methods added to an F# record, union or struct type definition. + member GeneratedHashAndEqualsValues: (ValRef * ValRef) option + + /// Gets any implicit hash/equals (with comparer argument) methods added to an F# record, union or struct type definition. + member GeneratedHashAndEqualsWithComparerValues: (ValRef * ValRef * ValRef) option + + /// Indicates if we have pre-determined that a type definition has a self-referential constructor using 'as x' + member HasSelfReferentialConstructor: bool + + /// Get the Abstract IL scope, nesting type metadata for this + /// type definition, assuming it is backed by Abstract IL metadata. + member ILTyconInfo: TILObjectReprData + + /// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata. + member ILTyconRawMetadata: ILTypeDef + + /// The identifier at the point of declaration of the type definition. + member Id: Syntax.Ident + + /// Gets the immediate interface types of an F# type definition. Further interfaces may be supported through class type interface inheritance. + member ImmediateInterfaceTypesOfFSharpTycon: TType list + + /// Gets the immediate interface definitions of an F# type definition. Further interfaces may be supported through class type interface inheritance. + member ImmediateInterfacesOfFSharpTycon: (TType * bool * range) list + + /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll which uses + /// an assembly-code representation for the type, e.g. the primitive array type constructor. + member IsAsmReprTycon: bool + + /// Indicates if this is an enum type definition + member IsEnumTycon: bool + + /// Indicates if the entity is erased, either a measure definition, or an erased provided type definition + member IsErased: bool + + /// Indicates if this is an F#-defined delegate type definition + member IsFSharpDelegateTycon: bool + + /// Indicates if this is an F#-defined enum type definition + member IsFSharpEnumTycon: bool + + /// Indicates if the entity represents an F# exception declaration. + member IsFSharpException: bool + + /// Indicates if this is an F#-defined interface type definition + member IsFSharpInterfaceTycon: bool + + /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition + member IsFSharpObjectModelTycon: bool + + /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition + member IsFSharpStructOrEnumTycon: bool + + /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature, + /// which in F# is called a 'unknown representation' type). + member IsHiddenReprTycon: bool + + /// Indicates if this is a .NET-defined enum type definition + member IsILEnumTycon: bool + + /// Indicates if this is a .NET-defined struct or enum type definition, i.e. a value type definition + member IsILStructOrEnumTycon: bool + + /// Indicate if this is a type definition backed by Abstract IL metadata. + member IsILTycon: bool + + /// Indicates if the reference is a local reference + member IsLocalRef: bool + + /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll like 'float<_>' which + /// defines a measure type with a relation to an existing non-measure type as a representation. + member IsMeasureableReprTycon: bool + + /// Indicates if the entity is an F# module definition + member IsModule: bool + + /// Indicates the "tycon blob" is actually a module + member IsModuleOrNamespace: bool + + /// Indicates if the entity is a namespace + member IsNamespace: bool + + /// Indicates the type prefers the "tycon" syntax for display etc. + member IsPrefixDisplay: bool + + /// Indicates if the entity is a provided namespace fragment + member IsProvided: bool + + /// Indicates if the entity is an erased provided type definition + member IsProvidedErasedTycon: bool + + /// Indicates if the entity is a generated provided type definition, i.e. not erased. + member IsProvidedGeneratedTycon: bool + + /// Indicates if the entity is a provided namespace fragment + member IsProvidedNamespace: bool + + /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition. + member IsRecordTycon: bool + + /// Indicates if the reference has been resolved + member IsResolved: bool + + /// Indicates if the entity is an erased provided type definition that incorporates a static instantiation (type therefore in some sense compiler generated) + member IsStaticInstantiationTycon: bool + + /// Indicates if this is a struct or enum type definition, i.e. a value type definition + member IsStructOrEnumTycon: bool + + /// Indicates if this entity is an F# type abbreviation definition + member IsTypeAbbrev: bool + + /// Indicate if this is a type whose r.h.s. is known to be a union type definition. + member IsUnionTycon: bool + + /// The name of the namespace, module or type, possibly with mangling, e.g. List`1, List or FailureException + member LogicalName: string + + /// Gets all immediate members of an F# type definition keyed by name, including compiler-generated ones. + /// Note: result is a indexed table, type for each name the results are in reverse declaration order + member MembersOfFSharpTyconByName: NameMultiMap + + /// Gets the immediate members of an F# type definition, excluding compiler-generated ones. + /// Note: result is alphabetically sorted, then for each name the results are in declaration order + member MembersOfFSharpTyconSorted: ValRef list + + /// The logical contents of the entity when it is a module or namespace fragment. + member ModuleOrNamespaceType: ModuleOrNamespaceType + + /// Indicates if we have pre-determined that a type definition has a default constructor. + member PreEstablishedHasDefaultConstructor: bool + + /// Get a blob of data indicating how this type is nested in other namespaces, modules or types. + member PublicPath: PublicPath option + + /// The code location where the module, namespace or type is defined. + member Range: range + + /// The resolved target of the reference + member ResolvedTarget: NonNullSlot + + /// The signature definition location of the namespace, module or type + member SigRange: range + + /// A unique stamp for this module, namespace or type definition within the context of this compilation. + /// Note that because of signatures, there are situations where in a single compilation the "same" + /// module, namespace or type may have two distinct Entity objects that have distinct stamps. + member Stamp: Stamp + + /// Get a list of all fields for F#-defined record, struct type class fields in this type definition, + /// including static fields, but excluding compiler-generate fields. + member TrueFieldsAsList: RecdField list + + /// Get a list of all instance fields for F#-defined record, struct type class fields in this type definition, + /// excluding compiler-generate fields. + member TrueInstanceFieldsAsList: RecdField list + + member TrueInstanceFieldsAsRefList: RecdFieldRef list + + /// Dereference the TyconRef to a Tycon option. + member TryDeref: NonNullSlot voption + + /// The on-demand analysis about whether the entity is assumed to be a readonly struct + member TryIsAssumedReadOnly: bool voption + + /// The on-demand analysis about whether the entity has the IsByRefLike attribute + member TryIsByRefLike: bool voption + + /// The on-demand analysis about whether the entity has the IsReadOnly attribute + member TryIsReadOnly: bool voption + + /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. + member TyparsNoRange: Typars + + /// Indicates if this entity is an F# type abbreviation definition + member TypeAbbrev: TType option + + /// The logical contents of the entity when it is a type definition. + member TypeContents: TyconAugmentation + + /// The kind of the type definition - is it a measure definition or a type definition? + member TypeOrMeasureKind: TyparKind + + /// Get the value representing the accessibility of the r.h.s. of an F# type definition. + member TypeReprAccessibility: Accessibility + + /// The information about the r.h.s. of a type definition, if any. For example, the r.h.s. of a union or record type. + member TypeReprInfo: TyconRepresentation + + /// Get the union cases for a type, if any + member UnionCasesArray: UnionCase[] + + /// Get the union cases for a type, if any, as a list + member UnionCasesAsList: UnionCase list + + member UnionCasesAsRefList: UnionCaseRef list + + /// Get the union cases type other union-type information for a type, if any + member UnionTypeInfo: TyconUnionData voption + + /// The XML documentation of the entity, if any. If the entity is backed by provided metadata + /// then this _does_ include this documentation. If the entity is backed by Abstract IL metadata + /// or comes from another F# assembly then it does not (because the documentation will get read from + /// an XML file). + member XmlDoc: XmlDoc + + /// The XML documentation sig-string of the entity, if any, to use to lookup an .xml doc file. This also acts + /// as a cache for this sig-string computation. + member XmlDocSig: string + +/// Represents a module-or-namespace reference in the typed abstract syntax. +type ModuleOrNamespaceRef = EntityRef + +/// Represents a type definition reference in the typed abstract syntax. +type TyconRef = EntityRef + +/// References are either local or nonlocal +[] +type ValRef = + { + + /// Indicates a reference to something bound in this CCU + mutable binding: NonNullSlot + + /// Indicates a reference to something bound in another CCU + nlr: NonLocalValOrMemberRef + } + + override ToString: unit -> string + + /// Get the value representing the accessibility of an F# type definition or module. + member Accessibility: Accessibility + + /// Get the apparent parent entity for the value, i.e. the entity under with which the + /// value is associated. For extension members this is the nominal type the member extends. + /// For other values it is just the actual parent. + member ApparentEnclosingEntity: ParentRef + + /// Get the declared attributes for the value + member Attribs: Attrib list + + /// Indicates if this is a 'base' or 'this' value? + member BaseOrThisInfo: ValBaseOrThisInfo + + /// The name of the method in compiled code (with some exceptions where ilxgen.fs decides not to use a method impl) + member CompiledName: (CompilerGlobalState.CompilerGlobalState option -> string) + + [] + member DebugText: string + + /// The parent type or module, if any (None for expression bindings type parameters) + member DeclaringEntity: ParentRef + + member DefinitionRange: range + + /// Dereference the ValRef to a Val. + member Deref: Val + + member DisplayName: string + + member DisplayNameCore: string + + member DisplayNameCoreMangled: string + + /// Get the type of the value including any generic type parameters + member GeneralizedType: Typars * TType + + member HasDeclaringEntity: bool + + member Id: Syntax.Ident + + /// Gets the dispatch slots implemented by this method + member ImplementedSlotSigs: SlotSig list + + /// Get the inline declaration on a parameter or other non-function-declaration value, used for optimization + member InlineIfLambda: bool + + /// Get the inline declaration on the value + member InlineInfo: ValInline + + /// Indicates if this is a 'base' value? + member IsBaseVal: bool + + /// Is this represented as a "top level" static binding (i.e. a static field, static member, + /// instance member), rather than an "inner" binding that may result in a closure. + member IsCompiledAsTopLevel: bool + + /// Indicates whether this value was generated by the compiler. + /// + /// Note: this is true for the overrides generated by hash/compare augmentations + member IsCompilerGenerated: bool + + /// Indicates if this is an F#-defined 'new' constructor member + member IsConstructor: bool + + /// Indicates if this is a 'this' value for an implicit ctor? + member IsCtorThisVal: bool + + /// Indicates if this member is an F#-defined dispatch slot. + member IsDispatchSlot: bool + + /// Indicates if this is an F#-defined extension member + member IsExtensionMember: bool + + /// Indicates if this is a constructor member generated from the de-sugaring of implicit constructor for a class type? + member IsIncrClassConstructor: bool + + /// Indicates if this is a member generated from the de-sugaring of 'let' function bindings in the implicit class syntax? + member IsIncrClassGeneratedMember: bool + + /// Indicates if this is an F#-defined instance member. + /// + /// Note, the value may still be (a) an extension member or (b) type abstract slot without + /// a true body. These cases are often causes of bugs in the compiler. + member IsInstanceMember: bool + + member IsLocalRef: bool + + /// Indicates if this is a member + member IsMember: bool + + /// Is this a member definition or module definition? + member IsMemberOrModuleBinding: bool + + /// Indicates if this is a 'this' value for a member? + member IsMemberThisVal: bool + + /// Indicates if this is an F#-defined value in a module, or an extension member, but excluding compiler generated bindings from optimizations + member IsModuleBinding: bool + + /// Indicates if this value is declared 'mutable' + member IsMutable: bool + + /// Indicates if this value was a member declared 'override' or an implementation of an interface slot + member IsOverrideOrExplicitImpl: bool + + /// Indicates whether this value represents a property getter. + member IsPropertyGetterMethod: bool + + /// Indicates whether this value represents a property setter. + member IsPropertySetterMethod: bool + + member IsResolved: bool + + /// Indicates if this value was declared to be a type function, e.g. "let f<'a> = typeof<'a>" + member IsTypeFunction: bool + + /// The value of a value or member marked with [] + member LiteralValue: Const option + + member LogicalName: string + + /// Indicates if this is inferred to be a method or function that definitely makes no critical tailcalls? + member MakesNoCriticalTailcalls: bool + + /// Get the apparent parent entity for a member + member MemberApparentEntity: TyconRef + + /// Is this a member, if so some more data about the member. + member MemberInfo: ValMemberInfo option + + /// Indicates whether the inline declaration for the value indicate that the value must be inlined? + member MustInline: bool + + /// Get the number of 'this'/'self' object arguments for the member. Instance extension members return '1'. + member NumObjArgs: int + + /// Indicates if this value allows the use of an explicit type instantiation (i.e. does it itself have explicit type arguments, + /// or does it have a signature?) + member PermitsExplicitTypeInstantiation: bool + + /// Get the name of the value, assuming it is compiled as a property. + /// - If this is a property then this is 'Foo' + /// - If this is an implementation of an abstract slot then this is the name of the property implemented by the abstract slot + member PropertyName: string + + /// Get the public path to the value, if any? Should be set if type only if + /// IsMemberOrModuleBinding is set. + member PublicPath: ValPublicPath option + + member Range: range + + /// Get the information about a recursive value used during type inference + member RecursiveValInfo: ValRecursiveScopeInfo + + /// The quotation expression associated with a value given the [] tag + member ReflectedDefinition: Expr option + + member ResolvedTarget: NonNullSlot + + member SigRange: range + + /// A unique stamp within the context of this invocation of the compiler process + member Stamp: Stamp + + /// Get the type of the value after removing any generic type parameters + member TauType: TType + + /// Get the actual parent entity for the value (a module or a type), i.e. the entity under which the + /// value will appear in compiled code. For extension members this is the module where the extension member + /// is declared. + member TopValDeclaringEntity: EntityRef + + /// Dereference the ValRef to a Val option. + member TryDeref: Val voption + + member Typars: Typars + + /// The type of the value. May be a TType_forall for a generic value. + /// May be a type variable or type containing type variables during type inference. + member Type: TType + + /// Records the "extra information" for a value compiled as a method. + /// + /// This indicates the number of arguments in each position for a curried function. + member ValReprInfo: ValReprInfo option + + /// Get the declared documentation for the value + member XmlDoc: XmlDoc + + /// Get or set the signature for the value's XML documentation + member XmlDocSig: string + +/// Represents a reference to a case of a union type +[] +type UnionCaseRef = + | UnionCaseRef of TyconRef * string + + /// Get a field of the union case by index + member FieldByIndex: n: int -> RecdField + + override ToString: unit -> string + + /// Get the fields of the union case + member AllFieldsAsList: RecdField list + + /// Get the attributes associated with the union case + member Attribs: Attribs + + /// Get the name of this union case + member CaseName: string + + [] + member DebugText: string + + /// Get the definition range of the union case + member DefinitionRange: range + + /// Get the index of the union case amongst the cases + member Index: int + + /// Get the range of the union case + member Range: range + + /// Get the resulting type of the union case + member ReturnType: TType + + /// Get the signature range of the union case + member SigRange: range + + /// Try to dereference the reference + member TryUnionCase: UnionCase voption + + /// Get the Entity for the type containing this union case + member Tycon: Entity + + /// Get a reference to the type containing this union case + member TyconRef: TyconRef + + /// Dereference the reference to the union case + member UnionCase: UnionCase + +/// Represents a reference to a field in a record, class or struct +[] +type RecdFieldRef = + | RecdFieldRef of tcref: TyconRef * id: string + + override ToString: unit -> string + + [] + member DebugText: string + + /// Get the definition range of the record field + member DefinitionRange: range + + /// Get the name of the field, with backticks added for non-identifier names + member DisplayName: string + + /// Get the name of the field + member FieldName: string + + member Index: int + + /// Get the attributes associated with the compiled property of the record field + member PropertyAttribs: Attribs + + /// Get the declaration range of the record field + member Range: range + + /// Dereference the reference + member RecdField: RecdField + + /// Get the signature range of the record field + member SigRange: range + + /// Try to dereference the reference + member TryRecdField: RecdField voption + + /// Get the Entity for the type containing this union case + member Tycon: Entity + + /// Get a reference to the type containing this union case + member TyconRef: TyconRef + +/// Represents a type in the typed abstract syntax +[] +type TType = + + /// Indicates the type is a universal type, only used for types of values type members + | TType_forall of typars: Typars * bodyTy: TType + + /// Indicates the type is built from a named type type a number of type arguments. + /// + /// 'flags' is a placeholder for future features, in particular nullness analysis + | TType_app of tyconRef: TyconRef * typeInstantiation: TypeInst * flags: byte + + /// Indicates the type is an anonymous record type whose compiled representation is located in the given assembly + | TType_anon of anonInfo: AnonRecdTypeInfo * tys: TType list + + /// Indicates the type is a tuple type. elementTypes must be of length 2 or greater. + | TType_tuple of tupInfo: TupInfo * elementTypes: TTypes + + /// Indicates the type is a function type. + /// + /// 'flags' is a placeholder for future features, in particular nullness analysis. + | TType_fun of domainType: TType * rangeType: TType * flags: byte + + /// Indicates the type is a non-F#-visible type representing a "proof" that a union value belongs to a particular union case + /// These types are not user-visible type will never appear as an inferred type. They are the types given to + /// the temporaries arising out of pattern matching on union values. + | TType_ucase of unionCaseRef: UnionCaseRef * typeInstantiation: TypeInst + + /// Indicates the type is a variable type, whether declared, generalized or an inference type parameter + /// + /// 'flags' is a placeholder for future features, in particular nullness analysis + | TType_var of typar: Typar * flags: byte + + /// Indicates the type is a unit-of-measure expression being used as an argument to a type or member + | TType_measure of measure: Measure + + /// For now, used only as a discriminant in error message. + /// See https://github.com/dotnet/fsharp/issues/2561 + member GetAssemblyName: unit -> string + + override ToString: unit -> string + + [] + member DebugText: string + +type TypeInst = TType list + +type TTypes = TType list + +/// Represents the information identifying an anonymous record +[] +type AnonRecdTypeInfo = + { mutable Assembly: CcuThunk + mutable TupInfo: TupInfo + mutable SortedIds: Syntax.Ident[] + mutable Stamp: Stamp + mutable SortedNames: string[] } + + /// Create an AnonRecdTypeInfo from the basic data + static member Create: ccu: CcuThunk * tupInfo: TupInfo * ids: Syntax.Ident[] -> AnonRecdTypeInfo + + static member NewUnlinked: unit -> AnonRecdTypeInfo + + member Link: d: AnonRecdTypeInfo -> unit + + /// Get the ILTypeRef for the generated type implied by the anonymous type + member ILTypeRef: ILTypeRef + + member IsLinked: bool + +[] +type TupInfo = + + /// Some constant, e.g. true or false for tupInfo + | Const of bool + +/// Represents a unit of measure in the typed AST +[] +type Measure = + + /// A variable unit-of-measure + | Var of typar: Typar + + /// A constant, leaf unit-of-measure such as 'kg' or 'm' + | Con of tyconRef: TyconRef + + /// A product of two units of measure + | Prod of measure1: Measure * measure2: Measure + + /// An inverse of a units of measure expression + | Inv of measure: Measure + + /// The unit of measure '1', e.g. float = float<1> + | One + + /// Raising a measure to a rational power + | RationalPower of measure: Measure * power: Rational + + override ToString: unit -> string + +type Attribs = Attrib list + +[] +type AttribKind = + + /// Indicates an attribute refers to a type defined in an imported .NET assembly + | ILAttrib of ilMethodRef: ILMethodRef + + /// Indicates an attribute refers to a type defined in an imported F# assembly + | FSAttrib of valRef: ValRef + + override ToString: unit -> string + +/// Attrib(tyconRef, kind, unnamedArgs, propVal, appliedToAGetterOrSetter, targetsOpt, range) +[] +type Attrib = + | Attrib of + tyconRef: TyconRef * + kind: AttribKind * + unnamedArgs: AttribExpr list * + propVal: AttribNamedArg list * + appliedToAGetterOrSetter: bool * + targetsOpt: AttributeTargets option * + range: range + + override ToString: unit -> string + + [] + member DebugText: string + + member Range: range + + member TyconRef: TyconRef + +/// We keep both source expression type evaluated expression around to help intellisense type signature printing +[] +type AttribExpr = + + /// AttribExpr(source, evaluated) + | AttribExpr of source: Expr * evaluated: Expr + + override ToString: unit -> string + + [] + member DebugText: string + +/// AttribNamedArg(name, type, isField, value) +[] +type AttribNamedArg = + | AttribNamedArg of (string * TType * bool * AttribExpr) + + override ToString: unit -> string + + [] + member DebugText: string + +/// Constants in expressions +[] +type Const = + | Bool of bool + | SByte of sbyte + | Byte of byte + | Int16 of int16 + | UInt16 of uint16 + | Int32 of int32 + | UInt32 of uint32 + | Int64 of int64 + | UInt64 of uint64 + | IntPtr of int64 + | UIntPtr of uint64 + | Single of single + | Double of double + | Char of char + | String of string + | Decimal of Decimal + | Unit + | Zero + + override ToString: unit -> string + + [] + member DebugText: string + +/// Decision trees. Pattern matching has been compiled down to +/// a decision tree by this point. The right-hand-sides (actions) of +/// a decision tree by this point. The right-hand-sides (actions) of +/// the decision tree are labelled by integers that are unique for that +/// particular tree. +[] +type DecisionTree = + + /// TDSwitch(input, cases, default, range) + /// + /// Indicates a decision point in a decision tree. + /// input -- The expression being tested. If switching over a struct union this + /// must be the address of the expression being tested. + /// cases -- The list of tests type their subsequent decision trees + /// default -- The default decision tree, if any + /// range -- (precise documentation needed) + | TDSwitch of input: Expr * cases: DecisionTreeCase list * defaultOpt: DecisionTree option * range: range + + /// TDSuccess(results, targets) + /// + /// Indicates the decision tree has terminated with success, transferring control to the given target with the given parameters. + /// results -- the expressions to be bound to the variables at the target + /// target -- the target number for the continuation + | TDSuccess of results: Exprs * targetNum: int + + /// TDBind(binding, body) + /// + /// Bind the given value through the remaining cases of the dtree. + /// These arise from active patterns type some optimizations to prevent + /// repeated computations in decision trees. + /// binding -- the value type the expression it is bound to + /// body -- the rest of the decision tree + | TDBind of binding: Binding * body: DecisionTree + + override ToString: unit -> string + +/// Represents a test type a subsequent decision tree +[] +type DecisionTreeCase = + | TCase of discriminator: DecisionTreeTest * caseTree: DecisionTree + + override ToString: unit -> string + + /// Get the decision tree or a successful test + member CaseTree: DecisionTree + + [] + member DebugText: string + + /// Get the discriminator associated with the case + member Discriminator: DecisionTreeTest + +[] +type DecisionTreeTest = + + /// Test if the input to a decision tree matches the given union case + | UnionCase of caseRef: UnionCaseRef * tinst: TypeInst + + /// Test if the input to a decision tree is an array of the given length + | ArrayLength of length: int * ty: TType + + /// Test if the input to a decision tree is the given constant value + | Const of value: Const + + /// Test if the input to a decision tree is null + | IsNull + + /// IsInst(source, target) + /// + /// Test if the input to a decision tree is an instance of the given type + | IsInst of source: TType * target: TType + + /// Test.ActivePatternCase(activePatExpr, activePatResTys, isStructRetTy, activePatIdentity, idx, activePatInfo) + /// + /// Run the active pattern type bind a successful result to a + /// variable in the remaining tree. + /// activePatExpr -- The active pattern function being called, perhaps applied to some active pattern parameters. + /// activePatResTys -- The result types (case types) of the active pattern. + /// isStructRetTy -- Is the active pattern a struct return + /// activePatIdentity -- The value type the types it is applied to. If there are any active pattern parameters then this is empty. + /// idx -- The case number of the active pattern which the test relates to. + /// activePatternInfo -- The extracted info for the active pattern. + | ActivePatternCase of + activePatExpr: Expr * + activePatResTys: TTypes * + isStructRetTy: bool * + activePatIdentity: (ValRef * TypeInst) option * + idx: int * + activePatternInfo: Syntax.PrettyNaming.ActivePatternInfo + + /// Used in error recovery + | Error of range: range + + override ToString: unit -> string + +/// A target of a decision tree. Can be thought of as a little function, though is compiled as a local block. +/// -- boundVals - The values bound at the target, matching the valuesin the TDSuccess +/// -- targetExpr - The expression to evaluate if we branch to the target +/// -- debugPoint - The debug point for the target +/// -- isStateVarFlags - Indicates which, if any, of the values are repesents as state machine variables +[] +type DecisionTreeTarget = + | TTarget of boundVals: Val list * targetExpr: Expr * isStateVarFlags: bool list option + + override ToString: unit -> string + + [] + member DebugText: string + + member TargetExpression: Expr + +/// A collection of simultaneous bindings +type Bindings = Binding list + +/// A binding of a variable to an expression, as in a `let` binding or similar +/// -- val: The value being bound +/// -- expr: The expression to execute to get the value +/// -- debugPoint: The debug point for the binding +[] +type Binding = + | TBind of var: Val * expr: Expr * debugPoint: Syntax.DebugPointAtBinding + + override ToString: unit -> string + + /// The information about whether to emit a sequence point for the binding + member DebugPoint: Syntax.DebugPointAtBinding + + [] + member DebugText: string + + /// The expression the value is being bound to + member Expr: Expr + + /// The value being bound + member Var: Val + +/// Represents a reference to an active pattern element. The +/// integer indicates which choice in the target set is being selected by this item. +[] +type ActivePatternElemRef = + | APElemRef of + activePatternInfo: Syntax.PrettyNaming.ActivePatternInfo * + activePatternVal: ValRef * + caseIndex: int * + isStructRetTy: bool + + override ToString: unit -> string + + /// Get the full information about the active pattern being referred to + member ActivePatternInfo: Syntax.PrettyNaming.ActivePatternInfo + + /// Get a reference to the value for the active pattern being referred to + member ActivePatternVal: ValRef + + /// Get the index of the active pattern element within the overall active pattern + member CaseIndex: int + + [] + member DebugText: string + + /// Get a reference to the value for the active pattern being referred to + member IsStructReturn: bool + +/// Records the "extra information" for a value compiled as a method (rather +/// than a closure or a local), including argument names, attributes etc. +[] +type ValReprInfo = + + /// ValReprInfo (typars, args, result) + | ValReprInfo of typars: TyparReprInfo list * args: ArgReprInfo list list * result: ArgReprInfo + + override ToString: unit -> string + + /// Get the extra information about the arguments for the value + member ArgInfos: ArgReprInfo list list + + member ArgNames: string list + + /// Get the number of tupled arguments in each curried argument position + member AritiesOfArgs: int list + + [] + member DebugText: string + + /// Indicates if the value has no arguments - neither type parameters nor value arguments + member HasNoArgs: bool + + /// Get the kind of each type parameter + member KindsOfTypars: TyparKind list + + /// Get the number of curried arguments of the value + member NumCurriedArgs: int + + /// Get the number of type parameters of the value + member NumTypars: int + + /// Get the total number of arguments + member TotalArgCount: int + +/// Records the "extra information" for an argument compiled as a real +/// method argument, specifically the argument name type attributes. +[] +type ArgReprInfo = + { + + /// The attributes for the argument + mutable Attribs: Attribs + + /// The name for the argument at this position, if any + mutable Name: Syntax.Ident option + } + + override ToString: unit -> string + + [] + member DebugText: string + +/// Records the extra metadata stored about typars for type parameters +/// compiled as "real" IL type parameters, specifically for values with +/// ValReprInfo. Any information here is propagated from signature through +/// to the compiled code. +type TyparReprInfo = TyparReprInfo of Syntax.Ident * TyparKind + +type Typars = Typar list + +type Exprs = Expr list + +type Vals = Val list + +/// Represents an expression in the typed abstract syntax +[] +type Expr = + + /// A constant expression. + | Const of value: Const * range: range * constType: TType + + /// Reference a value. The flag is only relevant if the value is an object model member + /// type indicates base calls type special uses of object constructors. + | Val of valRef: ValRef * flags: ValUseFlag * range: range + + /// Sequence expressions, used for "a;b", "let a = e in b;a" type "a then b" (the last an OO constructor). + | Sequential of expr1: Expr * expr2: Expr * kind: SequentialOpKind * range: range + + /// Lambda expressions. + /// Why multiple vspecs? A Expr.Lambda taking multiple arguments really accepts a tuple. + /// But it is in a convenient form to be compile accepting multiple + /// arguments, e.g. if compiled as a toplevel static method. + | Lambda of + unique: CompilerGlobalState.Unique * + ctorThisValOpt: Val option * + baseValOpt: Val option * + valParams: Val list * + bodyExpr: Expr * + range: Text.range * + overallType: TType + + /// Type lambdas. These are used for the r.h.s. of polymorphic 'let' bindings type + /// for expressions that implement first-class polymorphic values. + | TyLambda of + unique: CompilerGlobalState.Unique * + typeParams: Typars * + bodyExpr: Expr * + range: Text.range * + overallType: TType + + /// Applications. + /// Applications combine type type term applications, type are normalized so + /// that sequential applications are combined, so "(f x y)" becomes "f [[x];[y]]". + /// The type attached to the function is the formal function type, used to ensure we don't build application + /// nodes that over-apply when instantiating at function types. + | App of funcExpr: Expr * formalType: TType * typeArgs: TypeInst * args: Exprs * range: Text.range + + /// Bind a recursive set of values. + | LetRec of bindings: Bindings * bodyExpr: Expr * range: Text.range * frees: FreeVarsCache + + /// Bind a value. + | Let of binding: Binding * bodyExpr: Expr * range: Text.range * frees: FreeVarsCache + | Obj of + unique: CompilerGlobalState.Unique * + objTy: TType * + baseVal: Val option * + ctorCall: Expr * + overrides: ObjExprMethod list * + interfaceImpls: (TType * ObjExprMethod list) list * + range: Text.range + + /// Matches are a more complicated form of "let" with multiple possible destinations + /// type possibly multiple ways to get to each destination. + /// The first range is that of the expression being matched, which is used + /// as the range for all the decision making type binding that happens during the decision tree + /// execution. + | Match of + debugPoint: Syntax.DebugPointAtBinding * + inputRange: Text.range * + decision: DecisionTree * + targets: DecisionTreeTarget array * + fullRange: Text.range * + exprType: TType + + /// If we statically know some information then in many cases we can use a more optimized expression + /// This is primarily used by terms in the standard library, particularly those implementing overloaded + /// operators. + | StaticOptimization of conditions: StaticOptimization list * expr: Expr * alternativeExpr: Expr * range: Text.range + + /// An intrinsic applied to some (strictly evaluated) arguments + /// A few of intrinsics (TOp_try, TOp.While, TOp.IntegerForLoop) expect arguments kept in a normal form involving lambdas + | Op of op: TOp * typeArgs: TypeInst * args: Exprs * range: Text.range + + /// Indicates the expression is a quoted expression tree. + /// + | Quote of + quotedExpr: Expr * + quotationInfo: ((ILTypeRef list * TTypes * Exprs * QuotationPickler.ExprData) * (ILTypeRef list * TTypes * Exprs * QuotationPickler.ExprData)) option ref * + isFromQueryExpression: bool * + range: Text.range * + quotedType: TType + + /// Used in quotation generation to indicate a witness argument, spliced into a quotation literal. + /// + /// For example: + /// + /// let inline f x = <@ sin x @> + /// + /// needs to pass a witness argument to `sin x`, captured from the surrounding context, for the witness-passing + /// version of the code. Thus the QuotationTranslation type IlxGen makes the generated code as follows: + /// + /// f(x) { return Deserialize(<@ sin _spliceHole @>, [| x |]) } + /// + /// f$W(witnessForSin, x) { return Deserialize(<@ sin$W _spliceHole1 _spliceHole2 @>, [| WitnessArg(witnessForSin), x |]) } + /// + /// where _spliceHole1 will be the location of the witness argument in the quotation data, type + /// witnessArg is the lambda for the witness + /// + | WitnessArg of traitInfo: TraitConstraintInfo * range: Text.range + + /// Indicates a free choice of typars that arises due to + /// minimization of polymorphism at let-rec bindings. These are + /// resolved to a concrete instantiation on subsequent rewrites. + | TyChoose of typeParams: Typars * bodyExpr: Expr * range: Text.range + + /// An instance of a link node occurs for every use of a recursively bound variable. When type-checking + /// the recursive bindings a dummy expression is stored in the mutable reference cell. + /// After type checking the bindings this is replaced by a use of the variable, perhaps at an + /// appropriate type instantiation. These are immediately eliminated on subsequent rewrites. + | Link of Expr ref + + /// Indicates a debug point should be placed prior to the expression. + | DebugPoint of Syntax.DebugPointAtLeafExpr * Expr + + member ToDebugString: depth: int -> string + + override ToString: unit -> string + + [] + member DebugText: string + + /// Get the mark/range/position information from an expression + member Range: Text.range + +[] +type TOp = + + /// An operation representing the creation of a union value of the particular union case + | UnionCase of UnionCaseRef + + /// An operation representing the creation of an exception value using an F# exception declaration + | ExnConstr of TyconRef + + /// An operation representing the creation of a tuple value + | Tuple of TupInfo + + /// An operation representing the creation of an anonymous record + | AnonRecd of AnonRecdTypeInfo + + /// An operation representing the get of a property from an anonymous record + | AnonRecdGet of AnonRecdTypeInfo * int + + /// An operation representing the creation of an array value + | Array + + /// Constant byte arrays (used for parser tables type other embedded data) + | Bytes of byte[] + + /// Constant uint16 arrays (used for parser tables) + | UInt16s of uint16[] + + /// An operation representing a lambda-encoded while loop. The special while loop marker is used to mark compilations of 'foreach' expressions + | While of spWhile: Syntax.DebugPointAtWhile * marker: SpecialWhileLoopMarker + + /// An operation representing a lambda-encoded integer for-loop + | IntegerForLoop of spFor: Syntax.DebugPointAtFor * spTo: Syntax.DebugPointAtInOrTo * style: ForLoopStyle + + /// An operation representing a lambda-encoded try/with + | TryWith of spTry: Syntax.DebugPointAtTry * spWith: Syntax.DebugPointAtWith + + /// An operation representing a lambda-encoded try/finally + | TryFinally of spTry: Syntax.DebugPointAtTry * spFinally: Syntax.DebugPointAtFinally + + /// Construct a record or object-model value. The ValRef is for self-referential class constructors, otherwise + /// it indicates that we're in a constructor type the purpose of the expression is to + /// fill in the fields of a pre-created but uninitialized object, type to assign the initialized + /// version of the object into the optional mutable cell pointed to be the given value. + | Recd of RecordConstructionInfo * TyconRef + + /// An operation representing setting a record or class field + | ValFieldSet of RecdFieldRef + + /// An operation representing getting a record or class field + | ValFieldGet of RecdFieldRef + + /// An operation representing getting the address of a record field + | ValFieldGetAddr of RecdFieldRef * readonly: bool + + /// An operation representing getting an integer tag for a union value representing the union case number + | UnionCaseTagGet of TyconRef + + /// An operation representing a coercion that proves a union value is of a particular union case. This is not a test, its + /// simply added proof to enable us to generate verifiable code for field access on union types + | UnionCaseProof of UnionCaseRef + + /// An operation representing a field-get from a union value, where that value has been proven to be of the corresponding union case. + | UnionCaseFieldGet of UnionCaseRef * int + + /// An operation representing a field-get from a union value, where that value has been proven to be of the corresponding union case. + | UnionCaseFieldGetAddr of UnionCaseRef * int * readonly: bool + + /// An operation representing a field-get from a union value. The value is not assumed to have been proven to be of the corresponding union case. + | UnionCaseFieldSet of UnionCaseRef * int + + /// An operation representing a field-get from an F# exception value. + | ExnFieldGet of TyconRef * int + + /// An operation representing a field-set on an F# exception value. + | ExnFieldSet of TyconRef * int + + /// An operation representing a field-get from an F# tuple value. + | TupleFieldGet of TupInfo * int + + /// IL assembly code - type list are the types pushed on the stack + | ILAsm of instrs: ILInstr list * retTypes: TTypes + + /// Generate a ldflda on an 'a ref. + | RefAddrGet of bool + + /// Conversion node, compiled via type-directed translation or to box/unbox + | Coerce + + /// Represents a "rethrow" operation. May not be rebound, or used outside of try-finally, expecting a unit argument + | Reraise + + /// Used for state machine compilation + | Return + + /// Used for state machine compilation + | Goto of ILCodeLabel + + /// Used for state machine compilation + | Label of ILCodeLabel + + /// Pseudo method calls. This is used for overloaded operations like op_Addition. + | TraitCall of TraitConstraintInfo + + /// Operation nodes representing C-style operations on byrefs type mutable vals (l-values) + | LValueOp of LValueOperation * ValRef + + /// IL method calls. + /// isProperty -- used for quotation reflection, property getters & setters + /// noTailCall - DllImport? if so don't tailcall + /// retTypes -- the types of pushed values, if any + | ILCall of + isVirtual: bool * + isProtected: bool * + isStruct: bool * + isCtor: bool * + valUseFlag: ValUseFlag * + isProperty: bool * + noTailCall: bool * + ilMethRef: ILMethodRef * + enclTypeInst: TypeInst * + methInst: TypeInst * + retTypes: TTypes + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents the kind of record construction operation. +type RecordConstructionInfo = + + /// We're in an explicit constructor. The purpose of the record expression is to + /// fill in the fields of a pre-created but uninitialized object + | RecdExprIsObjInit + + /// Normal record construction + | RecdExpr + +/// If this is Some ty then it indicates that a .NET 2.0 constrained call is required, with the given type as the +/// static type of the object argument. +type ConstrainedCallInfo = TType option + +/// Represents the kind of looping operation. +type SpecialWhileLoopMarker = + | NoSpecialWhileLoopMarker + + /// Marks the compiled form of a 'for ... in ... do ' expression + | WhileLoopForCompiledForEachExprMarker + +/// Represents the kind of looping operation. +type ForLoopStyle = + + /// Evaluate start type end once, loop up + | FSharpForLoopUp + + /// Evaluate start type end once, loop down + | FSharpForLoopDown + + /// Evaluate start once type end multiple times, loop up + | CSharpForLoopUp + +/// Indicates what kind of pointer operation this is. +type LValueOperation = + + /// In C syntax this is: &localv + | LAddrOf of readonly: bool + + /// In C syntax this is: *localv_ptr + | LByrefGet + + /// In C syntax this is: localv = e, note == *(&localv) = e == LAddrOf; LByrefSet + | LSet + + /// In C syntax this is: *localv_ptr = e + | LByrefSet + +/// Represents the kind of sequential operation, i.e. "normal" or "to a before returning b" +type SequentialOpKind = + + /// a ; b + | NormalSeq + + /// let res = a in b;res + | ThenDoSeq + +/// Indicates how a value, function or member is being used at a particular usage point. +type ValUseFlag = + + /// Indicates a use of a value represents a call to a method that may require + /// a .NET 2.0 constrained call. A constrained call is only used for calls where + | PossibleConstrainedCall of ty: TType + + /// A normal use of a value + | NormalValUse + + /// A call to a constructor, e.g. 'inherit C()' + | CtorValUsedAsSuperInit + + /// A call to a constructor, e.g. 'new C() = new C(3)' + | CtorValUsedAsSelfInit + + /// A call to a base method, e.g. 'base.OnPaint(args)' + | VSlotDirectCall + +/// Represents the kind of an F# core library static optimization construct +type StaticOptimization = + + /// Indicates the static optimization applies when a type equality holds + | TTyconEqualsTycon of ty1: TType * ty2: TType + + /// Indicates the static optimization applies when a type is a struct + | TTyconIsStruct of ty: TType + +/// A representation of a method in an object expression. +/// +/// TObjExprMethod(slotsig, attribs, methTyparsOfOverridingMethod, methodParams, methodBodyExpr, m) +[] +type ObjExprMethod = + | TObjExprMethod of + slotSig: SlotSig * + attribs: Attribs * + methTyparsOfOverridingMethod: Typars * + methodParams: Val list list * + methodBodyExpr: Expr * + range: Text.range + + override ToString: unit -> string + + [] + member DebugText: string + + member Id: Syntax.Ident + +/// Represents an abstract method slot, or delegate signature. +/// +/// TSlotSig(methodName, declaringType, declaringTypeParameters, methodTypeParameters, slotParameters, returnTy) +[] +type SlotSig = + | TSlotSig of + methodName: string * + implementedType: TType * + classTypars: Typars * + methodTypars: Typars * + formalParams: SlotParam list list * + formalReturn: TType option + + override ToString: unit -> string + + /// The class type parameters of the slot + member ClassTypars: Typars + + [] + member DebugText: string + + /// The formal parameters of the slot (regardless of the type or method instantiation) + member FormalParams: SlotParam list list + + /// The formal return type of the slot (regardless of the type or method instantiation) + member FormalReturnType: TType option + + /// The (instantiated) type which the slot is logically a part of + member ImplementedType: TType + + /// The method type parameters of the slot + member MethodTypars: Typars + + /// The name of the method + member Name: string + +/// Represents a parameter to an abstract method slot. +/// +/// TSlotParam(nm, ty, inFlag, outFlag, optionalFlag, attribs) +[] +type SlotParam = + | TSlotParam of + paramName: string option * + paramType: TType * + isIn: bool * + isOut: bool * + isOptional: bool * + attributes: Attribs + + override ToString: unit -> string + + [] + member DebugText: string + + member Type: TType + +/// Represents open declaration statement. +type OpenDeclaration = + { + + /// Syntax after 'open' as it's presented in source code. + Target: Syntax.SynOpenDeclTarget + + /// Full range of the open declaration. + Range: Text.range option + + /// Modules or namespaces which is opened with this declaration. + Modules: ModuleOrNamespaceRef list + + /// Types whose static content is opened with this declaration. + Types: TType list + + /// Scope in which open declaration is visible. + AppliedScope: Text.range + + /// If it's `namespace Xxx.Yyy` declaration. + IsOwnNamespace: bool + } + + /// Create a new instance of OpenDeclaration. + static member Create: + target: Syntax.SynOpenDeclTarget * + modules: ModuleOrNamespaceRef list * + types: TType list * + appliedScope: Text.range * + isOwnNamespace: bool -> + OpenDeclaration + +/// The contents of a module-or-namespace-fragment definition +[] +type ModuleOrNamespaceContents = + + /// Indicates the module fragment is made of several module fragments in succession + | TMDefs of defs: ModuleOrNamespaceContents list + + /// Indicates the given 'open' declarations are active + | TMDefOpens of openDecls: OpenDeclaration list + + /// Indicates the module fragment is a 'let' definition + | TMDefLet of binding: Binding * range: Text.range + + /// Indicates the module fragment is an evaluation of expression for side-effects + | TMDefDo of expr: Expr * range: Text.range + + /// Indicates the module fragment is a 'rec' or 'non-rec' definition of types type modules + | TMDefRec of + isRec: bool * + opens: OpenDeclaration list * + tycons: Tycon list * + bindings: ModuleOrNamespaceBinding list * + range: Text.range + + override ToString: unit -> string + + member DebugText: string + +/// A named module-or-namespace-fragment definition +[] +type ModuleOrNamespaceBinding = + | Binding of binding: Binding + + /// The moduleOrNamespace represents the signature of the module. + /// The moduleOrNamespaceContents contains the definitions of the module. + /// The same set of entities are bound in the ModuleOrNamespace as in the ModuleOrNamespaceContents. + | Module of moduleOrNamespace: ModuleOrNamespace * moduleOrNamespaceContents: ModuleOrNamespaceContents + + override ToString: unit -> string + + [] + member DebugText: string + +[] +type NamedDebugPointKey = + { Range: Text.range + Name: string } + + interface IComparable + + override Equals: yobj: obj -> bool + + override GetHashCode: unit -> int + +/// Represents a complete typechecked implementation file, including its inferred or explicit signature. +/// +/// CheckedImplFile (qualifiedNameOfFile, pragmas, signature, contents, hasExplicitEntryPoint, isScript, anonRecdTypeInfo) +[] +type CheckedImplFile = + | CheckedImplFile of + qualifiedNameOfFile: Syntax.QualifiedNameOfFile * + pragmas: Syntax.ScopedPragma list * + signature: ModuleOrNamespaceType * + contents: ModuleOrNamespaceContents * + hasExplicitEntryPoint: bool * + isScript: bool * + anonRecdTypeInfo: StampMap * + namedDebugPointsForInlinedCode: Map + + override ToString: unit -> string + + member Contents: ModuleOrNamespaceContents + + [] + member DebugText: string + + member HasExplicitEntryPoint: bool + + member IsScript: bool + + member Pragmas: Syntax.ScopedPragma list + + member QualifiedNameOfFile: Syntax.QualifiedNameOfFile + + member Signature: ModuleOrNamespaceType + +/// Represents a complete typechecked assembly, made up of multiple implementation files. +[] +type CheckedImplFileAfterOptimization = + { ImplFile: CheckedImplFile + OptimizeDuringCodeGen: bool -> Expr -> Expr } + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents a complete typechecked assembly, made up of multiple implementation files. +[] +type CheckedAssemblyAfterOptimization = + | CheckedAssemblyAfterOptimization of CheckedImplFileAfterOptimization list + + override ToString: unit -> string + + [] + member DebugText: string + +[] +type CcuData = + { + + /// Holds the file name for the DLL, if any + FileName: string option + + /// Holds the data indicating how this assembly/module is referenced from the code being compiled. + ILScopeRef: ILScopeRef + + /// A unique stamp for this DLL + Stamp: Stamp + + /// The fully qualified assembly reference string to refer to this assembly. This is persisted in quotations + QualifiedName: string option + + /// A hint as to where does the code for the CCU live (e.g what was the tcConfig.implicitIncludeDir at compilation time for this DLL?) + SourceCodeDirectory: string + + /// Indicates that this DLL was compiled using the F# compiler type has F# metadata + IsFSharp: bool + + /// Is the CCu an assembly injected by a type provider + IsProviderGenerated: bool + + /// Triggered when the contents of the CCU are invalidated + InvalidateEvent: IEvent + + /// A helper function used to link method signatures using type equality. This is effectively a forward call to the type equality + /// logic in tastops.fs + ImportProvidedType: Tainted -> TType + + /// Indicates that this DLL uses pre-F#-4.0 quotation literals somewhere. This is used to implement a restriction on static linking + mutable UsesFSharp20PlusQuotations: bool + + /// A handle to the full specification of the contents of the module contained in this ccu + mutable Contents: ModuleOrNamespace + + /// A helper function used to link method signatures using type equality. This is effectively a forward call to the type equality + /// logic in tastops.fs + TryGetILModuleDef: unit -> ILModuleDef option + + /// A helper function used to link method signatures using type equality. This is effectively a forward call to the type equality + /// logic in tastops.fs + MemberSignatureEquality: TType -> TType -> bool + + /// The table of .NET CLI type forwarders for this assembly + TypeForwarders: CcuTypeForwarderTable + XmlDocumentationInfo: XmlDocumentationInfo option + } + + override ToString: unit -> string + + [] + member DebugText: string + +type CcuTypeForwarderTree = + { Value: Lazy option + Children: ImmutableDictionary } + + static member Empty: CcuTypeForwarderTree + +/// Represents a table of .NET CLI type forwarders for an assembly +type CcuTypeForwarderTable = + { Root: CcuTypeForwarderTree } + + member TryGetValue: path: string array -> item: string -> Lazy option + + static member Empty: CcuTypeForwarderTable + +type CcuReference = string + +/// A relinkable handle to the contents of a compilation unit. Relinking is performed by mutation. +[] +type CcuThunk = + { + + /// ccu.target is null when a reference is missing in the transitive closure of static references that + /// may potentially be required for the metadata of referenced DLLs. + mutable target: CcuData + name: CcuReference + } + + /// Create a CCU with the given name type contents + static member Create: nm: CcuReference * x: CcuData -> CcuThunk + + /// Create a CCU with the given name but where the contents have not yet been specified + static member CreateDelayed: nm: CcuReference -> CcuThunk + + /// Used at the end of comppiling an assembly to get a frozen, final stable CCU + /// for the compilation which we no longer mutate. + member CloneWithFinalizedContents: ccuContents: ModuleOrNamespace -> CcuThunk + + /// Ensure the ccu is derefable in advance. Supply a path to attach to any resulting error message. + member EnsureDerefable: requiringPath: string[] -> unit + + /// Fixup a CCU to have the given contents + member Fixup: avail: CcuThunk -> unit + + /// Used to make 'forward' calls into the loader during linking + member ImportProvidedType: ty: Tainted -> TType + + /// Used to make forward calls into the type/assembly loader when comparing member signatures during linking + member MemberSignatureEquality: ty1: TType * ty2: TType -> bool + + override ToString: unit -> string + + /// Try to resolve a path into the CCU by referencing the .NET/CLI type forwarder table of the CCU + member TryForward: nlpath: string[] * item: string -> EntityRef option + + /// Try to get the .NET Assembly, if known. May not be present for `IsFSharp` for + /// in-memory cross-project references + member TryGetILModuleDef: unit -> ILModuleDef option + + /// The short name of the assembly being referenced + member AssemblyName: string + + /// A handle to the full specification of the contents of the module contained in this ccu + member Contents: Entity + + [] + member DebugText: string + + /// Dereference the assembly reference + member Deref: CcuData + + /// Holds the file name for the assembly, if any + member FileName: string option + + /// Holds the data indicating how this assembly/module is referenced from the code being compiled. + member ILScopeRef: ILScopeRef + + /// Indicates that this DLL was compiled using the F# compiler type has F# metadata + member IsFSharp: bool + + /// Is this a provider-injected assembly + member IsProviderGenerated: bool + + /// Indicates if this assembly reference is unresolved + member IsUnresolvedReference: bool + + /// The fully qualified assembly reference string to refer to this assembly. This is persisted in quotations + member QualifiedName: string option + + /// The table of modules type namespaces at the "root" of the assembly + member RootModulesAndNamespaces: Entity list + + /// The table of type definitions at the "root" of the assembly + member RootTypeAndExceptionDefinitions: Entity list + + /// A hint as to where does the code for the CCU live (e.g what was the tcConfig.implicitIncludeDir at compilation time for this DLL?) + member SourceCodeDirectory: string + + /// A unique stamp for this assembly + member Stamp: Stamp + + /// The table of type forwarders for this assembly + member TypeForwarders: CcuTypeForwarderTable + + /// Indicates that this DLL uses F# 2.0+ quotation literals somewhere. This is used to implement a restriction on static linking. + member UsesFSharp20PlusQuotations: bool with get, set + +/// The result of attempting to resolve an assembly name to a full ccu. +/// UnresolvedCcu will contain the name of the assembly that could not be resolved. +[] +type CcuResolutionResult = + | ResolvedCcu of CcuThunk + | UnresolvedCcu of string + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents the information saved in the assembly signature data resource for an F# assembly +[] +type PickledCcuInfo = + { mspec: ModuleOrNamespace + compileTimeWorkingDir: string + usesQuotations: bool } + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents a set of free local values. Computed type cached by later phases +/// (never cached type checking). Cached in expressions. Not pickled. +type FreeLocals = Zset + +/// Represents a set of free type parameters. Computed type cached by later phases +/// (never cached type checking). Cached in expressions. Not pickled. +type FreeTypars = Zset + +/// Represents a set of 'free' named type definitions. Used to collect the named type definitions referred to +/// from a type or expression. Computed type cached by later phases (never cached type checking). Cached +/// in expressions. Not pickled. +type FreeTycons = Zset + +/// Represents a set of 'free' record field definitions. Used to collect the record field definitions referred to +/// from an expression. +type FreeRecdFields = Zset + +/// Represents a set of 'free' union cases. Used to collect the union cases referred to from an expression. +type FreeUnionCases = Zset + +/// Represents a set of 'free' type-related elements, including named types, trait solutions, union cases and +/// record fields. +[] +type FreeTyvars = + { + + /// The summary of locally defined type definitions used in the expression. These may be made private by a signature + /// type we have to check various conditions associated with that. + FreeTycons: FreeTycons + + /// The summary of values used as trait solutions + FreeTraitSolutions: FreeLocals + + /// The summary of type parameters used in the expression. These may not escape the enclosing generic construct + /// type we have to check various conditions associated with that. + FreeTypars: FreeTypars + } + + override ToString: unit -> string + + [] + member DebugText: string + +/// Represents an amortized computation of the free variables in an expression +type FreeVarsCache = cache + +/// Represents the set of free variables in an expression +[] +type FreeVars = + { + + /// The summary of locally defined variables used in the expression. These may be hidden at let bindings etc. + /// or made private by a signature or marked 'internal' or 'private', type we have to check various conditions associated with that. + FreeLocals: FreeLocals + + /// Indicates if the expression contains a call to a protected member or a base call. + /// Calls to protected members type direct calls to super classes can't escape, also code can't be inlined + UsesMethodLocalConstructs: bool + + /// Indicates if the expression contains a call to rethrow that is not bound under a (try-)with branch. + /// Rethrow may only occur in such locations. + UsesUnboundRethrow: bool + + /// The summary of locally defined tycon representations used in the expression. These may be made private by a signature + /// or marked 'internal' or 'private' type we have to check various conditions associated with that. + FreeLocalTyconReprs: FreeTycons + + /// The summary of fields used in the expression. These may be made private by a signature + /// or marked 'internal' or 'private' type we have to check various conditions associated with that. + FreeRecdFields: FreeRecdFields + + /// The summary of union constructors used in the expression. These may be + /// marked 'internal' or 'private' type we have to check various conditions associated with that. + FreeUnionCases: FreeUnionCases + + /// See FreeTyvars above. + FreeTyvars: FreeTyvars + } + + override ToString: unit -> string + + [] + member DebugText: string + +/// A set of static methods for constructing types. +type Construct = + + new: unit -> Construct + + /// Compute the definition location of a provided item + static member ComputeDefinitionLocationOfProvidedItem: + p: Tainted<#IProvidedCustomAttributeProvider> -> Text.range option + + /// Key a Tycon or TyconRef by both mangled type demangled name. + /// Generic types can be accessed either by 'List' or 'List`1'. + /// This lists both keys. + static member KeyTyconByAccessNames: nm: string -> x: 'T -> KeyValuePair[] + + /// Key a Tycon or TyconRef by decoded name + static member KeyTyconByDecodedName: nm: string -> x: 'T -> KeyValuePair + + /// Create the field tables for a record or class type + static member MakeRecdFieldsTable: ucs: RecdField list -> TyconRecdFields + + /// Create the union case tables for a union type + static member MakeUnionCases: ucs: UnionCase list -> TyconUnionData + + /// Create a node for a union type + static member MakeUnionRepr: ucs: UnionCase list -> TyconRepresentation + + /// Create the new contents of an overall assembly + static member NewCcuContents: + sref: ILScopeRef -> m: Text.range -> nm: string -> mty: ModuleOrNamespaceType -> ModuleOrNamespace + + /// Create a new module or namespace node by cloning an existing one + static member NewClonedModuleOrNamespace: orig: Tycon -> Entity + + /// Create a new type definition node by cloning an existing one + static member NewClonedTycon: orig: Tycon -> Entity + + /// Create a new node for an empty module or namespace contents + static member NewEmptyModuleOrNamespaceType: mkind: ModuleOrNamespaceKind -> ModuleOrNamespaceType + + /// Create a new TAST Entity node for an F# exception definition + static member NewExn: + cpath: CompilationPath option -> + id: Syntax.Ident -> + access: Accessibility -> + repr: ExceptionInfo -> + attribs: Attribs -> + doc: XmlDoc -> + Entity + + /// Create a new unfilled cache for free variable calculations + static member NewFreeVarsCache: unit -> cache<'a> + + /// Create a new type definition node for a .NET type definition + static member NewILTycon: + nlpath: CompilationPath option -> + nm: string * m: Text.range -> + tps: LazyWithContext -> + scoref: ILScopeRef * enc: ILTypeDef list * tdef: ILTypeDef -> + mtyp: MaybeLazy -> + Entity + + /// Create a module Tycon based on an existing one using the function 'f'. + /// We require that we be given the parent for the new module. + /// We pass the new module to 'f' in case it needs to reparent the + /// contents of the module. + static member NewModifiedModuleOrNamespace: + f: (ModuleOrNamespaceType -> ModuleOrNamespaceType) -> orig: Tycon -> Entity + + /// Create a tycon based on an existing one using the function 'f'. + /// We require that we be given the new parent for the new tycon. + /// We pass the new tycon to 'f' in case it needs to reparent the + /// contents of the tycon. + static member NewModifiedTycon: f: (Tycon -> Entity) -> orig: Tycon -> Entity + + /// Create a Val based on an existing one using the function 'f'. + /// We require that we be given the parent for the new Val. + static member NewModifiedVal: f: (Val -> Val) -> orig: Val -> Val + + /// Create a new entity node for a module or namespace + static member NewModuleOrNamespace: + cpath: CompilationPath option -> + access: Accessibility -> + id: Syntax.Ident -> + xml: XmlDoc -> + attribs: Attrib list -> + mtype: MaybeLazy -> + ModuleOrNamespace + + /// Create a new node for the contents of a module or namespace + static member NewModuleOrNamespaceType: + mkind: ModuleOrNamespaceKind -> tycons: Entity list -> vals: Val list -> ModuleOrNamespaceType + + /// Create a new entity node for a provided type definition + static member NewProvidedTycon: + resolutionEnvironment: ResolutionEnvironment * + st: Tainted * + importProvidedType: (Tainted -> TType) * + isSuppressRelocate: bool * + m: Text.range * + ?access: Accessibility * + ?cpath: CompilationPath -> + Entity + + /// Create a new node for the representation information for a provided type definition + static member NewProvidedTyconRepr: + resolutionEnvironment: ResolutionEnvironment * + st: Tainted * + importProvidedType: (Tainted -> TType) * + isSuppressRelocate: bool * + m: Text.range -> + TyconRepresentation + + /// Create a new TAST RecdField node for an F# class, struct or record field + static member NewRecdField: + stat: bool -> + konst: Const option -> + id: Syntax.Ident -> + nameGenerated: bool -> + ty: TType -> + isMutable: bool -> + isVolatile: bool -> + pattribs: Attribs -> + fattribs: Attribs -> + docOption: XmlDoc -> + access: Accessibility -> + secret: bool -> + RecdField + + /// Create a new type parameter node for a declared type parameter + static member NewRigidTypar: nm: string -> m: Text.range -> Typar + + /// Create a new type definition node + static member NewTycon: + cpath: CompilationPath option * + nm: string * + m: Text.range * + access: Accessibility * + reprAccess: Accessibility * + kind: TyparKind * + typars: LazyWithContext * + doc: XmlDoc * + usesPrefixDisplay: bool * + preEstablishedHasDefaultCtor: bool * + hasSelfReferentialCtor: bool * + mtyp: MaybeLazy -> + Entity + + /// Create a new type parameter node + static member NewTypar: + kind: TyparKind * + rigid: TyparRigidity * + Syntax.SynTypar * + isFromError: bool * + dynamicReq: TyparDynamicReq * + attribs: Attrib list * + eqDep: bool * + compDep: bool -> + Typar + + /// Create a new union case node + static member NewUnionCase: + id: Syntax.Ident -> + tys: RecdField list -> + retTy: TType -> + attribs: Attribs -> + docOption: XmlDoc -> + access: Accessibility -> + UnionCase + + /// Create a new Val node + static member NewVal: + logicalName: string * + m: Text.range * + compiledName: string option * + ty: TType * + isMutable: ValMutability * + isCompGen: bool * + arity: ValReprInfo option * + access: Accessibility * + recValInfo: ValRecursiveScopeInfo * + specialRepr: ValMemberInfo option * + baseOrThis: ValBaseOrThisInfo * + attribs: Attrib list * + inlineInfo: ValInline * + doc: XmlDoc * + isModuleOrMemberBinding: bool * + isExtensionMember: bool * + isIncrClassSpecialMember: bool * + isTyFunc: bool * + allowTypeInst: bool * + isGeneratedEventVal: bool * + konst: Const option * + actualParent: ParentRef -> + Val + +module CcuTypeForwarderTable = + + val findInTree: + remainingPath: ArraySegment -> finalKey: string -> tree: CcuTypeForwarderTree -> Lazy option diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fsi b/src/Compiler/TypedTree/TypedTreeBasics.fsi index a0c9f776373..246a9e74baa 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fsi +++ b/src/Compiler/TypedTree/TypedTreeBasics.fsi @@ -85,7 +85,7 @@ val (|ERefLocal|ERefNonLocal|): x: EntityRef -> Choice, NonL val mkLocalTyconRef: x: NonNullSlot -> EntityRef -val mkNonLocalEntityRef: ccu: CcuThunk -> mp: string [] -> NonLocalEntityRef +val mkNonLocalEntityRef: ccu: CcuThunk -> mp: string[] -> NonLocalEntityRef val mkNestedNonLocalEntityRef: nleref: NonLocalEntityRef -> id: string -> NonLocalEntityRef @@ -154,7 +154,7 @@ val tyconRefUsesLocalXmlDoc: compilingFSharpCore: bool -> x: TyconRef -> bool val entityRefInThisAssembly: compilingFSharpCore: bool -> x: EntityRef -> bool -val arrayPathEq: y1: string [] -> y2: string [] -> bool +val arrayPathEq: y1: string[] -> y2: string[] -> bool val nonLocalRefEq: NonLocalEntityRef -> NonLocalEntityRef -> bool diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 17ff3b487fb..9530e3c0662 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -920,7 +920,6 @@ val MeasureExprConExponent: TcGlobals -> bool -> TyconRef -> Measure -> Rational val normalizeMeasure: TcGlobals -> Measure -> Measure - //------------------------------------------------------------------------- // Members //------------------------------------------------------------------------- @@ -1033,36 +1032,38 @@ type GenericParameterStyle = [] type DisplayEnv = - { includeStaticParametersInTypeNames: bool - openTopPathsSorted: Lazy - openTopPathsRaw: string list list - shortTypeNames: bool - suppressNestedTypes: bool - maxMembers: int option - showObsoleteMembers: bool - showHiddenMembers: bool - showTyparBinding: bool - showInferenceTyparAnnotations: bool - suppressInlineKeyword: bool - suppressMutableKeyword: bool - showMemberContainers: bool - shortConstraints: bool - useColonForReturnType: bool - showAttributes: bool - showOverrides: bool - showStaticallyResolvedTyparAnnotations: bool - abbreviateAdditionalConstraints: bool - showTyparDefaultConstraints: bool - /// If set, signatures will be rendered with XML documentation comments for members if they exist - /// Defaults to false, expected use cases include things like signature file generation. - showDocumentation: bool - shrinkOverloads: bool - printVerboseSignatures: bool - escapeKeywordNames: bool - g: TcGlobals - contextAccessibility: Accessibility - generatedValueLayout: Val -> Layout option - genericParameterStyle: GenericParameterStyle } + { + includeStaticParametersInTypeNames: bool + openTopPathsSorted: Lazy + openTopPathsRaw: string list list + shortTypeNames: bool + suppressNestedTypes: bool + maxMembers: int option + showObsoleteMembers: bool + showHiddenMembers: bool + showTyparBinding: bool + showInferenceTyparAnnotations: bool + suppressInlineKeyword: bool + suppressMutableKeyword: bool + showMemberContainers: bool + shortConstraints: bool + useColonForReturnType: bool + showAttributes: bool + showOverrides: bool + showStaticallyResolvedTyparAnnotations: bool + abbreviateAdditionalConstraints: bool + showTyparDefaultConstraints: bool + /// If set, signatures will be rendered with XML documentation comments for members if they exist + /// Defaults to false, expected use cases include things like signature file generation. + showDocumentation: bool + shrinkOverloads: bool + printVerboseSignatures: bool + escapeKeywordNames: bool + g: TcGlobals + contextAccessibility: Accessibility + generatedValueLayout: Val -> Layout option + genericParameterStyle: GenericParameterStyle + } member SetOpenPaths: string list list -> DisplayEnv @@ -1242,11 +1243,13 @@ val instExpr: TcGlobals -> TyparInstantiation -> Expr -> Expr /// The remapping that corresponds to a module meeting its signature /// and also report the set of tycons, tycon representations and values hidden in the process. type SignatureRepackageInfo = - { /// The list of corresponding values - RepackagedVals: (ValRef * ValRef) list + { + /// The list of corresponding values + RepackagedVals: (ValRef * ValRef) list - /// The list of corresponding modules, namespaces and type definitions - RepackagedEntities: (TyconRef * TyconRef) list } + /// The list of corresponding modules, namespaces and type definitions + RepackagedEntities: (TyconRef * TyconRef) list + } /// The empty table static member Empty: SignatureRepackageInfo @@ -1932,7 +1935,6 @@ val mkByteArrayTy: TcGlobals -> TType val mkInvalidCastExnNewobj: TcGlobals -> ILInstr - //------------------------------------------------------------------------- // Construct calls to some intrinsic functions //------------------------------------------------------------------------- @@ -2250,7 +2252,6 @@ val mkCompilationMappingAttr: TcGlobals -> int -> ILAttribute val mkCompilationMappingAttrWithSeqNum: TcGlobals -> int -> int -> ILAttribute - val mkCompilationMappingAttrWithVariantNumAndSeqNum: TcGlobals -> int -> int -> int -> ILAttribute val mkCompilationMappingAttrForQuotationResource: TcGlobals -> string * ILTypeRef list -> ILAttribute @@ -2328,7 +2329,7 @@ val mkMethodTy: TcGlobals -> TType list list -> TType -> TType val mkAnyAnonRecdTy: TcGlobals -> AnonRecdTypeInfo -> TType list -> TType -val mkAnonRecd: TcGlobals -> range -> AnonRecdTypeInfo -> Ident [] -> Exprs -> TType list -> Expr +val mkAnonRecd: TcGlobals -> range -> AnonRecdTypeInfo -> Ident[] -> Exprs -> TType list -> Expr val AdjustValForExpectedArity: TcGlobals -> range -> ValRef -> ValUseFlag -> ValReprInfo -> Expr * TType diff --git a/src/Compiler/TypedTree/TypedTreePickle.fsi b/src/Compiler/TypedTree/TypedTreePickle.fsi index 2b511efa917..2d6fc2bdc4d 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fsi +++ b/src/Compiler/TypedTree/TypedTreePickle.fsi @@ -12,11 +12,13 @@ open FSharp.Compiler.TcGlobals /// Represents deserialized data with a dangling set of CCU fixup thunks indexed by name [] type PickledDataWithReferences<'RawData> = - { /// The data that uses a collection of CcuThunks internally - RawData: 'RawData + { + /// The data that uses a collection of CcuThunks internally + RawData: 'RawData - /// The assumptions that need to be fixed up - FixupThunks: CcuThunk [] } + /// The assumptions that need to be fixed up + FixupThunks: CcuThunk[] + } member Fixup: (CcuReference -> CcuThunk) -> 'RawData @@ -55,7 +57,7 @@ val inline internal p_tup4: pickler<'T1> -> pickler<'T2> -> pickler<'T3> -> pickler<'T4> -> pickler<'T1 * 'T2 * 'T3 * 'T4> /// Serialize an array of data -val internal p_array: pickler<'T> -> pickler<'T []> +val internal p_array: pickler<'T> -> pickler<'T[]> /// Serialize a namemap of data val internal p_namemap: pickler<'T> -> pickler> @@ -117,7 +119,7 @@ val inline internal u_tup4: unpickler<'T2> -> unpickler<'T3> -> unpickler<'T4> -> unpickler<'T5> -> unpickler<'T2 * 'T3 * 'T4 * 'T5> /// Deserialize an array of values -val internal u_array: unpickler<'T> -> unpickler<'T []> +val internal u_array: unpickler<'T> -> unpickler<'T[]> /// Deserialize a namemap val internal u_namemap: unpickler<'T> -> unpickler> diff --git a/src/Compiler/TypedTree/tainted.fsi b/src/Compiler/TypedTree/tainted.fsi index 00f056cb995..ee1a6d94069 100644 --- a/src/Compiler/TypedTree/tainted.fsi +++ b/src/Compiler/TypedTree/tainted.fsi @@ -42,7 +42,6 @@ type internal TypeProviderError = /// provides uniform way to process aggregated errors member Iter: (TypeProviderError -> unit) -> unit - /// This struct wraps a value produced by a type provider to properly attribute any failures. [] type internal Tainted<'T> = @@ -79,7 +78,7 @@ type internal Tainted<'T> = member PApplyWithProvider: ('T * ITypeProvider -> 'U) * range: range -> Tainted<'U> /// Apply an operation that returns an array. Unwrap array. Any exception will be attributed to the type provider with an error located at the given range. String is method name of thing-returning-array, to diagnostically attribute if it is null - member PApplyArray: ('T -> 'U [] MaybeNull) * string * range: range -> Tainted<'U> [] + member PApplyArray: ('T -> 'U[] MaybeNull) * string * range: range -> Tainted<'U>[] /// Apply an operation that returns an option. Unwrap option. Any exception will be attributed to the type provider with an error located at the given range member PApplyOption: ('T -> 'U option) * range: range -> Tainted<'U> option diff --git a/src/Compiler/Utilities/FileSystem.fsi b/src/Compiler/Utilities/FileSystem.fsi index 7eabb6151ce..9b23e58a3f6 100644 --- a/src/Compiler/Utilities/FileSystem.fsi +++ b/src/Compiler/Utilities/FileSystem.fsi @@ -13,19 +13,19 @@ exception internal IllegalFileNameChar of string * char module internal Bytes = /// returned int will be 0 <= x <= 255 - val get: byte [] -> int -> int + val get: byte[] -> int -> int - val zeroCreate: int -> byte [] + val zeroCreate: int -> byte[] /// each int must be 0 <= x <= 255 - val ofInt32Array: int [] -> byte [] + val ofInt32Array: int[] -> byte[] /// each int will be 0 <= x <= 255 - val blit: byte [] -> int -> byte [] -> int -> int -> unit + val blit: byte[] -> int -> byte[] -> int -> int -> unit - val stringAsUnicodeNullTerminated: string -> byte [] + val stringAsUnicodeNullTerminated: string -> byte[] - val stringAsUtf8NullTerminated: string -> byte [] + val stringAsUtf8NullTerminated: string -> byte[] /// A view over bytes. /// May be backed by managed or unmanaged memory, or memory mapped file. @@ -36,9 +36,9 @@ type public ByteMemory = abstract Length: int - abstract ReadAllBytes: unit -> byte [] + abstract ReadAllBytes: unit -> byte[] - abstract ReadBytes: pos: int * count: int -> byte [] + abstract ReadBytes: pos: int * count: int -> byte[] abstract ReadInt32: pos: int -> int @@ -50,9 +50,9 @@ type public ByteMemory = abstract CopyTo: Stream -> unit - abstract Copy: srcOffset: int * dest: byte [] * destOffset: int * count: int -> unit + abstract Copy: srcOffset: int * dest: byte[] * destOffset: int * count: int -> unit - abstract ToArray: unit -> byte [] + abstract ToArray: unit -> byte[] /// Get a stream representation of the backing memory. /// Disposing this will not free up any of the backing memory. @@ -72,9 +72,9 @@ type internal ReadOnlyByteMemory = member Length: int - member ReadAllBytes: unit -> byte [] + member ReadAllBytes: unit -> byte[] - member ReadBytes: pos: int * count: int -> byte [] + member ReadBytes: pos: int * count: int -> byte[] member ReadInt32: pos: int -> int @@ -86,9 +86,9 @@ type internal ReadOnlyByteMemory = member CopyTo: Stream -> unit - member Copy: srcOffset: int * dest: byte [] * destOffset: int * count: int -> unit + member Copy: srcOffset: int * dest: byte[] * destOffset: int * count: int -> unit - member ToArray: unit -> byte [] + member ToArray: unit -> byte[] member AsStream: unit -> Stream @@ -215,7 +215,6 @@ type public IFileSystem = /// Used to determine if a file will not be subject to deletion during the lifetime of a typical client process. abstract IsStableFileHeuristic: fileName: string -> bool - /// Represents a default (memory-mapped) implementation of the file system type DefaultFileSystem = /// Create a default implementation of the file system @@ -296,8 +295,8 @@ module public StreamExtensions = member WriteAllLines: contents: string seq * ?encoding: Encoding -> unit member Write<'a> : data: 'a -> unit member GetReader: codePage: int option * ?retryLocked: bool -> StreamReader - member ReadBytes: start: int * len: int -> byte [] - member ReadAllBytes: unit -> byte [] + member ReadBytes: start: int * len: int -> byte[] + member ReadAllBytes: unit -> byte[] member ReadAllText: ?encoding: Encoding -> string member ReadLines: ?encoding: Encoding -> string seq member ReadAllLines: ?encoding: Encoding -> string array @@ -324,10 +323,10 @@ type internal ByteMemory with static member FromUnsafePointer: addr: nativeint * length: int * holder: obj -> ByteMemory /// Creates a ByteMemory object that is backed by a byte array with the specified offset and length. - static member FromArray: bytes: byte [] * offset: int * length: int -> ByteMemory + static member FromArray: bytes: byte[] * offset: int * length: int -> ByteMemory /// Creates a ByteMemory object that is backed by a byte array. - static member FromArray: bytes: byte [] -> ByteMemory + static member FromArray: bytes: byte[] -> ByteMemory [] type internal ByteStream = @@ -355,13 +354,13 @@ type internal ByteBuffer = member EmitIntAsByte: int -> unit [] - member EmitIntsAsBytes: int [] -> unit + member EmitIntsAsBytes: int[] -> unit [] member EmitByte: byte -> unit [] - member EmitBytes: byte [] -> unit + member EmitBytes: byte[] -> unit [] member EmitMemory: ReadOnlyMemory -> unit @@ -399,7 +398,7 @@ type internal ByteStorage = static member FromByteMemory: ReadOnlyByteMemory -> ByteStorage /// Creates a ByteStorage whose backing bytes are the given byte array. Does not make a copy. - static member FromByteArray: byte [] -> ByteStorage + static member FromByteArray: byte[] -> ByteStorage /// Creates a ByteStorage that has a copy of the given ByteMemory. static member FromByteMemoryAndCopy: ReadOnlyByteMemory * useBackingMemoryMappedFile: bool -> ByteStorage @@ -408,4 +407,4 @@ type internal ByteStorage = static member FromMemoryAndCopy: ReadOnlyMemory * useBackingMemoryMappedFile: bool -> ByteStorage /// Creates a ByteStorage that has a copy of the given byte array. - static member FromByteArrayAndCopy: byte [] * useBackingMemoryMappedFile: bool -> ByteStorage + static member FromByteArrayAndCopy: byte[] * useBackingMemoryMappedFile: bool -> ByteStorage diff --git a/src/Compiler/Utilities/ResizeArray.fsi b/src/Compiler/Utilities/ResizeArray.fsi index 84aa416024e..890968f4532 100644 --- a/src/Compiler/Utilities/ResizeArray.fsi +++ b/src/Compiler/Utilities/ResizeArray.fsi @@ -128,10 +128,10 @@ module internal ResizeArray = val sortBy: ('T -> 'Key) -> ResizeArray<'T> -> unit when 'Key: comparison /// Return a fixed-length array containing the elements of the input ResizeArray. - val toArray: ResizeArray<'T> -> 'T [] + val toArray: ResizeArray<'T> -> 'T[] /// Build a ResizeArray from the given elements. - val ofArray: 'T [] -> ResizeArray<'T> + val ofArray: 'T[] -> ResizeArray<'T> /// Return a view of the array as an enumerable object. val toSeq: ResizeArray<'T> -> seq<'T> diff --git a/src/Compiler/Utilities/XmlAdapters.fsi b/src/Compiler/Utilities/XmlAdapters.fsi index bff4a2bd549..ab08f1c5ebd 100644 --- a/src/Compiler/Utilities/XmlAdapters.fsi +++ b/src/Compiler/Utilities/XmlAdapters.fsi @@ -2,7 +2,7 @@ module internal Internal.Utilities.XmlAdapters -val s_escapeChars: char [] +val s_escapeChars: char[] val getEscapeSequence: c: char -> string diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index a1de6b39678..6f7a0591bdc 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -90,43 +90,43 @@ module internal Order = module internal Array = - val mapq: f: ('a -> 'a) -> inp: 'a [] -> 'a [] when 'a: not struct + val mapq: f: ('a -> 'a) -> inp: 'a[] -> 'a[] when 'a: not struct - val lengthsEqAndForall2: p: ('a -> 'b -> bool) -> l1: 'a [] -> l2: 'b [] -> bool + val lengthsEqAndForall2: p: ('a -> 'b -> bool) -> l1: 'a[] -> l2: 'b[] -> bool val order: eltOrder: IComparer<'T> -> IComparer<'T array> - val existsOne: p: ('a -> bool) -> l: 'a [] -> bool + val existsOne: p: ('a -> bool) -> l: 'a[] -> bool - val existsTrue: arr: bool [] -> bool + val existsTrue: arr: bool[] -> bool - val findFirstIndexWhereTrue: arr: 'a [] -> p: ('a -> bool) -> int + val findFirstIndexWhereTrue: arr: 'a[] -> p: ('a -> bool) -> int /// pass an array byref to reverse it in place - val revInPlace: array: 'T [] -> unit + val revInPlace: array: 'T[] -> unit /// Async implementation of Array.map. - val mapAsync: mapping: ('T -> Async<'U>) -> array: 'T [] -> Async<'U []> + val mapAsync: mapping: ('T -> Async<'U>) -> array: 'T[] -> Async<'U[]> /// Returns a new array with an element replaced with a given value. - val replace: index: int -> value: 'a -> array: 'a [] -> 'a [] + val replace: index: int -> value: 'a -> array: 'a[] -> 'a[] /// Optimized arrays equality. ~100x faster than `array1 = array2` on strings. /// ~2x faster for floats /// ~0.8x slower for ints - val inline areEqual: xs: 'T [] -> ys: 'T [] -> bool when 'T: equality + val inline areEqual: xs: 'T[] -> ys: 'T[] -> bool when 'T: equality /// Returns all heads of a given array. - val heads: array: 'T [] -> 'T [] [] + val heads: array: 'T[] -> 'T[][] /// Check if subArray is found in the wholeArray starting at the provided index - val inline isSubArray: subArray: 'T [] -> wholeArray: 'T [] -> index: int -> bool when 'T: equality + val inline isSubArray: subArray: 'T[] -> wholeArray: 'T[] -> index: int -> bool when 'T: equality /// Returns true if one array has another as its subset from index 0. - val startsWith: prefix: 'a [] -> whole: 'a [] -> bool when 'a: equality + val startsWith: prefix: 'a[] -> whole: 'a[] -> bool when 'a: equality /// Returns true if one array has trailing elements equal to another's. - val endsWith: suffix: 'a [] -> whole: 'a [] -> bool when 'a: equality + val endsWith: suffix: 'a[] -> whole: 'a[] -> bool when 'a: equality module internal Option = @@ -187,7 +187,7 @@ module internal List = val collect2: f: ('a -> 'b -> 'c list) -> xs: 'a list -> ys: 'b list -> 'c list - val toArraySquared: xss: 'a list list -> 'a [] [] + val toArraySquared: xss: 'a list list -> 'a[][] val iterSquared: f: ('a -> unit) -> xss: 'a list list -> unit @@ -216,12 +216,12 @@ module internal ResizeArray = /// Split a ResizeArray into an array of smaller chunks. /// This requires `items/chunkSize` Array copies of length `chunkSize` if `items/chunkSize % 0 = 0`, /// otherwise `items/chunkSize + 1` Array copies. - val chunkBySize: chunkSize: int -> f: ('t -> 'a) -> items: ResizeArray<'t> -> 'a [] [] + val chunkBySize: chunkSize: int -> f: ('t -> 'a) -> items: ResizeArray<'t> -> 'a[][] /// Split a large ResizeArray into a series of array chunks that are each under the Large Object Heap limit. /// This is done to help prevent a stop-the-world collection of the single large array, instead allowing for a greater /// probability of smaller collections. Stop-the-world is still possible, just less likely. - val mapToSmallArrayChunks: f: ('t -> 'a) -> inp: ResizeArray<'t> -> 'a [] [] + val mapToSmallArrayChunks: f: ('t -> 'a) -> inp: ResizeArray<'t> -> 'a[][] module internal ValueOptionInternal = @@ -229,7 +229,6 @@ module internal ValueOptionInternal = val inline bind: f: ('a -> 'b voption) -> x: 'a voption -> 'b voption - module internal String = val make: n: int -> c: char -> string @@ -256,20 +255,20 @@ module internal String = val dropSuffix: s: string -> t: string -> string - val inline toCharArray: str: string -> char [] + val inline toCharArray: str: string -> char[] val lowerCaseFirstChar: str: string -> string val extractTrailingIndex: str: string -> string * int option /// Splits a string into substrings based on the strings in the array separators - val split: options: StringSplitOptions -> separator: string [] -> value: string -> string [] + val split: options: StringSplitOptions -> separator: string[] -> value: string -> string[] val (|StartsWith|_|): pattern: string -> value: string -> unit option val (|Contains|_|): pattern: string -> value: string -> unit option - val getLines: str: string -> string [] + val getLines: str: string -> string[] module internal Dictionary = val inline newWithSize: size: int -> Dictionary<'a, 'b> when 'a: equality @@ -521,7 +520,6 @@ module internal NameMap = val exists: f: ('a -> 'b -> bool) -> m: Map<'a, 'b> -> bool when 'a: comparison - val ofKeyedList: f: ('a -> 'b) -> l: 'a list -> Map<'b, 'a> when 'b: comparison val ofList: l: (string * 'T) list -> NameMap<'T> @@ -612,7 +610,6 @@ module internal MultiMap = type internal LayeredMap<'Key, 'Value when 'Key: comparison> = Map<'Key, 'Value> - [] module internal MapAutoOpens = type internal Map<'Key, 'Value when 'Key: comparison> with @@ -623,7 +620,7 @@ module internal MapAutoOpens = member Values: 'Value list #endif - member AddMany: kvs: KeyValuePair<'Key, 'Value> [] -> Map<'Key, 'Value> when 'Key: comparison + member AddMany: kvs: KeyValuePair<'Key, 'Value>[] -> Map<'Key, 'Value> when 'Key: comparison member AddOrModify: key: 'Key * f: ('Value option -> 'Value) -> Map<'Key, 'Value> when 'Key: comparison @@ -635,7 +632,7 @@ type internal LayeredMultiMap<'Key, 'Value when 'Key: comparison> = member Add: k: 'Key * v: 'Value -> LayeredMultiMap<'Key, 'Value> - member AddMany: kvs: KeyValuePair<'Key, 'Value> [] -> LayeredMultiMap<'Key, 'Value> + member AddMany: kvs: KeyValuePair<'Key, 'Value>[] -> LayeredMultiMap<'Key, 'Value> member TryFind: k: 'Key -> 'Value list option diff --git a/src/Compiler/Utilities/lib.fsi b/src/Compiler/Utilities/lib.fsi index 74be4d2ace9..585d4a5911f 100644 --- a/src/Compiler/Utilities/lib.fsi +++ b/src/Compiler/Utilities/lib.fsi @@ -74,7 +74,7 @@ module Check = /// Throw System.ArgumentNullException if array argument is null. /// Throw System.ArgumentOutOfRangeException is array argument is empty. - val ArrayArgumentNotNullOrEmpty: arr: 'T [] -> argName: string -> unit + val ArrayArgumentNotNullOrEmpty: arr: 'T[] -> argName: string -> unit /// Throw System.ArgumentNullException if string argument is null. /// Throw System.ArgumentOutOfRangeException is string argument is empty. @@ -315,6 +315,6 @@ type DisposablesTracker = [] module ArrayParallel = - val inline map: ('T -> 'U) -> 'T [] -> 'U [] + val inline map: ('T -> 'U) -> 'T[] -> 'U[] - val inline mapi: (int -> 'T -> 'U) -> 'T [] -> 'U [] + val inline mapi: (int -> 'T -> 'U) -> 'T[] -> 'U[] diff --git a/src/Compiler/Utilities/sformat.fsi b/src/Compiler/Utilities/sformat.fsi index 264c33d8f6e..41f57bc700f 100644 --- a/src/Compiler/Utilities/sformat.fsi +++ b/src/Compiler/Utilities/sformat.fsi @@ -96,7 +96,7 @@ type internal Layout = static member internal JuxtapositionMiddle: left: Layout * right: Layout -> bool -#else // FSharp.Compiler.Service.dll, fsc.exe +#else /// Data representing structured layouts of terms. type internal Layout diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 7706a8b7b7f..b44dd35ecac 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -4193,12 +4193,14 @@ declExpr: dynamicArg: | IDENT - { let con = SynConst.String ($1, SynStringKind.Regular, rhs parseState 1) - let arg2 = SynExpr.Const (con, con.Range (rhs parseState 1)) - arg2 } + { let m = rhs parseState 1 + SynExpr.Ident(Ident($1, m)) } | LPAREN typedSequentialExpr rparen - { $2 } + { let lpr = rhs parseState 1 + let rpr = rhs parseState 3 + let m = unionRanges lpr rpr + SynExpr.Paren($2, lpr, Some rpr, m) } withClauses: | WITH withPatternClauses @@ -4467,8 +4469,10 @@ atomicExpr: SynExpr.LongIdent (true, SynLongIdent([ident], [], [trivia]), None, rhs parseState 2), false } | atomicExpr QMARK dynamicArg - { let arg1, hpa1 = $1 - mkSynInfix (rhs parseState 2) arg1 "?" $3, hpa1 } + { let m = rhs2 parseState 1 3 + let mQmark = rhs parseState 2 + let arg1, hpa1 = $1 + SynExpr.Dynamic(arg1, mQmark, $3, m), hpa1 } | GLOBAL { let m = rhs parseState 1 diff --git a/src/FSharp.Build/CreateFSharpManifestResourceName.fs b/src/FSharp.Build/CreateFSharpManifestResourceName.fs index b377442c62b..175a76d2030 100644 --- a/src/FSharp.Build/CreateFSharpManifestResourceName.fs +++ b/src/FSharp.Build/CreateFSharpManifestResourceName.fs @@ -4,9 +4,7 @@ namespace FSharp.Build open System open System.IO -open System.Text open Microsoft.Build.Tasks -open Microsoft.Build.Utilities type CreateFSharpManifestResourceName public () = inherit CreateCSharpManifestResourceName() @@ -14,12 +12,14 @@ type CreateFSharpManifestResourceName public () = // When set to true, generate resource names in the same way as C# with root namespace and folder names member val UseStandardResourceNames = false with get, set - override this.CreateManifestName - ((fileName:string), - (linkFileName:string), - (rootNamespace:string), (* may be null *) - (dependentUponFileName:string), (* may be null *) - (binaryStream:System.IO.Stream) (* may be null *)) : string = + override this.CreateManifestName + ( + fileName: string, + linkFileName: string, + rootNamespace: string, // may be null + dependentUponFileName: string, // may be null + binaryStream: Stream // may be null + ) : string = // The Visual CSharp and XBuild CSharp toolchains transform resource names like this: // SubDir\abc.resx --> SubDir.abc.resources @@ -30,37 +30,56 @@ type CreateFSharpManifestResourceName public () = let fileName, linkFileName, rootNamespace = match this.UseStandardResourceNames with - | true -> - fileName, linkFileName, rootNamespace + | true -> fileName, linkFileName, rootNamespace | false -> - let runningOnMono = + let runningOnMono = try System.Type.GetType("Mono.Runtime") <> null - with e -> - false - let fileName = if not runningOnMono || fileName.EndsWith(".resources", StringComparison.OrdinalIgnoreCase) then fileName else Path.GetFileName(fileName) - let linkFileName = if not runningOnMono || linkFileName.EndsWith(".resources", StringComparison.OrdinalIgnoreCase) then linkFileName else Path.GetFileName(linkFileName) - fileName, linkFileName, "" + with + | e -> false - let embeddedFileName = + let fileName = + if + not runningOnMono + || fileName.EndsWith(".resources", StringComparison.OrdinalIgnoreCase) + then + fileName + else + Path.GetFileName(fileName) + + let linkFileName = + if + not runningOnMono + || linkFileName.EndsWith(".resources", StringComparison.OrdinalIgnoreCase) + then + linkFileName + else + Path.GetFileName(linkFileName) + + fileName, linkFileName, "" + + let embeddedFileName = match linkFileName with - | null -> fileName - | _ -> linkFileName + | null -> fileName + | _ -> linkFileName - // since we do not support resources dependent on a form, we always pass null for a binary stream - let cSharpResult = + // since we do not support resources dependent on a form, we always pass null for a binary stream + let cSharpResult = base.CreateManifestName(fileName, linkFileName, rootNamespace, dependentUponFileName, null) // Workaround that makes us keep .resources extension on both 3.5 and 3.5SP1 // 3.5 stripped ".resources", 3.5 SP1 does not. We should do 3.5SP1 thing let extensionToWorkaround = ".resources" - if embeddedFileName.EndsWith(extensionToWorkaround, StringComparison.OrdinalIgnoreCase) - && not (cSharpResult.EndsWith(extensionToWorkaround, StringComparison.OrdinalIgnoreCase)) then + + if + embeddedFileName.EndsWith(extensionToWorkaround, StringComparison.OrdinalIgnoreCase) + && not (cSharpResult.EndsWith(extensionToWorkaround, StringComparison.OrdinalIgnoreCase)) + then cSharpResult + extensionToWorkaround else cSharpResult - - - override _.IsSourceFile (fileName: string) = + + override _.IsSourceFile(fileName: string) = let extension = Path.GetExtension(fileName) - (String.Equals(extension, ".fs", StringComparison.OrdinalIgnoreCase) || - String.Equals(extension, ".ml", StringComparison.OrdinalIgnoreCase)) \ No newline at end of file + + (String.Equals(extension, ".fs", StringComparison.OrdinalIgnoreCase) + || String.Equals(extension, ".ml", StringComparison.OrdinalIgnoreCase)) diff --git a/src/FSharp.Build/FSharp.Build.fsproj b/src/FSharp.Build/FSharp.Build.fsproj index ab6fa250e78..f293b92a05f 100644 --- a/src/FSharp.Build/FSharp.Build.fsproj +++ b/src/FSharp.Build/FSharp.Build.fsproj @@ -19,7 +19,7 @@ - + diff --git a/src/FSharp.Build/FSharpCommandLineBuilder.fs b/src/FSharp.Build/FSharpCommandLineBuilder.fs index 2fd7dfa1d06..bf86d185edc 100644 --- a/src/FSharp.Build/FSharpCommandLineBuilder.fs +++ b/src/FSharp.Build/FSharpCommandLineBuilder.fs @@ -10,20 +10,23 @@ open Internal.Utilities [] [] -do() +do () // Shim to match nullness checking library support in preview [] -module Utils = +module Utils = /// Match on the nullness of an argument. - let inline (|Null|NonNull|) (x: 'T) : Choice = match x with null -> Null | v -> NonNull v + let inline (|Null|NonNull|) (x: 'T) : Choice = + match x with + | null -> Null + | v -> NonNull v /// Indicates that a type may be null. 'MaybeNull' used internally in the F# compiler as unchecked /// replacement for 'string?' for example for future FS-1060. - type 'T MaybeNull when 'T : null and 'T: not struct = 'T + type 'T MaybeNull when 'T: null and 'T: not struct = 'T -type FSharpCommandLineBuilder () = +type FSharpCommandLineBuilder() = // In addition to generating a command-line that will be handed to cmd.exe, we also generate // an array of individual arguments. The former needs to be quoted (and cmd.exe will strip the @@ -31,8 +34,8 @@ type FSharpCommandLineBuilder () = // class gets us out of the business of unparsing-then-reparsing arguments. let builder = new CommandLineBuilder() - let mutable args = [] // in reverse order - let mutable srcs = [] // in reverse order + let mutable args = [] // in reverse order + let mutable srcs = [] // in reverse order /// Return a list of the arguments (with no quoting for the cmd.exe shell) member _.CapturedArguments() = List.rev args @@ -48,8 +51,9 @@ type FSharpCommandLineBuilder () = // do not update "args", not used for item in filenames do let tmp = new CommandLineBuilder() - tmp.AppendSwitchUnquotedIfNotNull("", item.ItemSpec) // we don't want to quote the file name, this is a way to get that + tmp.AppendSwitchUnquotedIfNotNull("", item.ItemSpec) // we don't want to quote the file name, this is a way to get that let s = tmp.ToString() + if s <> String.Empty then srcs <- tmp.ToString() :: srcs @@ -58,6 +62,7 @@ type FSharpCommandLineBuilder () = let tmp = new CommandLineBuilder() tmp.AppendSwitchUnquotedIfNotNull(switch, values, sep) let s = tmp.ToString() + if s <> String.Empty then args <- s :: args @@ -66,43 +71,57 @@ type FSharpCommandLineBuilder () = builder.AppendSwitchIfNotNull(switch, value) let tmp = new CommandLineBuilder() tmp.AppendSwitchUnquotedIfNotNull(switch, value) + let providedMetaData = - metadataNames - |> Array.filter (String.IsNullOrWhiteSpace >> not) + metadataNames |> Array.filter (String.IsNullOrWhiteSpace >> not) + if providedMetaData.Length > 0 then tmp.AppendTextUnquoted "," - tmp.AppendTextUnquoted (providedMetaData|> String.concat ",") + tmp.AppendTextUnquoted(providedMetaData |> String.concat ",") + let s = tmp.ToString() + if s <> String.Empty then args <- s :: args member _.AppendSwitchUnquotedIfNotNull(switch: string, value: string MaybeNull) = - assert(switch = "") // we only call this method for "OtherFlags" + assert (switch = "") // we only call this method for "OtherFlags" // Unfortunately we still need to mimic what cmd.exe does, but only for "OtherFlags". - let ParseCommandLineArgs(commandLine: string) = // returns list in reverse order + let ParseCommandLineArgs (commandLine: string) = // returns list in reverse order let mutable args = [] let mutable i = 0 // index into commandLine let len = commandLine.Length + while i < len do // skip whitespace while i < len && System.Char.IsWhiteSpace(commandLine, i) do i <- i + 1 + if i < len then // parse an argument let sb = new StringBuilder() let mutable finished = false let mutable insideQuote = false + while i < len && not finished do match commandLine.[i] with - | '"' -> insideQuote <- not insideQuote; i <- i + 1 + | '"' -> + insideQuote <- not insideQuote + i <- i + 1 | c when not insideQuote && System.Char.IsWhiteSpace(c) -> finished <- true - | c -> sb.Append(c) |> ignore; i <- i + 1 + | c -> + sb.Append(c) |> ignore + i <- i + 1 + args <- sb.ToString() :: args + args + builder.AppendSwitchUnquotedIfNotNull(switch, value) let tmp = new CommandLineBuilder() tmp.AppendSwitchUnquotedIfNotNull(switch, value) let s = tmp.ToString() + if s <> String.Empty then args <- ParseCommandLineArgs(s) @ args @@ -110,8 +129,5 @@ type FSharpCommandLineBuilder () = builder.AppendSwitch(switch) args <- switch :: args - member internal x.GetCapturedArguments() = - [| - yield! x.CapturedArguments() - yield! x.CapturedFilenames() - |] + member internal x.GetCapturedArguments() = + [| yield! x.CapturedArguments(); yield! x.CapturedFilenames() |] diff --git a/src/FSharp.Build/FSharpEmbedResXSource.fs b/src/FSharp.Build/FSharpEmbedResXSource.fs index fc8b9167d38..24665c44f58 100644 --- a/src/FSharp.Build/FSharpEmbedResXSource.fs +++ b/src/FSharp.Build/FSharpEmbedResXSource.fs @@ -3,8 +3,6 @@ namespace FSharp.Build open System -open System.Collections -open System.Globalization open System.IO open System.Linq open System.Text @@ -20,7 +18,8 @@ type FSharpEmbedResXSource() = let mutable _outputPath: string = "" let mutable _targetFramework: string = "" - let boilerplate = @"// + let boilerplate = + @"// namespace {0} @@ -32,95 +31,128 @@ module internal {1} = let ResourceManager = new System.Resources.ResourceManager(""{2}"", C(0).GetType().GetTypeInfo().Assembly) let GetString(name:System.String) : System.String = ResourceManager.GetString(name, Culture)" - let boilerplateGetObject = " let GetObject(name:System.String) : System.Object = ResourceManager.GetObject(name, Culture)" + let boilerplateGetObject = + " let GetObject(name:System.String) : System.Object = ResourceManager.GetObject(name, Culture)" - let generateSource (resx:string) (fullModuleName:string) (generateLegacy:bool) (generateLiteral:bool) = + let generateSource (resx: string) (fullModuleName: string) (generateLegacy: bool) (generateLiteral: bool) = try let printMessage = printfn "FSharpEmbedResXSource: %s" let justFileName = Path.GetFileNameWithoutExtension(resx) let sourcePath = Path.Combine(_outputPath, justFileName + ".fs") // simple up-to-date check - if File.Exists(resx) && File.Exists(sourcePath) && - File.GetLastWriteTimeUtc(resx) <= File.GetLastWriteTimeUtc(sourcePath) then + if File.Exists(resx) + && File.Exists(sourcePath) + && File.GetLastWriteTimeUtc(resx) <= File.GetLastWriteTimeUtc(sourcePath) then printMessage (sprintf "Skipping generation: '%s' since it is up-to-date." sourcePath) Some(sourcePath) else let namespaceName, moduleName = let parts = fullModuleName.Split('.') - if parts.Length = 1 then ("global", parts.[0]) - else (String.Join(".", parts, 0, parts.Length - 1), parts.[parts.Length - 1]) - let generateGetObject = not (_targetFramework.StartsWith("netstandard1.") || _targetFramework.StartsWith("netcoreapp1.")) + + if parts.Length = 1 then + ("global", parts.[0]) + else + (String.Join(".", parts, 0, parts.Length - 1), parts.[parts.Length - 1]) + + let generateGetObject = + not ( + _targetFramework.StartsWith("netstandard1.") + || _targetFramework.StartsWith("netcoreapp1.") + ) + printMessage (sprintf "Generating code for target framework %s" _targetFramework) - let sb = StringBuilder().AppendLine(String.Format(boilerplate, namespaceName, moduleName, justFileName)) - if generateGetObject then sb.AppendLine(boilerplateGetObject) |> ignore + + let sb = + StringBuilder() + .AppendLine(String.Format(boilerplate, namespaceName, moduleName, justFileName)) + + if generateGetObject then + sb.AppendLine(boilerplateGetObject) |> ignore + printMessage <| sprintf "Generating: %s" sourcePath + let body = let xname = XName.op_Implicit + XDocument.Load(resx).Descendants(xname "data") - |> Seq.fold (fun (sb:StringBuilder) (node:XElement) -> - let name = - match node.Attribute(xname "name") with - | null -> failwith (sprintf "Missing resource name on element '%s'" (node.ToString())) - | attr -> attr.Value - let docComment = - match node.Elements(xname "value").FirstOrDefault() with - | null -> failwith <| sprintf "Missing resource value for '%s'" name - | element -> element.Value.Trim() - let identifier = if Char.IsLetter(name.[0]) || name.[0] = '_' then name else "_" + name - let commentBody = - XElement(xname "summary", docComment).ToString().Split([|"\r\n"; "\r"; "\n"|], StringSplitOptions.None) - |> Array.fold (fun (sb:StringBuilder) line -> sb.AppendLine(" /// " + line)) (StringBuilder()) - // add the resource - let accessorBody = - match (generateLegacy, generateLiteral) with - | (true, true) -> sprintf " []\n let %s = \"%s\"" identifier name - | (true, false) -> sprintf " let %s = \"%s\"" identifier name // the [] attribute can't be used for FSharp.Core - | (false, _) -> - let isStringResource = node.Attribute(xname "type") |> isNull - match (isStringResource, generateGetObject) with - | (true, _) -> sprintf " let %s() = GetString(\"%s\")" identifier name - | (false, true) -> sprintf " let %s() = GetObject(\"%s\")" identifier name - | (false, false) -> "" // the target runtime doesn't support non-string resources - // TODO: When calling the `GetObject` version, parse the `type` attribute to discover the proper return type - sb.AppendLine().Append(commentBody).AppendLine(accessorBody) - ) sb + |> Seq.fold + (fun (sb: StringBuilder) (node: XElement) -> + let name = + match node.Attribute(xname "name") with + | null -> failwith (sprintf "Missing resource name on element '%s'" (node.ToString())) + | attr -> attr.Value + + let docComment = + match node.Elements(xname "value").FirstOrDefault() with + | null -> failwith <| sprintf "Missing resource value for '%s'" name + | element -> element.Value.Trim() + + let identifier = + if Char.IsLetter(name.[0]) || name.[0] = '_' then + name + else + "_" + name + + let commentBody = + XElement(xname "summary", docComment) + .ToString() + .Split([| "\r\n"; "\r"; "\n" |], StringSplitOptions.None) + |> Array.fold + (fun (sb: StringBuilder) line -> sb.AppendLine(" /// " + line)) + (StringBuilder()) + // add the resource + let accessorBody = + match (generateLegacy, generateLiteral) with + | (true, true) -> sprintf " []\n let %s = \"%s\"" identifier name + | (true, false) -> sprintf " let %s = \"%s\"" identifier name // the [] attribute can't be used for FSharp.Core + | (false, _) -> + let isStringResource = node.Attribute(xname "type") |> isNull + + match (isStringResource, generateGetObject) with + | (true, _) -> sprintf " let %s() = GetString(\"%s\")" identifier name + | (false, true) -> sprintf " let %s() = GetObject(\"%s\")" identifier name + | (false, false) -> "" // the target runtime doesn't support non-string resources + // TODO: When calling the `GetObject` version, parse the `type` attribute to discover the proper return type + sb.AppendLine().Append(commentBody).AppendLine(accessorBody)) + sb + 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 [] member _.EmbeddedResource - with get() = _embeddedText - and set(value) = _embeddedText <- value + with get () = _embeddedText + and set (value) = _embeddedText <- value [] member _.IntermediateOutputPath - with get() = _outputPath - and set(value) = _outputPath <- value + with get () = _outputPath + and set (value) = _outputPath <- value member _.TargetFramework - with get() = _targetFramework - and set(value) = _targetFramework <- value + with get () = _targetFramework + and set (value) = _targetFramework <- value [] - member _.GeneratedSource - with get() = _generatedSource + member _.GeneratedSource = _generatedSource interface ITask with member _.BuildEngine - with get() = _buildEngine - and set(value) = _buildEngine <- value + with get () = _buildEngine + and set (value) = _buildEngine <- value member _.HostObject - with get() = _hostObject - and set(value) = _hostObject <- value + with get () = _hostObject + and set (value) = _hostObject <- value member this.Execute() = - let getBooleanMetadata (metadataName:string) (defaultValue:bool) (item:ITaskItem) = + let getBooleanMetadata (metadataName: string) (defaultValue: bool) (item: ITaskItem) = match item.GetMetadata(metadataName) with | value when String.IsNullOrWhiteSpace(value) -> defaultValue | value -> @@ -128,19 +160,26 @@ module internal {1} = | "true" -> true | "false" -> false | _ -> failwith (sprintf "Expected boolean value for '%s' found '%s'" metadataName value) + let mutable success = true + let generatedSource = - [| for item in this.EmbeddedResource do - if getBooleanMetadata "GenerateSource" false item then - let moduleName = - match item.GetMetadata("GeneratedModuleName") with - | null | "" -> Path.GetFileNameWithoutExtension(item.ItemSpec) - | value -> value - let generateLegacy = getBooleanMetadata "GenerateLegacyCode" false item - let generateLiteral = getBooleanMetadata "GenerateLiterals" true item - match generateSource item.ItemSpec moduleName generateLegacy generateLiteral with - | Some (source) -> yield TaskItem(source) :> ITaskItem - | None -> success <- false + [| + for item in this.EmbeddedResource do + if getBooleanMetadata "GenerateSource" false item then + let moduleName = + match item.GetMetadata("GeneratedModuleName") with + | null + | "" -> Path.GetFileNameWithoutExtension(item.ItemSpec) + | value -> value + + let generateLegacy = getBooleanMetadata "GenerateLegacyCode" false item + let generateLiteral = getBooleanMetadata "GenerateLiterals" true item + + match generateSource item.ItemSpec moduleName generateLegacy generateLiteral with + | Some (source) -> yield TaskItem(source) :> ITaskItem + | None -> success <- false |] + _generatedSource <- generatedSource success diff --git a/src/FSharp.Build/FSharpEmbedResourceText.fs b/src/FSharp.Build/FSharpEmbedResourceText.fs index f43fef77a43..eb1907187a8 100644 --- a/src/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/FSharp.Build/FSharpEmbedResourceText.fs @@ -14,10 +14,10 @@ type FSharpEmbedResourceText() = let mutable _generatedResx: ITaskItem[] = [||] let mutable _outputPath: string = "" - let PrintErr(fileName, line, msg) = + let PrintErr (fileName, line, msg) = printfn "%s(%d): error : %s" fileName line msg - let Err(fileName, line, msg) = + let Err (fileName, line, msg) = PrintErr(fileName, line, msg) printfn "Note that the syntax of each line is one of these three alternatives:" printfn "# comment" @@ -25,7 +25,8 @@ type FSharpEmbedResourceText() = printfn "errNum,ident,\"string\"" failwith (sprintf "there were errors in the file '%s'" fileName) - let xmlBoilerPlateString = @" + let xmlBoilerPlateString = + @" 'length1' would shadow function in module of same name +#nowarn "3218" // mismatch of parameter name where 'count1' --> 'length1' would shadow function in module of same name - [] - [] - module Array2D = +[] +[] +module Array2D = - let inline checkNonNull argName arg = - if isNull arg then - nullArg argName + let inline checkNonNull argName arg = + if isNull arg then + nullArg argName - // Define the primitive operations. - // Note: the "type" syntax is for the type parameter for inline - // polymorphic IL. This helps the compiler inline these fragments, - // i.e. work out the correspondence between IL and F# type variables. + // Define the primitive operations. + // Note: the "type" syntax is for the type parameter for inline + // polymorphic IL. This helps the compiler inline these fragments, + // i.e. work out the correspondence between IL and F# type variables. - [] - let length1 (array: 'T[,]) = (# "ldlen.multi 2 0" array : int #) + [] + let length1 (array: 'T[,]) = (# "ldlen.multi 2 0" array : int #) - [] - let length2 (array: 'T[,]) = (# "ldlen.multi 2 1" array : int #) + [] + let length2 (array: 'T[,]) = (# "ldlen.multi 2 1" array : int #) - [] - let base1 (array: 'T[,]) = array.GetLowerBound(0) + [] + let base1 (array: 'T[,]) = array.GetLowerBound(0) - [] - let base2 (array: 'T[,]) = array.GetLowerBound(1) + [] + let base2 (array: 'T[,]) = array.GetLowerBound(1) - [] - let get (array: 'T[,]) (index1:int) (index2:int) = - (# "ldelem.multi 2 !0" type ('T) array index1 index2 : 'T #) + [] + let get (array: 'T[,]) (index1:int) (index2:int) = + (# "ldelem.multi 2 !0" type ('T) array index1 index2 : 'T #) - [] - let set (array: 'T[,]) (index1:int) (index2:int) (value:'T) = - (# "stelem.multi 2 !0" type ('T) array index1 index2 value #) + [] + let set (array: 'T[,]) (index1:int) (index2:int) (value:'T) = + (# "stelem.multi 2 !0" type ('T) array index1 index2 value #) - [] - let zeroCreate (length1: int) (length2: int) = - if length1 < 0 then invalidArgInputMustBeNonNegative "length1" length1 - if length2 < 0 then invalidArgInputMustBeNonNegative "length2" length2 - (# "newarr.multi 2 !0" type ('T) length1 length2 : 'T[,] #) + [] + let zeroCreate (length1: int) (length2: int) = + if length1 < 0 then invalidArgInputMustBeNonNegative "length1" length1 + if length2 < 0 then invalidArgInputMustBeNonNegative "length2" length2 + (# "newarr.multi 2 !0" type ('T) length1 length2 : 'T[,] #) - [] - let zeroCreateBased (base1:int) (base2:int) (length1:int) (length2:int) = - if base1 = 0 && base2 = 0 then + [] + let zeroCreateBased (base1:int) (base2:int) (length1:int) (length2:int) = + if base1 = 0 && base2 = 0 then #if NETSTANDARD - zeroCreate length1 length2 + zeroCreate length1 length2 #else - // Note: this overload is available on Compact Framework and Silverlight, but not Portable - (System.Array.CreateInstance(typeof<'T>, [|length1;length2|]) :?> 'T[,]) + // Note: this overload is available on Compact Framework and Silverlight, but not Portable + (System.Array.CreateInstance(typeof<'T>, [|length1;length2|]) :?> 'T[,]) #endif - else - (Array.CreateInstance(typeof<'T>, [|length1;length2|], [|base1;base2|]) :?> 'T[,]) - - [] - let createBased base1 base2 length1 length2 (initial:'T) = - let array = (zeroCreateBased base1 base2 length1 length2 : 'T[,]) - for i = base1 to base1 + length1 - 1 do - for j = base2 to base2 + length2 - 1 do - array.[i, j] <- initial - array - - [] - let initBased base1 base2 length1 length2 initializer = - let array = (zeroCreateBased base1 base2 length1 length2 : 'T[,]) - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(initializer) - for i = base1 to base1 + length1 - 1 do - for j = base2 to base2 + length2 - 1 do - array.[i, j] <- f.Invoke(i, j) - array - - [] - let create length1 length2 (value:'T) = - createBased 0 0 length1 length2 value - - [] - let init length1 length2 initializer = - initBased 0 0 length1 length2 initializer - - [] - let iter action array = - checkNonNull "array" array - let count1 = length1 array - let count2 = length2 array - let b1 = base1 array - let b2 = base2 array - for i = b1 to b1 + count1 - 1 do - for j = b2 to b2 + count2 - 1 do - action array.[i, j] - - [] - let iteri (action : int -> int -> 'T -> unit) (array:'T[,]) = - checkNonNull "array" array - let count1 = length1 array - let count2 = length2 array - let b1 = base1 array - let b2 = base2 array - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(action) - for i = b1 to b1 + count1 - 1 do - for j = b2 to b2 + count2 - 1 do - f.Invoke(i, j, array.[i, j]) - - [] - let map mapping array = - checkNonNull "array" array - initBased (base1 array) (base2 array) (length1 array) (length2 array) (fun i j -> mapping array.[i,j]) - - [] - let mapi mapping array = - checkNonNull "array" array - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(mapping) - initBased (base1 array) (base2 array) (length1 array) (length2 array) (fun i j -> f.Invoke(i, j, array.[i,j])) - - [] - let copy array = - checkNonNull "array" array - initBased (base1 array) (base2 array) (length1 array) (length2 array) (fun i j -> array.[i,j]) - - [] - let rebase array = - checkNonNull "array" array - let b1 = base1 array - let b2 = base2 array - init (length1 array) (length2 array) (fun i j -> array.[b1 + i, b2 + j]) - - [] - let blit (source : 'T[,]) sourceIndex1 sourceIndex2 (target: 'T[,]) targetIndex1 targetIndex2 count1 count2 = - checkNonNull "source" source - checkNonNull "target" target - - let sourceX0, sourceY0 = source.GetLowerBound 0, source.GetLowerBound 1 - let sourceXN, sourceYN = (length1 source) + sourceX0, (length2 source) + sourceY0 - let targetX0, targetY0 = target.GetLowerBound 0, target.GetLowerBound 1 - let targetXN, targetYN = (length1 target) + targetX0, (length2 target) + targetY0 - - if sourceIndex1 < sourceX0 then invalidArgOutOfRange "sourceIndex1" sourceIndex1 "source axis-0 lower bound" sourceX0 - if sourceIndex2 < sourceY0 then invalidArgOutOfRange "sourceIndex2" sourceIndex2 "source axis-1 lower bound" sourceY0 - if targetIndex1 < targetX0 then invalidArgOutOfRange "targetIndex1" targetIndex1 "target axis-0 lower bound" targetX0 - if targetIndex2 < targetY0 then invalidArgOutOfRange "targetIndex2" targetIndex2 "target axis-1 lower bound" targetY0 - if sourceIndex1 + count1 > sourceXN then - invalidArgOutOfRange "count1" count1 ("source axis-0 end index = " + string(sourceIndex1 + count1) + " source axis-0 upper bound") sourceXN - if sourceIndex2 + count2 > sourceYN then - invalidArgOutOfRange "count2" count2 ("source axis-1 end index = " + string(sourceIndex2 + count2) + " source axis-1 upper bound") sourceYN - if targetIndex1 + count1 > targetXN then - invalidArgOutOfRange "count1" count1 ("target axis-0 end index = " + string(targetIndex1 + count1) + " target axis-0 upper bound") targetXN - if targetIndex2 + count2 > targetYN then - invalidArgOutOfRange "count2" count2 ("target axis-1 end index = " + string(targetIndex2 + count2) + " target axis-1 upper bound") targetYN - - for i = 0 to count1 - 1 do - for j = 0 to count2 - 1 do - target.[targetIndex1 + i, targetIndex2 + j] <- source.[sourceIndex1 + i, sourceIndex2 + j] + else + (Array.CreateInstance(typeof<'T>, [|length1;length2|], [|base1;base2|]) :?> 'T[,]) + + [] + let createBased base1 base2 length1 length2 (initial:'T) = + let array = (zeroCreateBased base1 base2 length1 length2 : 'T[,]) + for i = base1 to base1 + length1 - 1 do + for j = base2 to base2 + length2 - 1 do + array.[i, j] <- initial + array + + [] + let initBased base1 base2 length1 length2 initializer = + let array = (zeroCreateBased base1 base2 length1 length2 : 'T[,]) + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(initializer) + for i = base1 to base1 + length1 - 1 do + for j = base2 to base2 + length2 - 1 do + array.[i, j] <- f.Invoke(i, j) + array + + [] + let create length1 length2 (value:'T) = + createBased 0 0 length1 length2 value + + [] + let init length1 length2 initializer = + initBased 0 0 length1 length2 initializer + + [] + let iter action array = + checkNonNull "array" array + let count1 = length1 array + let count2 = length2 array + let b1 = base1 array + let b2 = base2 array + for i = b1 to b1 + count1 - 1 do + for j = b2 to b2 + count2 - 1 do + action array.[i, j] + + [] + let iteri (action : int -> int -> 'T -> unit) (array:'T[,]) = + checkNonNull "array" array + let count1 = length1 array + let count2 = length2 array + let b1 = base1 array + let b2 = base2 array + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(action) + for i = b1 to b1 + count1 - 1 do + for j = b2 to b2 + count2 - 1 do + f.Invoke(i, j, array.[i, j]) + + [] + let map mapping array = + checkNonNull "array" array + initBased (base1 array) (base2 array) (length1 array) (length2 array) (fun i j -> mapping array.[i,j]) + + [] + let mapi mapping array = + checkNonNull "array" array + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(mapping) + initBased (base1 array) (base2 array) (length1 array) (length2 array) (fun i j -> f.Invoke(i, j, array.[i,j])) + + [] + let copy array = + checkNonNull "array" array + initBased (base1 array) (base2 array) (length1 array) (length2 array) (fun i j -> array.[i,j]) + + [] + let rebase array = + checkNonNull "array" array + let b1 = base1 array + let b2 = base2 array + init (length1 array) (length2 array) (fun i j -> array.[b1 + i, b2 + j]) + + [] + let blit (source : 'T[,]) sourceIndex1 sourceIndex2 (target: 'T[,]) targetIndex1 targetIndex2 count1 count2 = + checkNonNull "source" source + checkNonNull "target" target + + let sourceX0, sourceY0 = source.GetLowerBound 0, source.GetLowerBound 1 + let sourceXN, sourceYN = (length1 source) + sourceX0, (length2 source) + sourceY0 + let targetX0, targetY0 = target.GetLowerBound 0, target.GetLowerBound 1 + let targetXN, targetYN = (length1 target) + targetX0, (length2 target) + targetY0 + + if sourceIndex1 < sourceX0 then invalidArgOutOfRange "sourceIndex1" sourceIndex1 "source axis-0 lower bound" sourceX0 + if sourceIndex2 < sourceY0 then invalidArgOutOfRange "sourceIndex2" sourceIndex2 "source axis-1 lower bound" sourceY0 + if targetIndex1 < targetX0 then invalidArgOutOfRange "targetIndex1" targetIndex1 "target axis-0 lower bound" targetX0 + if targetIndex2 < targetY0 then invalidArgOutOfRange "targetIndex2" targetIndex2 "target axis-1 lower bound" targetY0 + if sourceIndex1 + count1 > sourceXN then + invalidArgOutOfRange "count1" count1 ("source axis-0 end index = " + string(sourceIndex1 + count1) + " source axis-0 upper bound") sourceXN + if sourceIndex2 + count2 > sourceYN then + invalidArgOutOfRange "count2" count2 ("source axis-1 end index = " + string(sourceIndex2 + count2) + " source axis-1 upper bound") sourceYN + if targetIndex1 + count1 > targetXN then + invalidArgOutOfRange "count1" count1 ("target axis-0 end index = " + string(targetIndex1 + count1) + " target axis-0 upper bound") targetXN + if targetIndex2 + count2 > targetYN then + invalidArgOutOfRange "count2" count2 ("target axis-1 end index = " + string(targetIndex2 + count2) + " target axis-1 upper bound") targetYN + + for i = 0 to count1 - 1 do + for j = 0 to count2 - 1 do + target.[targetIndex1 + i, targetIndex2 + j] <- source.[sourceIndex1 + i, sourceIndex2 + j] diff --git a/src/FSharp.Core/array2.fsi b/src/FSharp.Core/array2.fsi index e471ab252dd..6867ea5884a 100644 --- a/src/FSharp.Core/array2.fsi +++ b/src/FSharp.Core/array2.fsi @@ -42,7 +42,7 @@ module Array2D = /// Evaluates to 1. /// [] - val base1: array: 'T [,] -> int + val base1: array: 'T[,] -> int /// Fetches the base-index for the second dimension of the array. /// @@ -61,7 +61,7 @@ module Array2D = /// Evaluates to 1. /// [] - val base2: array: 'T [,] -> int + val base2: array: 'T[,] -> int /// Builds a new array whose elements are the same as the input array. /// @@ -83,7 +83,7 @@ module Array2D = /// Evaluates to a new copy of the 10x10 array. /// [] - val copy: array: 'T [,] -> 'T [,] + val copy: array: 'T[,] -> 'T[,] /// Reads a range of elements from the first array and write them into the second. /// @@ -118,10 +118,10 @@ module Array2D = /// [] val blit: - source: 'T [,] -> + source: 'T[,] -> sourceIndex1: int -> sourceIndex2: int -> - target: 'T [,] -> + target: 'T[,] -> targetIndex1: int -> targetIndex2: int -> length1: int -> @@ -145,7 +145,7 @@ module Array2D = /// /// [] - val init: length1: int -> length2: int -> initializer: (int -> int -> 'T) -> 'T [,] + val init: length1: int -> length2: int -> initializer: (int -> int -> 'T) -> 'T[,] /// Creates an array whose elements are all initially the given value. /// @@ -164,7 +164,7 @@ module Array2D = /// /// [] - val create: length1: int -> length2: int -> value: 'T -> 'T [,] + val create: length1: int -> length2: int -> value: 'T -> 'T[,] /// Creates an array where the entries are initially Unchecked.defaultof<'T>. /// @@ -182,7 +182,7 @@ module Array2D = /// /// [] - val zeroCreate: length1: int -> length2: int -> 'T [,] + val zeroCreate: length1: int -> length2: int -> 'T[,] /// Creates a based array given the dimensions and a generator function to compute the elements. /// @@ -203,7 +203,7 @@ module Array2D = /// /// [] - val initBased: base1: int -> base2: int -> length1: int -> length2: int -> initializer: (int -> int -> 'T) -> 'T [,] + val initBased: base1: int -> base2: int -> length1: int -> length2: int -> initializer: (int -> int -> 'T) -> 'T[,] /// Creates a based array whose elements are all initially the given value. /// @@ -224,7 +224,7 @@ module Array2D = /// /// [] - val createBased: base1: int -> base2: int -> length1: int -> length2: int -> initial: 'T -> 'T [,] + val createBased: base1: int -> base2: int -> length1: int -> length2: int -> initial: 'T -> 'T[,] /// Creates a based array where the entries are initially Unchecked.defaultof<'T>. /// @@ -244,7 +244,7 @@ module Array2D = /// /// [] - val zeroCreateBased: base1: int -> base2: int -> length1: int -> length2: int -> 'T [,] + val zeroCreateBased: base1: int -> base2: int -> length1: int -> length2: int -> 'T[,] /// Applies the given function to each element of the array. /// @@ -267,7 +267,7 @@ module Array2D = /// in the console. /// [] - val iter: action: ('T -> unit) -> array: 'T [,] -> unit + val iter: action: ('T -> unit) -> array: 'T[,] -> unit /// Applies the given function to each element of the array. The integer indices passed to the /// function indicates the index of element. @@ -291,7 +291,7 @@ module Array2D = /// in the console. /// [] - val iteri: action: (int -> int -> 'T -> unit) -> array: 'T [,] -> unit + val iteri: action: (int -> int -> 'T -> unit) -> array: 'T[,] -> unit /// Returns the length of an array in the first dimension. /// @@ -308,7 +308,7 @@ module Array2D = /// Evaluates to 2. /// [] - val length1: array: 'T [,] -> int + val length1: array: 'T[,] -> int /// Returns the length of an array in the second dimension. /// @@ -325,7 +325,7 @@ module Array2D = /// Evaluates to 3. /// [] - val length2: array: 'T [,] -> int + val length2: array: 'T[,] -> int /// Builds a new array whose elements are the results of applying the given function /// to each of the elements of the array. @@ -347,7 +347,7 @@ module Array2D = /// Evaluates to a 2x2 array with contents [[6; 8;]; [26; 28]] /// [] - val map: mapping: ('T -> 'U) -> array: 'T [,] -> 'U [,] + val map: mapping: ('T -> 'U) -> array: 'T[,] -> 'U[,] /// Builds a new array whose elements are the results of applying the given function /// to each of the elements of the array. The integer indices passed to the @@ -371,7 +371,7 @@ module Array2D = /// Evaluates to a 2x2 array with contents [[3; 5;]; [14; 16]] /// [] - val mapi: mapping: (int -> int -> 'T -> 'U) -> array: 'T [,] -> 'U [,] + val mapi: mapping: (int -> int -> 'T -> 'U) -> array: 'T[,] -> 'U[,] /// Builds a new array whose elements are the same as the input array but /// where a non-zero-based input array generates a corresponding zero-based @@ -390,7 +390,7 @@ module Array2D = /// Evaluates to a 2x2 zero-based array with contents [[1; 1]; [1; 1]] /// [] - val rebase: array: 'T [,] -> 'T [,] + val rebase: array: 'T[,] -> 'T[,] /// Sets the value of an element in an array. You can also use the syntax array.[index1,index2] <- value. /// @@ -419,7 +419,7 @@ module Array2D = /// After evaluation array is a 2x2 array with contents [[0.0; 4.0]; [0.0; 0.0]] /// [] - val set: array: 'T [,] -> index1: int -> index2: int -> value: 'T -> unit + val set: array: 'T[,] -> index1: int -> index2: int -> value: 'T -> unit /// Fetches an element from a 2D array. You can also use the syntax array.[index1,index2]. /// @@ -449,4 +449,4 @@ module Array2D = /// Evaluates to 2.0. /// [] - val get: array: 'T [,] -> index1: int -> index2: int -> 'T + val get: array: 'T[,] -> index1: int -> index2: int -> 'T diff --git a/src/FSharp.Core/array3.fs b/src/FSharp.Core/array3.fs index 6af3a650cf3..c92e46b8e57 100644 --- a/src/FSharp.Core/array3.fs +++ b/src/FSharp.Core/array3.fs @@ -2,159 +2,158 @@ namespace Microsoft.FSharp.Collections - open System.Diagnostics - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.Operators.Checked - - [] - [] - module Array3D = - - let inline checkNonNull argName arg = - if isNull arg then - nullArg argName - - [] - let length1 (array: 'T[,,]) = (# "ldlen.multi 3 0" array : int #) - - [] - let length2 (array: 'T[,,]) = (# "ldlen.multi 3 1" array : int #) - - [] - let length3 (array: 'T[,,]) = (# "ldlen.multi 3 2" array : int #) - - [] - let get (array: 'T[,,]) index1 index2 index3 = array.[index1,index2,index3] - - [] - let set (array: 'T[,,]) index1 index2 index3 value = array.[index1,index2,index3] <- value - - [] - let zeroCreate length1 length2 length3 = - if length1 < 0 then invalidArgInputMustBeNonNegative "n1" length1 - if length2 < 0 then invalidArgInputMustBeNonNegative "n2" length2 - if length3 < 0 then invalidArgInputMustBeNonNegative "n3" length3 - (# "newarr.multi 3 !0" type ('T) length1 length2 length3 : 'T[,,] #) - - [] - let create length1 length2 length3 (initial:'T) = - let arr = (zeroCreate length1 length2 length3 : 'T[,,]) - for i = 0 to length1 - 1 do - for j = 0 to length2 - 1 do - for k = 0 to length3 - 1 do - arr.[i,j,k] <- initial - arr - - [] - let init length1 length2 length3 initializer = - let arr = (zeroCreate length1 length2 length3 : 'T[,,]) - let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(initializer) - for i = 0 to length1 - 1 do - for j = 0 to length2 - 1 do - for k = 0 to length3 - 1 do - arr.[i,j,k] <- f.Invoke(i, j, k) - arr - - [] - let iter action array = - checkNonNull "array" array - let len1 = length1 array - let len2 = length2 array - let len3 = length3 array - for i = 0 to len1 - 1 do - for j = 0 to len2 - 1 do - for k = 0 to len3 - 1 do - action array.[i,j,k] - - [] - let map mapping array = - checkNonNull "array" array - let len1 = length1 array - let len2 = length2 array - let len3 = length3 array - let res = (zeroCreate len1 len2 len3 : 'b[,,]) - for i = 0 to len1 - 1 do - for j = 0 to len2 - 1 do - for k = 0 to len3 - 1 do - res.[i,j,k] <- mapping array.[i,j,k] - res - - [] - let iteri action array = - checkNonNull "array" array - let len1 = length1 array - let len2 = length2 array - let len3 = length3 array - let f = OptimizedClosures.FSharpFunc<_,_,_,_,_>.Adapt(action) - for i = 0 to len1 - 1 do - for j = 0 to len2 - 1 do - for k = 0 to len3 - 1 do - f.Invoke(i, j, k, array.[i,j,k]) - - [] - let mapi mapping array = - checkNonNull "array" array - let len1 = length1 array - let len2 = length2 array - let len3 = length3 array - let res = (zeroCreate len1 len2 len3 : 'b[,,]) - let f = OptimizedClosures.FSharpFunc<_,_,_,_,_>.Adapt(mapping) - for i = 0 to len1 - 1 do - for j = 0 to len2 - 1 do - for k = 0 to len3 - 1 do - res.[i,j,k] <- f.Invoke(i, j, k, array.[i,j,k]) - res - - [] - [] - module Array4D = - - [] - let length1 (array: 'T[,,,]) = (# "ldlen.multi 4 0" array : int #) - - [] - let length2 (array: 'T[,,,]) = (# "ldlen.multi 4 1" array : int #) - - [] - let length3 (array: 'T[,,,]) = (# "ldlen.multi 4 2" array : int #) - - [] - let length4 (array: 'T[,,,]) = (# "ldlen.multi 4 3" array : int #) - - [] - let zeroCreate length1 length2 length3 length4 = - if length1 < 0 then invalidArgInputMustBeNonNegative "n1" length1 - if length2 < 0 then invalidArgInputMustBeNonNegative "n2" length2 - if length3 < 0 then invalidArgInputMustBeNonNegative "n3" length3 - if length4 < 0 then invalidArgInputMustBeNonNegative "n4" length4 - (# "newarr.multi 4 !0" type ('T) length1 length2 length3 length4 : 'T[,,,] #) - - [] - let create length1 length2 length3 length4 (initial:'T) = - let arr = (zeroCreate length1 length2 length3 length4 : 'T[,,,]) - for i = 0 to length1 - 1 do - for j = 0 to length2 - 1 do - for k = 0 to length3 - 1 do - for m = 0 to length4 - 1 do - arr.[i,j,k,m] <- initial - arr - - [] - let init length1 length2 length3 length4 initializer = - let arr = (zeroCreate length1 length2 length3 length4 : 'T[,,,]) - let f = OptimizedClosures.FSharpFunc<_,_,_,_,_>.Adapt(initializer) - for i = 0 to length1 - 1 do - for j = 0 to length2 - 1 do - for k = 0 to length3 - 1 do - for m = 0 to length4 - 1 do - arr.[i,j,k,m] <- f.Invoke(i, j, k, m) - arr - - [] - let get (array: 'T[,,,]) index1 index2 index3 index4 = array.[index1,index2,index3,index4] - - [] - let set (array: 'T[,,,]) index1 index2 index3 index4 value = array.[index1,index2,index3,index4] <- value +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Core.Operators.Checked + +[] +[] +module Array3D = + + let inline checkNonNull argName arg = + if isNull arg then + nullArg argName + + [] + let length1 (array: 'T[,,]) = (# "ldlen.multi 3 0" array : int #) + + [] + let length2 (array: 'T[,,]) = (# "ldlen.multi 3 1" array : int #) + + [] + let length3 (array: 'T[,,]) = (# "ldlen.multi 3 2" array : int #) + + [] + let get (array: 'T[,,]) index1 index2 index3 = array.[index1,index2,index3] + + [] + let set (array: 'T[,,]) index1 index2 index3 value = array.[index1,index2,index3] <- value + + [] + let zeroCreate length1 length2 length3 = + if length1 < 0 then invalidArgInputMustBeNonNegative "n1" length1 + if length2 < 0 then invalidArgInputMustBeNonNegative "n2" length2 + if length3 < 0 then invalidArgInputMustBeNonNegative "n3" length3 + (# "newarr.multi 3 !0" type ('T) length1 length2 length3 : 'T[,,] #) + + [] + let create length1 length2 length3 (initial:'T) = + let arr = (zeroCreate length1 length2 length3 : 'T[,,]) + for i = 0 to length1 - 1 do + for j = 0 to length2 - 1 do + for k = 0 to length3 - 1 do + arr.[i,j,k] <- initial + arr + + [] + let init length1 length2 length3 initializer = + let arr = (zeroCreate length1 length2 length3 : 'T[,,]) + let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(initializer) + for i = 0 to length1 - 1 do + for j = 0 to length2 - 1 do + for k = 0 to length3 - 1 do + arr.[i,j,k] <- f.Invoke(i, j, k) + arr + + [] + let iter action array = + checkNonNull "array" array + let len1 = length1 array + let len2 = length2 array + let len3 = length3 array + for i = 0 to len1 - 1 do + for j = 0 to len2 - 1 do + for k = 0 to len3 - 1 do + action array.[i,j,k] + + [] + let map mapping array = + checkNonNull "array" array + let len1 = length1 array + let len2 = length2 array + let len3 = length3 array + let res = (zeroCreate len1 len2 len3 : 'b[,,]) + for i = 0 to len1 - 1 do + for j = 0 to len2 - 1 do + for k = 0 to len3 - 1 do + res.[i,j,k] <- mapping array.[i,j,k] + res + + [] + let iteri action array = + checkNonNull "array" array + let len1 = length1 array + let len2 = length2 array + let len3 = length3 array + let f = OptimizedClosures.FSharpFunc<_,_,_,_,_>.Adapt(action) + for i = 0 to len1 - 1 do + for j = 0 to len2 - 1 do + for k = 0 to len3 - 1 do + f.Invoke(i, j, k, array.[i,j,k]) + + [] + let mapi mapping array = + checkNonNull "array" array + let len1 = length1 array + let len2 = length2 array + let len3 = length3 array + let res = (zeroCreate len1 len2 len3 : 'b[,,]) + let f = OptimizedClosures.FSharpFunc<_,_,_,_,_>.Adapt(mapping) + for i = 0 to len1 - 1 do + for j = 0 to len2 - 1 do + for k = 0 to len3 - 1 do + res.[i,j,k] <- f.Invoke(i, j, k, array.[i,j,k]) + res + +[] +[] +module Array4D = + + [] + let length1 (array: 'T[,,,]) = (# "ldlen.multi 4 0" array : int #) + + [] + let length2 (array: 'T[,,,]) = (# "ldlen.multi 4 1" array : int #) + + [] + let length3 (array: 'T[,,,]) = (# "ldlen.multi 4 2" array : int #) + + [] + let length4 (array: 'T[,,,]) = (# "ldlen.multi 4 3" array : int #) + + [] + let zeroCreate length1 length2 length3 length4 = + if length1 < 0 then invalidArgInputMustBeNonNegative "n1" length1 + if length2 < 0 then invalidArgInputMustBeNonNegative "n2" length2 + if length3 < 0 then invalidArgInputMustBeNonNegative "n3" length3 + if length4 < 0 then invalidArgInputMustBeNonNegative "n4" length4 + (# "newarr.multi 4 !0" type ('T) length1 length2 length3 length4 : 'T[,,,] #) + + [] + let create length1 length2 length3 length4 (initial:'T) = + let arr = (zeroCreate length1 length2 length3 length4 : 'T[,,,]) + for i = 0 to length1 - 1 do + for j = 0 to length2 - 1 do + for k = 0 to length3 - 1 do + for m = 0 to length4 - 1 do + arr.[i,j,k,m] <- initial + arr + + [] + let init length1 length2 length3 length4 initializer = + let arr = (zeroCreate length1 length2 length3 length4 : 'T[,,,]) + let f = OptimizedClosures.FSharpFunc<_,_,_,_,_>.Adapt(initializer) + for i = 0 to length1 - 1 do + for j = 0 to length2 - 1 do + for k = 0 to length3 - 1 do + for m = 0 to length4 - 1 do + arr.[i,j,k,m] <- f.Invoke(i, j, k, m) + arr + + [] + let get (array: 'T[,,,]) index1 index2 index3 index4 = array.[index1,index2,index3,index4] + + [] + let set (array: 'T[,,,]) index1 index2 index3 index4 value = array.[index1,index2,index3,index4] <- value diff --git a/src/FSharp.Core/array3.fsi b/src/FSharp.Core/array3.fsi index 507b99ea659..e1f33dc9448 100644 --- a/src/FSharp.Core/array3.fsi +++ b/src/FSharp.Core/array3.fsi @@ -32,7 +32,7 @@ module Array3D = /// /// [] - val create: length1: int -> length2: int -> length3: int -> initial: 'T -> 'T [,,] + val create: length1: int -> length2: int -> length3: int -> initial: 'T -> 'T[,,] /// Creates an array given the dimensions and a generator function to compute the elements. /// @@ -50,7 +50,7 @@ module Array3D = /// Evaluates to a 2x2x3 array with contents [[[0; 1; 2]; [10; 11; 12]]; [[100; 101; 102]; [110; 111; 112]]] /// [] - val init: length1: int -> length2: int -> length3: int -> initializer: (int -> int -> int -> 'T) -> 'T [,,] + val init: length1: int -> length2: int -> length3: int -> initializer: (int -> int -> int -> 'T) -> 'T[,,] /// Fetches an element from a 3D array. You can also use the syntax 'array.[index1,index2,index3]' /// @@ -80,7 +80,7 @@ module Array3D = /// Evaluates to 21. /// [] - val get: array: 'T [,,] -> index1: int -> index2: int -> index3: int -> 'T + val get: array: 'T[,,] -> index1: int -> index2: int -> index3: int -> 'T /// Applies the given function to each element of the array. /// @@ -111,7 +111,7 @@ module Array3D = /// in the console. /// [] - val iter: action: ('T -> unit) -> array: 'T [,,] -> unit + val iter: action: ('T -> unit) -> array: 'T[,,] -> unit /// Applies the given function to each element of the array. The integer indices passed to the /// function indicates the index of element. @@ -143,7 +143,7 @@ module Array3D = /// in the console. /// [] - val iteri: action: (int -> int -> int -> 'T -> unit) -> array: 'T [,,] -> unit + val iteri: action: (int -> int -> int -> 'T -> unit) -> array: 'T[,,] -> unit /// Returns the length of an array in the first dimension /// @@ -160,7 +160,7 @@ module Array3D = /// Evaluates to 2. /// [] - val length1: array: 'T [,,] -> int + val length1: array: 'T[,,] -> int /// Returns the length of an array in the second dimension. /// @@ -177,7 +177,7 @@ module Array3D = /// Evaluates to 3. /// [] - val length2: array: 'T [,,] -> int + val length2: array: 'T[,,] -> int /// Returns the length of an array in the third dimension. /// @@ -194,7 +194,7 @@ module Array3D = /// Evaluates to 4. /// [] - val length3: array: 'T [,,] -> int + val length3: array: 'T[,,] -> int /// Builds a new array whose elements are the results of applying the given function /// to each of the elements of the array. @@ -215,7 +215,7 @@ module Array3D = /// Evaluates to a 2x3x3 array with contents [[[0; 2; 4]; [20; 22; 24]]; [[200; 202; 204]; [220; 222; 224]]] /// [] - val map: mapping: ('T -> 'U) -> array: 'T [,,] -> 'U [,,] + val map: mapping: ('T -> 'U) -> array: 'T[,,] -> 'U[,,] /// Builds a new array whose elements are the results of applying the given function /// to each of the elements of the array. The integer indices passed to the @@ -237,7 +237,7 @@ module Array3D = /// Evaluates to a 2x3x3 array with contents [[[0; 2; 4]; [20; 22; 24]]; [[200; 202; 204]; [220; 222; 224]]] /// [] - val mapi: mapping: (int -> int -> int -> 'T -> 'U) -> array: 'T [,,] -> 'U [,,] + val mapi: mapping: (int -> int -> int -> 'T -> 'U) -> array: 'T[,,] -> 'U[,,] /// Sets the value of an element in an array. You can also /// use the syntax 'array.[index1,index2,index3] <- value'. @@ -267,7 +267,7 @@ module Array3D = /// After evaluation array is a 2x3x3 array with contents [[[0.0; 0.0; 0.0]; [0.0; 4.0; 0.0]]; [[0.0; 0.0; 0.0]; [0.0; 0.0; 0.0]]] /// [] - val set: array: 'T [,,] -> index1: int -> index2: int -> index3: int -> value: 'T -> unit + val set: array: 'T[,,] -> index1: int -> index2: int -> index3: int -> value: 'T -> unit /// Creates an array where the entries are initially the "default" value. /// @@ -284,7 +284,7 @@ module Array3D = /// After evaluation array is a 2x3x3 array with contents all zero. /// [] - val zeroCreate: length1: int -> length2: int -> length3: int -> 'T [,,] + val zeroCreate: length1: int -> length2: int -> length3: int -> 'T[,,] /// Contains operations for working with rank 4 arrays. [] @@ -309,7 +309,7 @@ module Array4D = /// /// [] - val create: length1: int -> length2: int -> length3: int -> length4: int -> initial: 'T -> 'T [,,,] + val create: length1: int -> length2: int -> length3: int -> length4: int -> initial: 'T -> 'T[,,,] /// Creates an array given the dimensions and a generator function to compute the elements. /// @@ -335,7 +335,7 @@ module Array4D = length3: int -> length4: int -> initializer: (int -> int -> int -> int -> 'T) -> - 'T [,,,] + 'T[,,,] /// Returns the length of an array in the first dimension /// @@ -352,7 +352,7 @@ module Array4D = /// Evaluates to 2. /// [] - val length1: array: 'T [,,,] -> int + val length1: array: 'T[,,,] -> int /// Returns the length of an array in the second dimension. /// @@ -369,7 +369,7 @@ module Array4D = /// Evaluates to 3. /// [] - val length2: array: 'T [,,,] -> int + val length2: array: 'T[,,,] -> int /// Returns the length of an array in the third dimension. /// @@ -386,7 +386,7 @@ module Array4D = /// Evaluates to 4. /// [] - val length3: array: 'T [,,,] -> int + val length3: array: 'T[,,,] -> int /// Returns the length of an array in the fourth dimension. /// @@ -403,7 +403,7 @@ module Array4D = /// Evaluates to 5. /// [] - val length4: array: 'T [,,,] -> int + val length4: array: 'T[,,,] -> int /// Creates an array where the entries are initially the "default" value. /// @@ -421,7 +421,7 @@ module Array4D = /// After evaluation array is a 2x3x3x5 array with contents all zero. /// [] - val zeroCreate: length1: int -> length2: int -> length3: int -> length4: int -> 'T [,,,] + val zeroCreate: length1: int -> length2: int -> length3: int -> length4: int -> 'T[,,,] /// Fetches an element from a 4D array. You can also use the syntax 'array.[index1,index2,index3,index4]' /// @@ -450,7 +450,7 @@ module Array4D = /// /// [] - val get: array: 'T [,,,] -> index1: int -> index2: int -> index3: int -> index4: int -> 'T + val get: array: 'T[,,,] -> index1: int -> index2: int -> index3: int -> index4: int -> 'T /// Sets the value of an element in an array. You can also /// use the syntax 'array.[index1,index2,index3,index4] <- value'. @@ -479,4 +479,4 @@ module Array4D = /// /// [] - val set: array: 'T [,,,] -> index1: int -> index2: int -> index3: int -> index4: int -> value: 'T -> unit + val set: array: 'T[,,,] -> index1: int -> index2: int -> index3: int -> index4: int -> value: 'T -> unit diff --git a/src/FSharp.Core/async.fs b/src/FSharp.Core/async.fs index 0620810dac8..73a229670b3 100644 --- a/src/FSharp.Core/async.fs +++ b/src/FSharp.Core/async.fs @@ -2,1613 +2,1674 @@ namespace Microsoft.FSharp.Control - #nowarn "40" - #nowarn "52" // The value has been copied to ensure the original is not mutated by this operation +#nowarn "40" +#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation - open System - open System.Diagnostics - open System.Reflection - open System.Runtime.CompilerServices - open System.Runtime.ExceptionServices - open System.Threading - open System.Threading.Tasks - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Control - open Microsoft.FSharp.Collections +open System +open System.Diagnostics +open System.Reflection +open System.Runtime.CompilerServices +open System.Runtime.ExceptionServices +open System.Threading +open System.Threading.Tasks +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Control +open Microsoft.FSharp.Collections - type LinkedSubSource(cancellationToken: CancellationToken) = +type LinkedSubSource(cancellationToken: CancellationToken) = - let failureCTS = new CancellationTokenSource() + let failureCTS = new CancellationTokenSource() - let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, failureCTS.Token) + let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, failureCTS.Token) - member _.Token = linkedCTS.Token + member _.Token = linkedCTS.Token - member _.Cancel() = failureCTS.Cancel() + member _.Cancel() = failureCTS.Cancel() - member _.Dispose() = - linkedCTS.Dispose() - failureCTS.Dispose() + member _.Dispose() = + linkedCTS.Dispose() + failureCTS.Dispose() - interface IDisposable with - member this.Dispose() = this.Dispose() - - /// Global mutable state used to associate Exception - [] - module ExceptionDispatchInfoHelpers = - - let associationTable = ConditionalWeakTable() - - type ExceptionDispatchInfo with - - member edi.GetAssociatedSourceException() = - let exn = edi.SourceException - // Try to store the entry in the association table to allow us to recover it later. - try associationTable.Add(exn, edi) with _ -> () - exn - - // Capture, but prefer the saved information if available - [] - static member RestoreOrCapture exn = - match associationTable.TryGetValue exn with - | true, edi -> edi - | _ -> - ExceptionDispatchInfo.Capture exn - - member inline edi.ThrowAny() = - edi.Throw() - Unchecked.defaultof<'T> // Note, this line should not be reached, but gives a generic return type - - // F# don't always take tailcalls to functions returning 'unit' because this - // is represented as type 'void' in the underlying IL. - // Hence we don't use the 'unit' return type here, and instead invent our own type. - [] - type AsyncReturn = - | AsyncReturn - with - static member inline Fake() = Unchecked.defaultof - - type cont<'T> = ('T -> AsyncReturn) - type econt = (ExceptionDispatchInfo -> AsyncReturn) - type ccont = (OperationCanceledException -> AsyncReturn) - - [] - type Trampoline() = + interface IDisposable with + member this.Dispose() = this.Dispose() - [] - static let bindLimitBeforeHijack = 300 +/// Global mutable state used to associate Exception +[] +module ExceptionDispatchInfoHelpers = - [] - static val mutable private thisThreadHasTrampoline: bool + let associationTable = ConditionalWeakTable() - static member ThisThreadHasTrampoline = - Trampoline.thisThreadHasTrampoline + type ExceptionDispatchInfo with - let mutable storedCont = None - let mutable storedExnCont = None - let mutable bindCount = 0 + member edi.GetAssociatedSourceException() = + let exn = edi.SourceException + // Try to store the entry in the association table to allow us to recover it later. + try associationTable.Add(exn, edi) with _ -> () + exn - /// Use this trampoline on the synchronous stack if none exists, and execute - /// the given function. The function might write its continuation into the trampoline. + // Capture, but prefer the saved information if available [] - member _.Execute (firstAction: unit -> AsyncReturn) = - - let thisThreadHadTrampoline = Trampoline.thisThreadHasTrampoline - Trampoline.thisThreadHasTrampoline <- true - try - let mutable keepGoing = true - let mutable action = firstAction - while keepGoing do - try - action() |> ignore - match storedCont with - | None -> - keepGoing <- false - | Some cont -> - storedCont <- None - action <- cont - - // Catch exceptions at the trampoline to get a full .StackTrace entry - // This is because of this problem https://stackoverflow.com/questions/5301535/exception-call-stack-truncated-without-any-re-throwing - // where only a limited number of stack frames are included in the .StackTrace property - // of a .NET exception when it is thrown, up to the first catch handler. - // - // So when running async code, there aren't any intermediate catch handlers (though there - // may be intermediate try/finally frames), there is just this one catch handler at the - // base of the stack. - // - // If an exception is thrown we must have storedExnCont via OnExceptionRaised. - with exn -> - match storedExnCont with - | None -> - // Here, the exception escapes the trampoline. This should not happen since all - // exception-generating code should use ProtectCode. However some - // direct uses of combinators (not using async {...}) may cause - // code to execute unprotected, e.g. async.While((fun () -> failwith ".."), ...) executes the first - // guardExpr unprotected. - reraise() - - | Some econt -> - storedExnCont <- None - let edi = ExceptionDispatchInfo.RestoreOrCapture exn - action <- (fun () -> econt edi) - - finally - Trampoline.thisThreadHasTrampoline <- thisThreadHadTrampoline - AsyncReturn.Fake() - - /// Increment the counter estimating the size of the synchronous stack and - /// return true if time to jump on trampoline. - member _.IncrementBindCount() = - bindCount <- bindCount + 1 - bindCount >= bindLimitBeforeHijack - - /// Prepare to abandon the synchronous stack of the current execution and save the continuation in the trampoline. - member _.Set action = - assert storedCont.IsNone - bindCount <- 0 - storedCont <- Some action - AsyncReturn.Fake() - - /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member _.OnExceptionRaised (action: econt) = - assert storedExnCont.IsNone - storedExnCont <- Some action - - type TrampolineHolder() = - let mutable trampoline = null - - // On-demand allocate this delegate and keep it in the trampoline holder. - let mutable sendOrPostCallbackWithTrampoline : SendOrPostCallback = null - let getSendOrPostCallbackWithTrampoline(this: TrampolineHolder) = - match sendOrPostCallbackWithTrampoline with - | null -> - sendOrPostCallbackWithTrampoline <- - SendOrPostCallback (fun o -> + static member RestoreOrCapture exn = + match associationTable.TryGetValue exn with + | true, edi -> edi + | _ -> + ExceptionDispatchInfo.Capture exn + + member inline edi.ThrowAny() = + edi.Throw() + Unchecked.defaultof<'T> // Note, this line should not be reached, but gives a generic return type + +// F# don't always take tailcalls to functions returning 'unit' because this +// is represented as type 'void' in the underlying IL. +// Hence we don't use the 'unit' return type here, and instead invent our own type. +[] +type AsyncReturn = + | AsyncReturn + with + static member inline Fake() = Unchecked.defaultof + +type cont<'T> = ('T -> AsyncReturn) +type econt = (ExceptionDispatchInfo -> AsyncReturn) +type ccont = (OperationCanceledException -> AsyncReturn) + +[] +type Trampoline() = + + [] + static let bindLimitBeforeHijack = 300 + + [] + static val mutable private thisThreadHasTrampoline: bool + + static member ThisThreadHasTrampoline = + Trampoline.thisThreadHasTrampoline + + let mutable storedCont = None + let mutable storedExnCont = None + let mutable bindCount = 0 + + /// Use this trampoline on the synchronous stack if none exists, and execute + /// the given function. The function might write its continuation into the trampoline. + [] + member _.Execute (firstAction: unit -> AsyncReturn) = + + let thisThreadHadTrampoline = Trampoline.thisThreadHasTrampoline + Trampoline.thisThreadHasTrampoline <- true + try + let mutable keepGoing = true + let mutable action = firstAction + while keepGoing do + try + action() |> ignore + match storedCont with + | None -> + keepGoing <- false + | Some cont -> + storedCont <- None + action <- cont + + // Catch exceptions at the trampoline to get a full .StackTrace entry + // This is because of this problem https://stackoverflow.com/questions/5301535/exception-call-stack-truncated-without-any-re-throwing + // where only a limited number of stack frames are included in the .StackTrace property + // of a .NET exception when it is thrown, up to the first catch handler. + // + // So when running async code, there aren't any intermediate catch handlers (though there + // may be intermediate try/finally frames), there is just this one catch handler at the + // base of the stack. + // + // If an exception is thrown we must have storedExnCont via OnExceptionRaised. + with exn -> + match storedExnCont with + | None -> + // Here, the exception escapes the trampoline. This should not happen since all + // exception-generating code should use ProtectCode. However some + // direct uses of combinators (not using async {...}) may cause + // code to execute unprotected, e.g. async.While((fun () -> failwith ".."), ...) executes the first + // guardExpr unprotected. + reraise() + + | Some econt -> + storedExnCont <- None + let edi = ExceptionDispatchInfo.RestoreOrCapture exn + action <- (fun () -> econt edi) + + finally + Trampoline.thisThreadHasTrampoline <- thisThreadHadTrampoline + AsyncReturn.Fake() + + /// Increment the counter estimating the size of the synchronous stack and + /// return true if time to jump on trampoline. + member _.IncrementBindCount() = + bindCount <- bindCount + 1 + bindCount >= bindLimitBeforeHijack + + /// Prepare to abandon the synchronous stack of the current execution and save the continuation in the trampoline. + member _.Set action = + assert storedCont.IsNone + bindCount <- 0 + storedCont <- Some action + AsyncReturn.Fake() + + /// Save the exception continuation during propagation of an exception, or prior to raising an exception + member _.OnExceptionRaised (action: econt) = + assert storedExnCont.IsNone + storedExnCont <- Some action + +type TrampolineHolder() = + let mutable trampoline = null + + // On-demand allocate this delegate and keep it in the trampoline holder. + let mutable sendOrPostCallbackWithTrampoline : SendOrPostCallback = null + let getSendOrPostCallbackWithTrampoline(this: TrampolineHolder) = + match sendOrPostCallbackWithTrampoline with + | null -> + sendOrPostCallbackWithTrampoline <- + SendOrPostCallback (fun o -> + let f = unbox AsyncReturn> o + // Reminder: the ignore below ignores an AsyncReturn. + this.ExecuteWithTrampoline f |> ignore) + | _ -> () + sendOrPostCallbackWithTrampoline + + // On-demand allocate this delegate and keep it in the trampoline holder. + let mutable waitCallbackForQueueWorkItemWithTrampoline : WaitCallback = null + let getWaitCallbackForQueueWorkItemWithTrampoline(this: TrampolineHolder) = + match waitCallbackForQueueWorkItemWithTrampoline with + | null -> + waitCallbackForQueueWorkItemWithTrampoline <- + WaitCallback (fun o -> let f = unbox AsyncReturn> o - // Reminder: the ignore below ignores an AsyncReturn. this.ExecuteWithTrampoline f |> ignore) - | _ -> () - sendOrPostCallbackWithTrampoline - - // On-demand allocate this delegate and keep it in the trampoline holder. - let mutable waitCallbackForQueueWorkItemWithTrampoline : WaitCallback = null - let getWaitCallbackForQueueWorkItemWithTrampoline(this: TrampolineHolder) = - match waitCallbackForQueueWorkItemWithTrampoline with - | null -> - waitCallbackForQueueWorkItemWithTrampoline <- - WaitCallback (fun o -> - let f = unbox AsyncReturn> o - this.ExecuteWithTrampoline f |> ignore) - | _ -> () - waitCallbackForQueueWorkItemWithTrampoline - - // On-demand allocate this delegate and keep it in the trampoline holder. - let mutable threadStartCallbackForStartThreadWithTrampoline : ParameterizedThreadStart = null - let getThreadStartCallbackForStartThreadWithTrampoline(this: TrampolineHolder) = - match threadStartCallbackForStartThreadWithTrampoline with - | null -> - threadStartCallbackForStartThreadWithTrampoline <- - ParameterizedThreadStart (fun o -> - let f = unbox AsyncReturn> o - this.ExecuteWithTrampoline f |> ignore) - | _ -> () - threadStartCallbackForStartThreadWithTrampoline - - /// Execute an async computation after installing a trampoline on its synchronous stack. - [] - member _.ExecuteWithTrampoline firstAction = - trampoline <- Trampoline() - trampoline.Execute firstAction - - member this.PostWithTrampoline (syncCtxt: SynchronizationContext) (f: unit -> AsyncReturn) = - syncCtxt.Post (getSendOrPostCallbackWithTrampoline(this), state=(f |> box)) - AsyncReturn.Fake() - - member this.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) = - if not (ThreadPool.QueueUserWorkItem(getWaitCallbackForQueueWorkItemWithTrampoline(this), f |> box)) then - failwith "failed to queue user work item" - AsyncReturn.Fake() - - member this.PostOrQueueWithTrampoline (syncCtxt: SynchronizationContext) f = - match syncCtxt with - | null -> this.QueueWorkItemWithTrampoline f - | _ -> this.PostWithTrampoline syncCtxt f - - // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member this.StartThreadWithTrampoline (f: unit -> AsyncReturn) = - Thread(getThreadStartCallbackForStartThreadWithTrampoline(this), IsBackground=true).Start(f|>box) - AsyncReturn.Fake() - - /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member inline _.OnExceptionRaised econt = - trampoline.OnExceptionRaised econt - - /// Call a continuation, but first check if an async computation should trampoline on its synchronous stack. - member inline _.HijackCheckThenCall (cont: 'T -> AsyncReturn) res = - if trampoline.IncrementBindCount() then - trampoline.Set (fun () -> cont res) - else - // NOTE: this must be a tailcall - cont res - - /// Represents rarely changing components of an in-flight async computation - [] - [] - type AsyncActivationAux = - { /// The active cancellation token - token: CancellationToken - - /// The exception continuation - econt: econt - - /// The cancellation continuation - ccont: ccont - - /// Holds some commonly-allocated callbacks and a mutable location to use for a trampoline - trampolineHolder: TrampolineHolder } - - /// Represents context for an in-flight async computation - [] - [] - type AsyncActivationContents<'T> = - { /// The success continuation - cont: cont<'T> - - /// The rarely changing components - aux: AsyncActivationAux } - - /// A struct wrapper around AsyncActivationContents. Using a struct wrapper allows us to change representation of the - /// contents at a later point, e.g. to change the contents to a .NET Task or some other representation. - [] - type AsyncActivation<'T>(contents: AsyncActivationContents<'T>) = - - /// Produce a new execution context for a composite async - member ctxt.WithCancellationContinuation ccont = AsyncActivation<'T> { contents with aux = { ctxt.aux with ccont = ccont } } - - /// Produce a new execution context for a composite async - member ctxt.WithExceptionContinuation econt = AsyncActivation<'T> { contents with aux = { ctxt.aux with econt = econt } } - - /// Produce a new execution context for a composite async - member _.WithContinuation cont = AsyncActivation<'U> { cont = cont; aux = contents.aux } - - /// Produce a new execution context for a composite async - member _.WithContinuations(cont, econt) = AsyncActivation<'U> { cont = cont; aux = { contents.aux with econt = econt } } - - /// Produce a new execution context for a composite async - member ctxt.WithContinuations(cont, econt, ccont) = AsyncActivation<'T> { contents with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } - - /// The extra information relevant to the execution of the async - member _.aux = contents.aux - - /// The success continuation relevant to the execution of the async - member _.cont = contents.cont - - /// The exception continuation relevant to the execution of the async - member _.econt = contents.aux.econt - - /// The cancellation continuation relevant to the execution of the async - member _.ccont = contents.aux.ccont + | _ -> () + waitCallbackForQueueWorkItemWithTrampoline + + // On-demand allocate this delegate and keep it in the trampoline holder. + let mutable threadStartCallbackForStartThreadWithTrampoline : ParameterizedThreadStart = null + let getThreadStartCallbackForStartThreadWithTrampoline(this: TrampolineHolder) = + match threadStartCallbackForStartThreadWithTrampoline with + | null -> + threadStartCallbackForStartThreadWithTrampoline <- + ParameterizedThreadStart (fun o -> + let f = unbox AsyncReturn> o + this.ExecuteWithTrampoline f |> ignore) + | _ -> () + threadStartCallbackForStartThreadWithTrampoline - /// The cancellation token relevant to the execution of the async - member _.token = contents.aux.token + /// Execute an async computation after installing a trampoline on its synchronous stack. + [] + member _.ExecuteWithTrampoline firstAction = + trampoline <- Trampoline() + trampoline.Execute firstAction - /// The trampoline holder being used to protect execution of the async - member _.trampolineHolder = contents.aux.trampolineHolder + member this.PostWithTrampoline (syncCtxt: SynchronizationContext) (f: unit -> AsyncReturn) = + syncCtxt.Post (getSendOrPostCallbackWithTrampoline(this), state=(f |> box)) + AsyncReturn.Fake() - /// Check if cancellation has been requested - member _.IsCancellationRequested = contents.aux.token.IsCancellationRequested + member this.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) = + if not (ThreadPool.QueueUserWorkItem(getWaitCallbackForQueueWorkItemWithTrampoline(this), f |> box)) then + failwith "failed to queue user work item" + AsyncReturn.Fake() - /// Call the cancellation continuation of the active computation - member _.OnCancellation () = - contents.aux.ccont (OperationCanceledException (contents.aux.token)) + member this.PostOrQueueWithTrampoline (syncCtxt: SynchronizationContext) f = + match syncCtxt with + | null -> this.QueueWorkItemWithTrampoline f + | _ -> this.PostWithTrampoline syncCtxt f + + // This should be the only call to Thread.Start in this library. We must always install a trampoline. + member this.StartThreadWithTrampoline (f: unit -> AsyncReturn) = + Thread(getThreadStartCallbackForStartThreadWithTrampoline(this), IsBackground=true).Start(f|>box) + AsyncReturn.Fake() + + /// Save the exception continuation during propagation of an exception, or prior to raising an exception + member inline _.OnExceptionRaised econt = + trampoline.OnExceptionRaised econt + + /// Call a continuation, but first check if an async computation should trampoline on its synchronous stack. + member inline _.HijackCheckThenCall (cont: 'T -> AsyncReturn) res = + if trampoline.IncrementBindCount() then + trampoline.Set (fun () -> cont res) + else + // NOTE: this must be a tailcall + cont res + +/// Represents rarely changing components of an in-flight async computation +[] +[] +type AsyncActivationAux = + { /// The active cancellation token + token: CancellationToken + + /// The exception continuation + econt: econt + + /// The cancellation continuation + ccont: ccont + + /// Holds some commonly-allocated callbacks and a mutable location to use for a trampoline + trampolineHolder: TrampolineHolder } + +/// Represents context for an in-flight async computation +[] +[] +type AsyncActivationContents<'T> = + { /// The success continuation + cont: cont<'T> + + /// The rarely changing components + aux: AsyncActivationAux } + +/// A struct wrapper around AsyncActivationContents. Using a struct wrapper allows us to change representation of the +/// contents at a later point, e.g. to change the contents to a .NET Task or some other representation. +[] +type AsyncActivation<'T>(contents: AsyncActivationContents<'T>) = + + /// Produce a new execution context for a composite async + member ctxt.WithCancellationContinuation ccont = AsyncActivation<'T> { contents with aux = { ctxt.aux with ccont = ccont } } + + /// Produce a new execution context for a composite async + member ctxt.WithExceptionContinuation econt = AsyncActivation<'T> { contents with aux = { ctxt.aux with econt = econt } } + + /// Produce a new execution context for a composite async + member _.WithContinuation cont = AsyncActivation<'U> { cont = cont; aux = contents.aux } + + /// Produce a new execution context for a composite async + member _.WithContinuations(cont, econt) = AsyncActivation<'U> { cont = cont; aux = { contents.aux with econt = econt } } + + /// Produce a new execution context for a composite async + member ctxt.WithContinuations(cont, econt, ccont) = AsyncActivation<'T> { contents with cont = cont; aux = { ctxt.aux with econt = econt; ccont = ccont } } + + /// The extra information relevant to the execution of the async + member _.aux = contents.aux + + /// The success continuation relevant to the execution of the async + member _.cont = contents.cont + + /// The exception continuation relevant to the execution of the async + member _.econt = contents.aux.econt + + /// The cancellation continuation relevant to the execution of the async + member _.ccont = contents.aux.ccont + + /// The cancellation token relevant to the execution of the async + member _.token = contents.aux.token + + /// The trampoline holder being used to protect execution of the async + member _.trampolineHolder = contents.aux.trampolineHolder + + /// Check if cancellation has been requested + member _.IsCancellationRequested = contents.aux.token.IsCancellationRequested + + /// Call the cancellation continuation of the active computation + member _.OnCancellation () = + contents.aux.ccont (OperationCanceledException (contents.aux.token)) + + /// Check for trampoline hijacking. + // + // Note, this must make tailcalls, so may not be an instance member taking a byref argument, + // nor call any members taking byref arguments. + static member inline HijackCheckThenCall (ctxt: AsyncActivation<'T>) cont arg = + ctxt.aux.trampolineHolder.HijackCheckThenCall cont arg + + /// Call the success continuation of the asynchronous execution context after checking for + /// cancellation and trampoline hijacking. + // - Cancellation check + // - Hijack check + // + // Note, this must make tailcalls, so may not be an instance member taking a byref argument. + static member Success (ctxt: AsyncActivation<'T>) result = + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.cont result + + // For backwards API Compat + [] + member ctxt.OnSuccess (result: 'T) = AsyncActivation<'T>.Success ctxt result + + /// Save the exception continuation during propagation of an exception, or prior to raising an exception + member _.OnExceptionRaised() = + contents.aux.trampolineHolder.OnExceptionRaised contents.aux.econt + + /// Make an initial async activation. + static member Create cancellationToken trampolineHolder cont econt ccont : AsyncActivation<'T> = + AsyncActivation { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } + + /// Queue the success continuation of the asynchronous execution context as a work item in the thread pool + /// after installing a trampoline + member ctxt.QueueContinuationWithTrampoline (result: 'T) = + let cont = ctxt.cont + ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline(fun () -> cont result) + + /// Ensure that any exceptions raised by the immediate execution of "userCode" + /// are sent to the exception continuation. This is done by allowing the exception to propagate + /// to the trampoline, and the saved exception continuation is called there. + /// + /// It is also valid for MakeAsync primitive code to call the exception continuation directly. + [] + member ctxt.ProtectCode userCode = + let mutable ok = false + try + let res = userCode() + ok <- true + res + finally + if not ok then + ctxt.OnExceptionRaised() + + member ctxt.PostWithTrampoline (syncCtxt: SynchronizationContext) (f: unit -> AsyncReturn) = + let holder = contents.aux.trampolineHolder + ctxt.ProtectCode (fun () -> holder.PostWithTrampoline syncCtxt f) + + /// Call the success continuation of the asynchronous execution context + member ctxt.CallContinuation(result: 'T) = + ctxt.cont result + +/// Represents an asynchronous computation +[] +type Async<'T> = + { Invoke: (AsyncActivation<'T> -> AsyncReturn) } + +/// Mutable register to help ensure that code is only executed once +[] +type Latch() = + let mutable i = 0 + + /// Execute the latch + member _.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 + +/// Represents the result of an asynchronous computation +[] +type AsyncResult<'T> = + | Ok of 'T + | Error of ExceptionDispatchInfo + | Canceled of OperationCanceledException + + /// Get the result of an asynchronous computation + [] + member res.Commit () = + match res with + | AsyncResult.Ok res -> res + | AsyncResult.Error edi -> edi.ThrowAny() + | AsyncResult.Canceled exn -> raise exn + +/// Primitives to execute asynchronous computations +module AsyncPrimitives = + + let inline fake () = Unchecked.defaultof + + let inline unfake (_: AsyncReturn) = () + + /// The mutable global CancellationTokenSource, see Async.DefaultCancellationToken + let mutable defaultCancellationTokenSource = new CancellationTokenSource() + + /// Primitive to invoke an async computation. + // + // Note: direct calls to this function may end up in user assemblies via inlining + [] + let Invoke (computation: Async<'T>) (ctxt: AsyncActivation<_>) : AsyncReturn = + AsyncActivation<'T>.HijackCheckThenCall ctxt computation.Invoke ctxt + + /// Apply 'userCode' to 'arg'. If no exception is raised then call the normal continuation. Used to implement + /// 'finally' and 'when cancelled'. + /// + /// - Apply 'userCode' to argument with exception protection + /// - Hijack check before invoking the continuation + [] + let CallThenContinue userCode arg (ctxt: AsyncActivation<_>) : AsyncReturn = + let mutable result = Unchecked.defaultof<_> + let mutable ok = false + + try + result <- userCode arg + ok <- true + finally + if not ok then + ctxt.OnExceptionRaised() + + if ok then + AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.cont result + else + fake() + + /// Apply 'part2' to 'result1' and invoke the resulting computation. + /// + /// Note: direct calls to this function end up in user assemblies via inlining + /// + /// - Apply 'part2' to argument with exception protection + /// - Hijack check before invoking the resulting computation + [] + let CallThenInvoke (ctxt: AsyncActivation<_>) result1 part2 : AsyncReturn = + let mutable result = Unchecked.defaultof<_> + let mutable ok = false + + try + result <- part2 result1 + ok <- true + finally + if not ok then + ctxt.OnExceptionRaised() + + if ok then + Invoke result ctxt + else + fake() + + /// Like `CallThenInvoke` but does not do a hijack check for historical reasons (exact code compat) + [] + let CallThenInvokeNoHijackCheck (ctxt: AsyncActivation<_>) result1 userCode = + let mutable res = Unchecked.defaultof<_> + let mutable ok = false + + try + res <- userCode result1 + ok <- true + finally + if not ok then + ctxt.OnExceptionRaised() + + if ok then + res.Invoke ctxt + else + fake() + + /// Apply 'filterFunction' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' + /// then send 'result1' to the exception continuation. + /// + /// - Apply 'filterFunction' to argument with exception protection + /// - Hijack check before invoking the resulting computation or exception continuation + [] + let CallFilterThenInvoke (ctxt: AsyncActivation<'T>) filterFunction (edi: ExceptionDispatchInfo) : AsyncReturn = + let mutable resOpt = None + let mutable ok = false + + try + resOpt <- filterFunction (edi.GetAssociatedSourceException()) + ok <- true + finally + if not ok then + ctxt.OnExceptionRaised() + + if ok then + match resOpt with + | None -> + AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.econt edi + | Some res -> + Invoke res ctxt + else + fake() - /// Check for trampoline hijacking. - // - // Note, this must make tailcalls, so may not be an instance member taking a byref argument, - // nor call any members taking byref arguments. - static member inline HijackCheckThenCall (ctxt: AsyncActivation<'T>) cont arg = - ctxt.aux.trampolineHolder.HijackCheckThenCall cont arg + /// Build a primitive without any exception or resync protection + [] + let MakeAsync body = { Invoke = body } - /// Call the success continuation of the asynchronous execution context after checking for - /// cancellation and trampoline hijacking. - // - Cancellation check - // - Hijack check - // - // Note, this must make tailcalls, so may not be an instance member taking a byref argument. - static member Success (ctxt: AsyncActivation<'T>) result = + [] + let MakeAsyncWithCancelCheck body = + MakeAsync (fun ctxt -> if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.cont result - - // For backwards API Compat - [] - member ctxt.OnSuccess (result: 'T) = AsyncActivation<'T>.Success ctxt result - - /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member _.OnExceptionRaised() = - contents.aux.trampolineHolder.OnExceptionRaised contents.aux.econt - - /// Make an initial async activation. - static member Create cancellationToken trampolineHolder cont econt ccont : AsyncActivation<'T> = - AsyncActivation { cont = cont; aux = { token = cancellationToken; econt = econt; ccont = ccont; trampolineHolder = trampolineHolder } } - - /// Queue the success continuation of the asynchronous execution context as a work item in the thread pool - /// after installing a trampoline - member ctxt.QueueContinuationWithTrampoline (result: 'T) = - let cont = ctxt.cont - ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline(fun () -> cont result) - - /// Ensure that any exceptions raised by the immediate execution of "userCode" - /// are sent to the exception continuation. This is done by allowing the exception to propagate - /// to the trampoline, and the saved exception continuation is called there. - /// - /// It is also valid for MakeAsync primitive code to call the exception continuation directly. - [] - member ctxt.ProtectCode userCode = - let mutable ok = false - try - let res = userCode() - ok <- true - res - finally - if not ok then - ctxt.OnExceptionRaised() - - member ctxt.PostWithTrampoline (syncCtxt: SynchronizationContext) (f: unit -> AsyncReturn) = - let holder = contents.aux.trampolineHolder - ctxt.ProtectCode (fun () -> holder.PostWithTrampoline syncCtxt f) - - /// Call the success continuation of the asynchronous execution context - member ctxt.CallContinuation(result: 'T) = - ctxt.cont result - - /// Represents an asynchronous computation - [] - type Async<'T> = - { Invoke: (AsyncActivation<'T> -> AsyncReturn) } - - /// Mutable register to help ensure that code is only executed once - [] - type Latch() = - let mutable i = 0 - - /// Execute the latch - member _.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 + body ctxt) + + /// Execute part1, then apply part2, then execute the result of that + /// + /// Note: direct calls to this function end up in user assemblies via inlining + /// - Initial cancellation check + /// - Initial hijack check (see Invoke) + /// - No hijack check after applying 'part2' to argument (see CallThenInvoke) + /// - No cancellation check after applying 'part2' to argument (see CallThenInvoke) + /// - Apply 'part2' to argument with exception protection (see CallThenInvoke) + [] + let Bind (ctxt: AsyncActivation<'T>) (part1: Async<'U>) (part2: 'U -> Async<'T>) : AsyncReturn = + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + // Note, no cancellation check is done before calling 'part2'. This is + // because part1 may bind a resource, while part2 is a try/finally, and, if + // the resource creation completes, we want to enter part2 before cancellation takes effect. + Invoke part1 (ctxt.WithContinuation(fun result1 -> CallThenInvokeNoHijackCheck ctxt result1 part2)) + + /// Re-route all continuations to execute the finally function. + /// - Cancellation check after 'entering' the try/finally and before running the body + /// - Hijack check after 'entering' the try/finally and before running the body (see Invoke) + /// - Run 'finallyFunction' with exception protection (see CallThenContinue) + /// - Hijack check before any of the continuations (see CallThenContinue) + [] + let TryFinally (ctxt: AsyncActivation<'T>) (computation: Async<'T>) finallyFunction = + // Note, we don't test for cancellation before entering a try/finally. This prevents + // a resource being created without being disposed. + + // The new continuation runs the finallyFunction and resumes the old continuation + // If an exception is thrown we continue with the previous exception continuation. + let cont result = + CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.cont result)) + + // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. + // If an exception is thrown we continue with the previous exception continuation. + let econt edi = + CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.econt edi)) + + // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. + // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) + let ccont cexn = + CallThenContinue finallyFunction () (ctxt.WithContinuations(cont=(fun () -> ctxt.ccont cexn), econt = (fun _ -> ctxt.ccont cexn))) + + let ctxt = ctxt.WithContinuations(cont=cont, econt=econt, ccont=ccont) + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + computation.Invoke ctxt + + /// Re-route the exception continuation to call to catchFunction. If catchFunction returns None then call the exception continuation. + /// If it returns Some, invoke the resulting async. + /// - Cancellation check before entering the try + /// - No hijack check after 'entering' the try/with + /// - Cancellation check before applying the 'catchFunction' + /// - Apply `catchFunction' to argument with exception protection (see CallFilterThenInvoke) + /// - Hijack check before invoking the resulting computation or exception continuation (see CallFilterThenInvoke) + [] + let TryWith (ctxt: AsyncActivation<'T>) (computation: Async<'T>) catchFunction = + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + let ctxt = + ctxt.WithExceptionContinuation(fun edi -> + if ctxt.IsCancellationRequested then + ctxt.OnCancellation () + else + CallFilterThenInvoke ctxt catchFunction edi) - /// Represents the result of an asynchronous computation - [] - type AsyncResult<'T> = - | Ok of 'T - | Error of ExceptionDispatchInfo - | Canceled of OperationCanceledException + computation.Invoke ctxt - /// Get the result of an asynchronous computation - [] - member res.Commit () = + /// Make an async for an AsyncResult + // - No cancellation check + // - No hijack check + let CreateAsyncResultAsync res = + MakeAsync (fun ctxt -> match res with - | AsyncResult.Ok res -> res - | AsyncResult.Error edi -> edi.ThrowAny() - | AsyncResult.Canceled exn -> raise exn - - /// Primitives to execute asynchronous computations - module AsyncPrimitives = - - let inline fake () = Unchecked.defaultof - - let inline unfake (_: AsyncReturn) = () - - /// The mutable global CancellationTokenSource, see Async.DefaultCancellationToken - let mutable defaultCancellationTokenSource = new CancellationTokenSource() - - /// Primitive to invoke an async computation. - // - // Note: direct calls to this function may end up in user assemblies via inlining - [] - let Invoke (computation: Async<'T>) (ctxt: AsyncActivation<_>) : AsyncReturn = - AsyncActivation<'T>.HijackCheckThenCall ctxt computation.Invoke ctxt - - /// Apply 'userCode' to 'arg'. If no exception is raised then call the normal continuation. Used to implement - /// 'finally' and 'when cancelled'. - /// - /// - Apply 'userCode' to argument with exception protection - /// - Hijack check before invoking the continuation - [] - let CallThenContinue userCode arg (ctxt: AsyncActivation<_>) : AsyncReturn = - let mutable result = Unchecked.defaultof<_> - let mutable ok = false - - try - result <- userCode arg - ok <- true - finally - if not ok then - ctxt.OnExceptionRaised() - - if ok then - AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.cont result - else - fake() - - /// Apply 'part2' to 'result1' and invoke the resulting computation. - /// - /// Note: direct calls to this function end up in user assemblies via inlining - /// - /// - Apply 'part2' to argument with exception protection - /// - Hijack check before invoking the resulting computation - [] - let CallThenInvoke (ctxt: AsyncActivation<_>) result1 part2 : AsyncReturn = - let mutable result = Unchecked.defaultof<_> - let mutable ok = false - - try - result <- part2 result1 - ok <- true - finally - if not ok then - ctxt.OnExceptionRaised() - - if ok then - Invoke result ctxt - else - fake() - - /// Like `CallThenInvoke` but does not do a hijack check for historical reasons (exact code compat) - [] - let CallThenInvokeNoHijackCheck (ctxt: AsyncActivation<_>) result1 userCode = - let mutable res = Unchecked.defaultof<_> - let mutable ok = false - - try - res <- userCode result1 - ok <- true - finally - if not ok then - ctxt.OnExceptionRaised() - - if ok then - res.Invoke ctxt - else - fake() - - /// Apply 'filterFunction' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' - /// then send 'result1' to the exception continuation. - /// - /// - Apply 'filterFunction' to argument with exception protection - /// - Hijack check before invoking the resulting computation or exception continuation - [] - let CallFilterThenInvoke (ctxt: AsyncActivation<'T>) filterFunction (edi: ExceptionDispatchInfo) : AsyncReturn = - let mutable resOpt = None - let mutable ok = false - - try - resOpt <- filterFunction (edi.GetAssociatedSourceException()) - ok <- true - finally - if not ok then - ctxt.OnExceptionRaised() - - if ok then - match resOpt with - | None -> - AsyncActivation<'T>.HijackCheckThenCall ctxt ctxt.econt edi - | Some res -> - Invoke res ctxt - else - fake() - - /// Build a primitive without any exception or resync protection - [] - let MakeAsync body = { Invoke = body } - - [] - let MakeAsyncWithCancelCheck body = - MakeAsync (fun ctxt -> - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - body ctxt) - - /// Execute part1, then apply part2, then execute the result of that - /// - /// Note: direct calls to this function end up in user assemblies via inlining - /// - Initial cancellation check - /// - Initial hijack check (see Invoke) - /// - No hijack check after applying 'part2' to argument (see CallThenInvoke) - /// - No cancellation check after applying 'part2' to argument (see CallThenInvoke) - /// - Apply 'part2' to argument with exception protection (see CallThenInvoke) - [] - let Bind (ctxt: AsyncActivation<'T>) (part1: Async<'U>) (part2: 'U -> Async<'T>) : AsyncReturn = - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - // Note, no cancellation check is done before calling 'part2'. This is - // because part1 may bind a resource, while part2 is a try/finally, and, if - // the resource creation completes, we want to enter part2 before cancellation takes effect. - Invoke part1 (ctxt.WithContinuation(fun result1 -> CallThenInvokeNoHijackCheck ctxt result1 part2)) - - /// Re-route all continuations to execute the finally function. - /// - Cancellation check after 'entering' the try/finally and before running the body - /// - Hijack check after 'entering' the try/finally and before running the body (see Invoke) - /// - Run 'finallyFunction' with exception protection (see CallThenContinue) - /// - Hijack check before any of the continuations (see CallThenContinue) - [] - let TryFinally (ctxt: AsyncActivation<'T>) (computation: Async<'T>) finallyFunction = - // Note, we don't test for cancellation before entering a try/finally. This prevents - // a resource being created without being disposed. - - // The new continuation runs the finallyFunction and resumes the old continuation - // If an exception is thrown we continue with the previous exception continuation. - let cont result = - CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.cont result)) - - // The new exception continuation runs the finallyFunction and then runs the previous exception continuation. - // If an exception is thrown we continue with the previous exception continuation. - let econt edi = - CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.econt edi)) - - // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation. - // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost) - let ccont cexn = - CallThenContinue finallyFunction () (ctxt.WithContinuations(cont=(fun () -> ctxt.ccont cexn), econt = (fun _ -> ctxt.ccont cexn))) - - let ctxt = ctxt.WithContinuations(cont=cont, econt=econt, ccont=ccont) - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - computation.Invoke ctxt - - /// Re-route the exception continuation to call to catchFunction. If catchFunction returns None then call the exception continuation. - /// If it returns Some, invoke the resulting async. - /// - Cancellation check before entering the try - /// - No hijack check after 'entering' the try/with - /// - Cancellation check before applying the 'catchFunction' - /// - Apply `catchFunction' to argument with exception protection (see CallFilterThenInvoke) - /// - Hijack check before invoking the resulting computation or exception continuation (see CallFilterThenInvoke) - [] - let TryWith (ctxt: AsyncActivation<'T>) (computation: Async<'T>) catchFunction = - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - let ctxt = - ctxt.WithExceptionContinuation(fun edi -> - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - CallFilterThenInvoke ctxt catchFunction edi) - - computation.Invoke ctxt + | AsyncResult.Ok r -> ctxt.cont r + | AsyncResult.Error edi -> ctxt.econt edi + | AsyncResult.Canceled cexn -> ctxt.ccont cexn) + + /// Generate async computation which calls its continuation with the given result + /// - Cancellation check (see OnSuccess) + /// - Hijack check (see OnSuccess) + let inline CreateReturnAsync res = + // Note: this code ends up in user assemblies via inlining + MakeAsync (fun ctxt -> AsyncActivation.Success ctxt res) + + /// Runs the first process, takes its result, applies f and then runs the new process produced. + /// - Initial cancellation check (see Bind) + /// - Initial hijack check (see Bind) + /// - No hijack check after applying 'part2' to argument (see Bind) + /// - No cancellation check after applying 'part2' to argument (see Bind) + /// - Apply 'part2' to argument with exception protection (see Bind) + let inline CreateBindAsync part1 part2 = + // Note: this code ends up in user assemblies via inlining + MakeAsync (fun ctxt -> + Bind ctxt part1 part2) + + /// Call the given function with exception protection. + /// - No initial cancellation check + /// - Hijack check after applying part2 to argument (see CallThenInvoke) + let inline CreateCallAsync part2 result1 = + // Note: this code ends up in user assemblies via inlining + MakeAsync (fun ctxt -> + CallThenInvoke ctxt result1 part2) + + /// Call the given function with exception protection. + /// - Initial cancellation check + /// - Hijack check after applying computation to argument (see CallThenInvoke) + /// - Apply 'computation' to argument with exception protection (see CallThenInvoke) + let inline CreateDelayAsync computation = + // Note: this code ends up in user assemblies via inlining + MakeAsyncWithCancelCheck (fun ctxt -> + CallThenInvoke ctxt () computation) + + /// Implements the sequencing construct of async computation expressions + /// - Initial cancellation check (see CreateBindAsync) + /// - Initial hijack check (see CreateBindAsync) + /// - No hijack check after applying 'part2' to argument (see CreateBindAsync) + /// - No cancellation check after applying 'part2' to argument (see CreateBindAsync) + /// - Apply 'part2' to argument with exception protection (see CreateBindAsync) + let inline CreateSequentialAsync part1 part2 = + // Note: this code ends up in user assemblies via inlining + CreateBindAsync part1 (fun () -> part2) + + /// Create an async for a try/finally + /// - Cancellation check after 'entering' the try/finally and before running the body + /// - Hijack check after 'entering' the try/finally and before running the body (see TryFinally) + /// - Apply 'finallyFunction' with exception protection (see TryFinally) + let inline CreateTryFinallyAsync finallyFunction computation = + MakeAsync (fun ctxt -> TryFinally ctxt computation finallyFunction) + + /// Create an async for a try/with filtering exceptions through a pattern match + /// - Cancellation check before entering the try (see TryWith) + /// - Cancellation check before entering the with (see TryWith) + /// - Apply `filterFunction' to argument with exception protection (see TryWith) + /// - Hijack check before invoking the resulting computation or exception continuation + let inline CreateTryWithFilterAsync filterFunction computation = + MakeAsync (fun ctxt -> TryWith ctxt computation filterFunction) + + /// Create an async for a try/with filtering + /// - Cancellation check before entering the try (see TryWith) + /// - Cancellation check before entering the with (see TryWith) + /// - Apply `catchFunction' to argument with exception protection (see TryWith) + /// - Hijack check before invoking the resulting computation or exception continuation + let inline CreateTryWithAsync catchFunction computation = + MakeAsync (fun ctxt -> TryWith ctxt computation (fun exn -> Some (catchFunction exn))) + + /// Call the finallyFunction if the computation results in a cancellation, and then continue with cancellation. + /// If the finally function gives an exception then continue with cancellation regardless. + /// - No cancellation check before entering the when-cancelled + /// - No hijack check before entering the when-cancelled + /// - Apply `finallyFunction' to argument with exception protection (see CallThenContinue) + /// - Hijack check before continuing with cancellation (see CallThenContinue) + let CreateWhenCancelledAsync (finallyFunction: OperationCanceledException -> unit) computation = + MakeAsync (fun ctxt -> + let ccont = ctxt.ccont + let ctxt = + ctxt.WithCancellationContinuation(fun cexn -> + CallThenContinue finallyFunction cexn (ctxt.WithContinuations(cont = (fun _ -> ccont cexn), econt = (fun _ -> ccont cexn)))) + computation.Invoke ctxt) + + /// A single pre-allocated computation that fetched the current cancellation token + let cancellationTokenAsync = + MakeAsync (fun ctxt -> ctxt.cont ctxt.aux.token) + + /// A single pre-allocated computation that returns a unit result + /// - Cancellation check (see CreateReturnAsync) + /// - Hijack check (see CreateReturnAsync) + let unitAsync = + CreateReturnAsync() + + /// Implement use/Dispose + /// + /// - No initial cancellation check before applying computation to its argument. See CreateTryFinallyAsync + /// and CreateCallAsync. We enter the try/finally before any cancel checks. + /// - Cancellation check after 'entering' the implied try/finally and before running the body (see CreateTryFinallyAsync) + /// - Hijack check after 'entering' the implied try/finally and before running the body (see CreateTryFinallyAsync) + /// - Run 'disposeFunction' with exception protection (see CreateTryFinallyAsync) + let CreateUsingAsync (resource:'T :> IDisposable) (computation:'T -> Async<'a>) : Async<'a> = + let disposeFunction () = Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource + CreateTryFinallyAsync disposeFunction (CreateCallAsync computation resource) + + /// - Initial cancellation check (see CreateBindAsync) + /// - Initial hijack check (see CreateBindAsync) + /// - Cancellation check after (see unitAsync) + /// - No hijack check after (see unitAsync) + let inline CreateIgnoreAsync computation = + CreateBindAsync computation (fun _ -> unitAsync) + + /// Implement the while loop construct of async computation expressions + /// - No initial cancellation check before first execution of guard + /// - No initial hijack check before first execution of guard + /// - No cancellation check before each execution of guard (see CreateBindAsync) + /// - Hijack check before each execution of guard (see CreateBindAsync) + /// - Cancellation check before each execution of the body after guard (CreateBindAsync) + /// - No hijack check before each execution of the body after guard (see CreateBindAsync) + /// - Cancellation check after guard fails (see unitAsync) + /// - Hijack check after guard fails (see unitAsync) + /// - Apply 'guardFunc' with exception protection (see ProtectCode) + // + // Note: There are allocations during loop set up, but no allocations during iterations of the loop + let CreateWhileAsync guardFunc computation = + if guardFunc() then + let mutable whileAsync = Unchecked.defaultof<_> + whileAsync <- CreateBindAsync computation (fun () -> if guardFunc() then whileAsync else unitAsync) + whileAsync + else + unitAsync - /// Make an async for an AsyncResult - // - No cancellation check - // - No hijack check - let CreateAsyncResultAsync res = - MakeAsync (fun ctxt -> - match res with - | AsyncResult.Ok r -> ctxt.cont r - | AsyncResult.Error edi -> ctxt.econt edi - | AsyncResult.Canceled cexn -> ctxt.ccont cexn) - - /// Generate async computation which calls its continuation with the given result - /// - Cancellation check (see OnSuccess) - /// - Hijack check (see OnSuccess) - let inline CreateReturnAsync res = - // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> AsyncActivation.Success ctxt res) - - /// Runs the first process, takes its result, applies f and then runs the new process produced. - /// - Initial cancellation check (see Bind) - /// - Initial hijack check (see Bind) - /// - No hijack check after applying 'part2' to argument (see Bind) - /// - No cancellation check after applying 'part2' to argument (see Bind) - /// - Apply 'part2' to argument with exception protection (see Bind) - let inline CreateBindAsync part1 part2 = - // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> - Bind ctxt part1 part2) +#if REDUCED_ALLOCATIONS_BUT_RUNS_SLOWER + /// Implement the while loop construct of async computation expressions + /// - Initial cancellation check before each execution of guard + /// - No initial hijack check before each execution of guard + /// - No cancellation check before each execution of the body after guard + /// - Hijack check before each execution of the body after guard (see Invoke) + /// - Cancellation check after guard fails (see OnSuccess) + /// - Hijack check after guard fails (see OnSuccess) + /// - Apply 'guardFunc' with exception protection (see ProtectCode) + // + // Note: There are allocations during loop set up, but no allocations during iterations of the loop + // One allocation for While async + // One allocation for While async context function + MakeAsync (fun ctxtGuard -> + // One allocation for ctxtLoop reference cell + let mutable ctxtLoop = Unchecked.defaultof<_> + // One allocation for While recursive closure + let rec WhileLoop () = + if ctxtGuard.IsCancellationRequested then + ctxtGuard.OnCancellation () + elif ctxtGuard.ProtectCode guardFunc then + Invoke computation ctxtLoop + else + ctxtGuard.OnSuccess () + // One allocation for While body activation context + ctxtLoop <- ctxtGuard.WithContinuation(WhileLoop) + WhileLoop ()) +#endif - /// Call the given function with exception protection. - /// - No initial cancellation check - /// - Hijack check after applying part2 to argument (see CallThenInvoke) - let inline CreateCallAsync part2 result1 = - // Note: this code ends up in user assemblies via inlining - MakeAsync (fun ctxt -> - CallThenInvoke ctxt result1 part2) - - /// Call the given function with exception protection. - /// - Initial cancellation check - /// - Hijack check after applying computation to argument (see CallThenInvoke) - /// - Apply 'computation' to argument with exception protection (see CallThenInvoke) - let inline CreateDelayAsync computation = - // Note: this code ends up in user assemblies via inlining - MakeAsyncWithCancelCheck (fun ctxt -> - CallThenInvoke ctxt () computation) - - /// Implements the sequencing construct of async computation expressions - /// - Initial cancellation check (see CreateBindAsync) - /// - Initial hijack check (see CreateBindAsync) - /// - No hijack check after applying 'part2' to argument (see CreateBindAsync) - /// - No cancellation check after applying 'part2' to argument (see CreateBindAsync) - /// - Apply 'part2' to argument with exception protection (see CreateBindAsync) - let inline CreateSequentialAsync part1 part2 = - // Note: this code ends up in user assemblies via inlining - CreateBindAsync part1 (fun () -> part2) - - /// Create an async for a try/finally - /// - Cancellation check after 'entering' the try/finally and before running the body - /// - Hijack check after 'entering' the try/finally and before running the body (see TryFinally) - /// - Apply 'finallyFunction' with exception protection (see TryFinally) - let inline CreateTryFinallyAsync finallyFunction computation = - MakeAsync (fun ctxt -> TryFinally ctxt computation finallyFunction) - - /// Create an async for a try/with filtering exceptions through a pattern match - /// - Cancellation check before entering the try (see TryWith) - /// - Cancellation check before entering the with (see TryWith) - /// - Apply `filterFunction' to argument with exception protection (see TryWith) - /// - Hijack check before invoking the resulting computation or exception continuation - let inline CreateTryWithFilterAsync filterFunction computation = - MakeAsync (fun ctxt -> TryWith ctxt computation filterFunction) - - /// Create an async for a try/with filtering - /// - Cancellation check before entering the try (see TryWith) - /// - Cancellation check before entering the with (see TryWith) - /// - Apply `catchFunction' to argument with exception protection (see TryWith) - /// - Hijack check before invoking the resulting computation or exception continuation - let inline CreateTryWithAsync catchFunction computation = - MakeAsync (fun ctxt -> TryWith ctxt computation (fun exn -> Some (catchFunction exn))) - - /// Call the finallyFunction if the computation results in a cancellation, and then continue with cancellation. - /// If the finally function gives an exception then continue with cancellation regardless. - /// - No cancellation check before entering the when-cancelled - /// - No hijack check before entering the when-cancelled - /// - Apply `finallyFunction' to argument with exception protection (see CallThenContinue) - /// - Hijack check before continuing with cancellation (see CallThenContinue) - let CreateWhenCancelledAsync (finallyFunction: OperationCanceledException -> unit) computation = - MakeAsync (fun ctxt -> - let ccont = ctxt.ccont - let ctxt = - ctxt.WithCancellationContinuation(fun cexn -> - CallThenContinue finallyFunction cexn (ctxt.WithContinuations(cont = (fun _ -> ccont cexn), econt = (fun _ -> ccont cexn)))) - computation.Invoke ctxt) - - /// A single pre-allocated computation that fetched the current cancellation token - let cancellationTokenAsync = - MakeAsync (fun ctxt -> ctxt.cont ctxt.aux.token) - - /// A single pre-allocated computation that returns a unit result - /// - Cancellation check (see CreateReturnAsync) - /// - Hijack check (see CreateReturnAsync) - let unitAsync = - CreateReturnAsync() - - /// Implement use/Dispose - /// - /// - No initial cancellation check before applying computation to its argument. See CreateTryFinallyAsync - /// and CreateCallAsync. We enter the try/finally before any cancel checks. - /// - Cancellation check after 'entering' the implied try/finally and before running the body (see CreateTryFinallyAsync) - /// - Hijack check after 'entering' the implied try/finally and before running the body (see CreateTryFinallyAsync) - /// - Run 'disposeFunction' with exception protection (see CreateTryFinallyAsync) - let CreateUsingAsync (resource:'T :> IDisposable) (computation:'T -> Async<'a>) : Async<'a> = - let disposeFunction () = Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource - CreateTryFinallyAsync disposeFunction (CreateCallAsync computation resource) - - /// - Initial cancellation check (see CreateBindAsync) - /// - Initial hijack check (see CreateBindAsync) - /// - Cancellation check after (see unitAsync) - /// - No hijack check after (see unitAsync) - let inline CreateIgnoreAsync computation = - CreateBindAsync computation (fun _ -> unitAsync) - - /// Implement the while loop construct of async computation expressions - /// - No initial cancellation check before first execution of guard - /// - No initial hijack check before first execution of guard - /// - No cancellation check before each execution of guard (see CreateBindAsync) - /// - Hijack check before each execution of guard (see CreateBindAsync) - /// - Cancellation check before each execution of the body after guard (CreateBindAsync) - /// - No hijack check before each execution of the body after guard (see CreateBindAsync) - /// - Cancellation check after guard fails (see unitAsync) - /// - Hijack check after guard fails (see unitAsync) - /// - Apply 'guardFunc' with exception protection (see ProtectCode) - // - // Note: There are allocations during loop set up, but no allocations during iterations of the loop - let CreateWhileAsync guardFunc computation = - if guardFunc() then - let mutable whileAsync = Unchecked.defaultof<_> - whileAsync <- CreateBindAsync computation (fun () -> if guardFunc() then whileAsync else unitAsync) - whileAsync - else - unitAsync + /// Implement the for loop construct of async commputation expressions + /// - No initial cancellation check before GetEnumerator call. + /// - No initial cancellation check before entering protection of implied try/finally + /// - Cancellation check after 'entering' the implied try/finally and before loop + /// - Hijack check after 'entering' the implied try/finally and after MoveNext call + /// - Do not apply 'GetEnumerator' with exception protection. However for an 'async' + /// in an 'async { ... }' the exception protection will be provided by the enclosing + /// Delay or Bind or similar construct. + /// - Apply 'MoveNext' with exception protection + /// - Apply 'Current' with exception protection + + // Note: No allocations during iterations of the loop apart from those from + // applying the loop body to the element + let CreateForLoopAsync (source: seq<_>) computation = + CreateUsingAsync (source.GetEnumerator()) (fun ie -> + CreateWhileAsync + (fun () -> ie.MoveNext()) + (CreateDelayAsync (fun () -> computation ie.Current))) #if REDUCED_ALLOCATIONS_BUT_RUNS_SLOWER - /// Implement the while loop construct of async computation expressions - /// - Initial cancellation check before each execution of guard - /// - No initial hijack check before each execution of guard - /// - No cancellation check before each execution of the body after guard - /// - Hijack check before each execution of the body after guard (see Invoke) - /// - Cancellation check after guard fails (see OnSuccess) - /// - Hijack check after guard fails (see OnSuccess) - /// - Apply 'guardFunc' with exception protection (see ProtectCode) - // - // Note: There are allocations during loop set up, but no allocations during iterations of the loop + CreateUsingAsync (source.GetEnumerator()) (fun ie -> // One allocation for While async // One allocation for While async context function MakeAsync (fun ctxtGuard -> // One allocation for ctxtLoop reference cell let mutable ctxtLoop = Unchecked.defaultof<_> - // One allocation for While recursive closure - let rec WhileLoop () = + // Two allocations for protected functions + let guardFunc() = ie.MoveNext() + let currentFunc() = ie.Current + // One allocation for ForLoop recursive closure + let rec ForLoop () = if ctxtGuard.IsCancellationRequested then ctxtGuard.OnCancellation () elif ctxtGuard.ProtectCode guardFunc then - Invoke computation ctxtLoop + let x = ctxtGuard.ProtectCode currentFunc + CallThenInvoke ctxtLoop x computation else ctxtGuard.OnSuccess () - // One allocation for While body activation context - ctxtLoop <- ctxtGuard.WithContinuation(WhileLoop) - WhileLoop ()) + // One allocation for loop activation context + ctxtLoop <- ctxtGuard.WithContinuation(ForLoop) + ForLoop ())) #endif - /// Implement the for loop construct of async commputation expressions - /// - No initial cancellation check before GetEnumerator call. - /// - No initial cancellation check before entering protection of implied try/finally - /// - Cancellation check after 'entering' the implied try/finally and before loop - /// - Hijack check after 'entering' the implied try/finally and after MoveNext call - /// - Do not apply 'GetEnumerator' with exception protection. However for an 'async' - /// in an 'async { ... }' the exception protection will be provided by the enclosing - /// Delay or Bind or similar construct. - /// - Apply 'MoveNext' with exception protection - /// - Apply 'Current' with exception protection - - // Note: No allocations during iterations of the loop apart from those from - // applying the loop body to the element - let CreateForLoopAsync (source: seq<_>) computation = - CreateUsingAsync (source.GetEnumerator()) (fun ie -> - CreateWhileAsync - (fun () -> ie.MoveNext()) - (CreateDelayAsync (fun () -> computation ie.Current))) + /// - Initial cancellation check + /// - Call syncCtxt.Post with exception protection. THis may fail as it is arbitrary user code + let CreateSwitchToAsync (syncCtxt: SynchronizationContext) = + MakeAsyncWithCancelCheck (fun ctxt -> + ctxt.PostWithTrampoline syncCtxt ctxt.cont) + + /// - Initial cancellation check + /// - Create Thread and call Start() with exception protection. We don't expect this + /// to fail but protect nevertheless. + let CreateSwitchToNewThreadAsync() = + MakeAsyncWithCancelCheck (fun ctxt -> + ctxt.ProtectCode (fun () -> ctxt.trampolineHolder.StartThreadWithTrampoline ctxt.cont)) + + /// - Initial cancellation check + /// - Call ThreadPool.QueueUserWorkItem with exception protection. We don't expect this + /// to fail but protect nevertheless. + let CreateSwitchToThreadPoolAsync() = + MakeAsyncWithCancelCheck (fun ctxt -> + ctxt.ProtectCode (fun () -> ctxt.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont)) + + /// Post back to the sync context regardless of which continuation is taken + /// - Call syncCtxt.Post with exception protection + let DelimitSyncContext (ctxt: AsyncActivation<_>) = + match SynchronizationContext.Current with + | null -> ctxt + | syncCtxt -> + ctxt.WithContinuations(cont = (fun x -> ctxt.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)), + econt = (fun edi -> ctxt.PostWithTrampoline syncCtxt (fun () -> ctxt.econt edi)), + ccont = (fun cexn -> ctxt.PostWithTrampoline syncCtxt (fun () -> ctxt.ccont cexn))) -#if REDUCED_ALLOCATIONS_BUT_RUNS_SLOWER - CreateUsingAsync (source.GetEnumerator()) (fun ie -> - // One allocation for While async - // One allocation for While async context function - MakeAsync (fun ctxtGuard -> - // One allocation for ctxtLoop reference cell - let mutable ctxtLoop = Unchecked.defaultof<_> - // Two allocations for protected functions - let guardFunc() = ie.MoveNext() - let currentFunc() = ie.Current - // One allocation for ForLoop recursive closure - let rec ForLoop () = - if ctxtGuard.IsCancellationRequested then - ctxtGuard.OnCancellation () - elif ctxtGuard.ProtectCode guardFunc then - let x = ctxtGuard.ProtectCode currentFunc - CallThenInvoke ctxtLoop x computation - else - ctxtGuard.OnSuccess () - // One allocation for loop activation context - ctxtLoop <- ctxtGuard.WithContinuation(ForLoop) - ForLoop ())) -#endif + [] + [] + type SuspendedAsync<'T>(ctxt: AsyncActivation<'T>) = - /// - Initial cancellation check - /// - Call syncCtxt.Post with exception protection. THis may fail as it is arbitrary user code - let CreateSwitchToAsync (syncCtxt: SynchronizationContext) = - MakeAsyncWithCancelCheck (fun ctxt -> - ctxt.PostWithTrampoline syncCtxt ctxt.cont) - - /// - Initial cancellation check - /// - Create Thread and call Start() with exception protection. We don't expect this - /// to fail but protect nevertheless. - let CreateSwitchToNewThreadAsync() = - MakeAsyncWithCancelCheck (fun ctxt -> - ctxt.ProtectCode (fun () -> ctxt.trampolineHolder.StartThreadWithTrampoline ctxt.cont)) - - /// - Initial cancellation check - /// - Call ThreadPool.QueueUserWorkItem with exception protection. We don't expect this - /// to fail but protect nevertheless. - let CreateSwitchToThreadPoolAsync() = - MakeAsyncWithCancelCheck (fun ctxt -> - ctxt.ProtectCode (fun () -> ctxt.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont)) - - /// Post back to the sync context regardless of which continuation is taken - /// - Call syncCtxt.Post with exception protection - let DelimitSyncContext (ctxt: AsyncActivation<_>) = - match SynchronizationContext.Current with - | null -> ctxt - | syncCtxt -> - ctxt.WithContinuations(cont = (fun x -> ctxt.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)), - econt = (fun edi -> ctxt.PostWithTrampoline syncCtxt (fun () -> ctxt.econt edi)), - ccont = (fun cexn -> ctxt.PostWithTrampoline syncCtxt (fun () -> ctxt.ccont cexn))) - - [] - [] - type SuspendedAsync<'T>(ctxt: AsyncActivation<'T>) = - - let syncCtxt = SynchronizationContext.Current - - let thread = - match syncCtxt with - | null -> null // saving a thread-local access - | _ -> Thread.CurrentThread - - let trampolineHolder = ctxt.trampolineHolder - - member _.ContinueImmediate res = - let action () = ctxt.cont res - let inline executeImmediately () = trampolineHolder.ExecuteWithTrampoline action - let currentSyncCtxt = SynchronizationContext.Current - match syncCtxt, currentSyncCtxt with - | null, null -> - executeImmediately () - // This logic was added in F# 2.0 though is incorrect from the perspective of - // how SynchronizationContext is meant to work. However the logic works for - // mainline scenarios (WinForms/WPF) and for compatibility reasons we won't change it. - | _ when Object.Equals(syncCtxt, currentSyncCtxt) && thread.Equals Thread.CurrentThread -> - executeImmediately () - | _ -> - trampolineHolder.PostOrQueueWithTrampoline syncCtxt action + let syncCtxt = SynchronizationContext.Current - member _.PostOrQueueWithTrampoline res = - trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> ctxt.cont res) + let thread = + match syncCtxt with + | null -> null // saving a thread-local access + | _ -> Thread.CurrentThread + + let trampolineHolder = ctxt.trampolineHolder + + member _.ContinueImmediate res = + let action () = ctxt.cont res + let inline executeImmediately () = trampolineHolder.ExecuteWithTrampoline action + let currentSyncCtxt = SynchronizationContext.Current + match syncCtxt, currentSyncCtxt with + | null, null -> + executeImmediately () + // This logic was added in F# 2.0 though is incorrect from the perspective of + // how SynchronizationContext is meant to work. However the logic works for + // mainline scenarios (WinForms/WPF) and for compatibility reasons we won't change it. + | _ when Object.Equals(syncCtxt, currentSyncCtxt) && thread.Equals Thread.CurrentThread -> + executeImmediately () + | _ -> + trampolineHolder.PostOrQueueWithTrampoline syncCtxt action - /// A utility type to provide a synchronization point between an asynchronous computation - /// and callers waiting on the result of that computation. - /// - /// Use with care! - [] - [] - type ResultCell<'T>() = + member _.PostOrQueueWithTrampoline res = + trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> ctxt.cont res) - let mutable result = None + /// A utility type to provide a synchronization point between an asynchronous computation + /// and callers waiting on the result of that computation. + /// + /// Use with care! + [] + [] + type ResultCell<'T>() = - // The continuations for the result - let mutable savedConts: SuspendedAsync<'T> list = [] + let mutable result = None - // The WaitHandle event for the result. Only created if needed, and set to null when disposed. - let mutable resEvent = null + // The continuations for the result + let mutable savedConts: SuspendedAsync<'T> list = [] - let mutable disposed = false + // The WaitHandle event for the result. Only created if needed, and set to null when disposed. + let mutable resEvent = null - // All writers of result are protected by lock on syncRoot. - let syncRoot = obj() + let mutable disposed = false - member x.GetWaitHandle() = - lock syncRoot (fun () -> - if disposed then - raise (System.ObjectDisposedException("ResultCell")) + // All writers of result are protected by lock on syncRoot. + let syncRoot = obj() + + member x.GetWaitHandle() = + lock syncRoot (fun () -> + if disposed then + raise (System.ObjectDisposedException("ResultCell")) + match resEvent with + | null -> + // Start in signalled state if a result is already present. + let ev = new ManualResetEvent(result.IsSome) + resEvent <- ev + (ev :> WaitHandle) + | ev -> + (ev :> WaitHandle)) + + member x.Close() = + lock syncRoot (fun () -> + if not disposed then + disposed <- true match resEvent with - | null -> - // Start in signalled state if a result is already present. - let ev = new ManualResetEvent(result.IsSome) - resEvent <- ev - (ev :> WaitHandle) + | null -> () | ev -> - (ev :> WaitHandle)) + ev.Close() + resEvent <- null) + + interface IDisposable with + member x.Dispose() = x.Close() + + member x.GrabResult() = + match result with + | Some res -> res + | None -> failwith "Unexpected no result" - member x.Close() = + /// Record the result in the ResultCell. + member x.RegisterResult (res:'T, reuseThread) = + let grabbedConts = lock syncRoot (fun () -> - if not disposed then - disposed <- true - match resEvent with - | null -> () - | ev -> - ev.Close() - resEvent <- null) - - interface IDisposable with - member x.Dispose() = x.Close() - - member x.GrabResult() = - match result with - | Some res -> res - | None -> failwith "Unexpected no result" - - /// Record the result in the ResultCell. - member x.RegisterResult (res:'T, reuseThread) = - let grabbedConts = - lock syncRoot (fun () -> - // Ignore multiple sets of the result. This can happen, e.g. for a race between a cancellation and a success - if x.ResultAvailable then - [] // invalidOp "multiple results registered for asynchronous operation" - else - // In this case the ResultCell has already been disposed, e.g. due to a timeout. - // The result is dropped on the floor. - if disposed then - [] - else - result <- Some res - // If the resEvent exists then set it. If not we can skip setting it altogether and it won't be - // created - match resEvent with - | null -> - () - | ev -> - // Setting the event need to happen under lock so as not to race with Close() - ev.Set () |> ignore - List.rev savedConts) - - // Run the action outside the lock - match grabbedConts with - | [] -> fake() - | [cont] -> - if reuseThread then - cont.ContinueImmediate res + // Ignore multiple sets of the result. This can happen, e.g. for a race between a cancellation and a success + if x.ResultAvailable then + [] // invalidOp "multiple results registered for asynchronous operation" else - cont.PostOrQueueWithTrampoline res - | otherwise -> - otherwise |> List.iter (fun cont -> cont.PostOrQueueWithTrampoline res |> unfake) |> fake - - member x.ResultAvailable = result.IsSome - - /// Await the result of a result cell, without a direct timeout or direct - /// cancellation. That is, the underlying computation must fill the result - /// if cancellation or timeout occurs. - member x.AwaitResult_NoDirectCancelOrTimeout = - MakeAsync (fun ctxt -> - // Check if a result is available synchronously - let resOpt = - match result with - | Some _ -> result - | None -> - lock syncRoot (fun () -> - match result with - | Some _ -> - result - | None -> - // Otherwise save the continuation and call it in RegisterResult - savedConts <- (SuspendedAsync<_>(ctxt)) :: savedConts - None - ) - match resOpt with - | Some res -> ctxt.cont res - | None -> fake() - ) + // In this case the ResultCell has already been disposed, e.g. due to a timeout. + // The result is dropped on the floor. + if disposed then + [] + else + result <- Some res + // If the resEvent exists then set it. If not we can skip setting it altogether and it won't be + // created + match resEvent with + | null -> + () + | ev -> + // Setting the event need to happen under lock so as not to race with Close() + ev.Set () |> ignore + List.rev savedConts) + + // Run the action outside the lock + match grabbedConts with + | [] -> fake() + | [cont] -> + if reuseThread then + cont.ContinueImmediate res + else + cont.PostOrQueueWithTrampoline res + | otherwise -> + otherwise |> List.iter (fun cont -> cont.PostOrQueueWithTrampoline res |> unfake) |> fake - member x.TryWaitForResultSynchronously (?timeout) : 'T option = - // Check if a result is available. + member x.ResultAvailable = result.IsSome + + /// Await the result of a result cell, without a direct timeout or direct + /// cancellation. That is, the underlying computation must fill the result + /// if cancellation or timeout occurs. + member x.AwaitResult_NoDirectCancelOrTimeout = + MakeAsync (fun ctxt -> + // Check if a result is available synchronously + let resOpt = + match result with + | Some _ -> result + | None -> + lock syncRoot (fun () -> + match result with + | Some _ -> + result + | None -> + // Otherwise save the continuation and call it in RegisterResult + savedConts <- (SuspendedAsync<_>(ctxt)) :: savedConts + None + ) + match resOpt with + | Some res -> ctxt.cont res + | None -> fake() + ) + + member x.TryWaitForResultSynchronously (?timeout) : 'T option = + // Check if a result is available. + match result with + | Some _ as r -> + r + | None -> + // Force the creation of the WaitHandle + let resHandle = x.GetWaitHandle() + // Check again. While we were in GetWaitHandle, a call to RegisterResult may have set result then skipped the + // Set because the resHandle wasn't forced. match result with | Some _ as r -> r | None -> - // Force the creation of the WaitHandle - let resHandle = x.GetWaitHandle() - // Check again. While we were in GetWaitHandle, a call to RegisterResult may have set result then skipped the - // Set because the resHandle wasn't forced. - match result with - | Some _ as r -> - r - | None -> - // OK, let's really wait for the Set signal. This may block. - let timeout = defaultArg timeout Threading.Timeout.Infinite - let ok = resHandle.WaitOne(millisecondsTimeout= timeout, exitContext=true) - if ok then - // Now the result really must be available - result - else - // timed out - None - - - /// Create an instance of an arbitrary delegate type delegating to the given F# function - type FuncDelegate<'T>(f) = - member _.Invoke(sender:obj, a:'T) : unit = ignore sender; f a - static member Create<'Delegate when 'Delegate :> Delegate>(f) = - let obj = FuncDelegate<'T>(f) - let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) - System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate - - [] - let QueueAsync cancellationToken cont econt ccont computation = - let trampolineHolder = TrampolineHolder() - trampolineHolder.QueueWorkItemWithTrampoline (fun () -> - let ctxt = AsyncActivation.Create cancellationToken trampolineHolder cont econt ccont - computation.Invoke ctxt) - - /// Run the asynchronous workflow and wait for its result. - [] - let QueueAsyncAndWaitForResultSynchronously (token:CancellationToken) computation timeout = - let token, innerCTS = - // If timeout is provided, we govern the async by our own CTS, to cancel - // when execution times out. Otherwise, the user-supplied token governs the async. - match timeout with - | None -> token, None - | Some _ -> - let subSource = new LinkedSubSource(token) - subSource.Token, Some subSource - - use resultCell = new ResultCell>() - QueueAsync - token - (fun res -> resultCell.RegisterResult(AsyncResult.Ok res, reuseThread=true)) - (fun edi -> resultCell.RegisterResult(AsyncResult.Error edi, reuseThread=true)) - (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled exn, reuseThread=true)) - computation - |> unfake - - let res = resultCell.TryWaitForResultSynchronously(?timeout = timeout) - match res with - | None -> // timed out - // issue cancellation signal - if innerCTS.IsSome then innerCTS.Value.Cancel() - // wait for computation to quiesce; drop result on the floor - resultCell.TryWaitForResultSynchronously() |> ignore - // dispose the CancellationTokenSource - if innerCTS.IsSome then innerCTS.Value.Dispose() - raise (System.TimeoutException()) - | Some res -> - match innerCTS with - | Some subSource -> subSource.Dispose() - | None -> () - res.Commit() - - [] - let RunImmediate (cancellationToken:CancellationToken) computation = - use resultCell = new ResultCell>() - let trampolineHolder = TrampolineHolder() - - trampolineHolder.ExecuteWithTrampoline (fun () -> - let ctxt = - AsyncActivation.Create - cancellationToken - trampolineHolder - (fun res -> resultCell.RegisterResult(AsyncResult.Ok res, reuseThread=true)) - (fun edi -> resultCell.RegisterResult(AsyncResult.Error edi, reuseThread=true)) - (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled exn, reuseThread=true)) - computation.Invoke ctxt) - |> unfake - - let res = resultCell.TryWaitForResultSynchronously().Value - res.Commit() - - [] - let RunSynchronously cancellationToken (computation: Async<'T>) timeout = - // Reuse the current ThreadPool thread if possible. - match SynchronizationContext.Current, Thread.CurrentThread.IsThreadPoolThread, timeout with - | null, true, None -> RunImmediate cancellationToken computation - | _ -> QueueAsyncAndWaitForResultSynchronously cancellationToken computation timeout - - [] - let Start cancellationToken (computation:Async) = - QueueAsync - cancellationToken - (fun () -> fake()) // nothing to do on success - (fun edi -> edi.ThrowAny()) // raise exception in child - (fun _ -> fake()) // ignore cancellation in child - computation - |> unfake - - [] - let StartWithContinuations cancellationToken (computation:Async<'T>) cont econt ccont = - let trampolineHolder = TrampolineHolder() - trampolineHolder.ExecuteWithTrampoline (fun () -> - let ctxt = AsyncActivation.Create cancellationToken trampolineHolder (cont >> fake) (econt >> fake) (ccont >> fake) - computation.Invoke ctxt) - |> unfake - - [] - let StartAsTask cancellationToken (computation:Async<'T>) taskCreationOptions = - let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None - let tcs = TaskCompletionSource<_>(taskCreationOptions) - - // The contract: - // a) cancellation signal should always propagate to the computation - // b) when the task IsCompleted -> nothing is running anymore - let task = tcs.Task - QueueAsync - cancellationToken - (fun r -> tcs.SetResult r |> fake) - (fun edi -> tcs.SetException edi.SourceException |> fake) - (fun _ -> tcs.SetCanceled() |> fake) - computation - |> unfake - task - - // Call the appropriate continuation on completion of a task - [] - let OnTaskCompleted (completedTask: Task<'T>) (ctxt: AsyncActivation<'T>) = - assert completedTask.IsCompleted - if completedTask.IsCanceled then - let edi = ExceptionDispatchInfo.Capture(TaskCanceledException completedTask) - ctxt.econt edi - elif completedTask.IsFaulted then - let edi = ExceptionDispatchInfo.RestoreOrCapture completedTask.Exception - ctxt.econt edi - else - ctxt.cont completedTask.Result - - // Call the appropriate continuation on completion of a task. A cancelled task - // calls the exception continuation with TaskCanceledException, since it may not represent cancellation of - // the overall async (they may be governed by different cancellation tokens, or - // the task may not have a cancellation token at all). - [] - let OnUnitTaskCompleted (completedTask: Task) (ctxt: AsyncActivation) = - assert completedTask.IsCompleted - if completedTask.IsCanceled then - let edi = ExceptionDispatchInfo.Capture(TaskCanceledException(completedTask)) - ctxt.econt edi - elif completedTask.IsFaulted then - let edi = ExceptionDispatchInfo.RestoreOrCapture completedTask.Exception - ctxt.econt edi - else - ctxt.cont () - - // Helper to attach continuation to the given task, which is assumed not to be completed. - // When the task completes the continuation will be run synchronously on the thread - // completing the task. This will install a new trampoline on that thread and continue the - // execution of the async there. - [] - let AttachContinuationToTask (task: Task<'T>) (ctxt: AsyncActivation<'T>) = - task.ContinueWith(Action>(fun completedTask -> - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> - OnTaskCompleted completedTask ctxt) - |> unfake), TaskContinuationOptions.ExecuteSynchronously) - |> ignore - |> fake - - // Helper to attach continuation to the given task, which is assumed not to be completed - // When the task completes the continuation will be run synchronously on the thread - // completing the task. This will install a new trampoline on that thread and continue the - // execution of the async there. - [] - let AttachContinuationToUnitTask (task: Task) (ctxt: AsyncActivation) = - task.ContinueWith(Action(fun completedTask -> - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> - OnUnitTaskCompleted completedTask ctxt) - |> unfake), TaskContinuationOptions.ExecuteSynchronously) - |> ignore - |> fake - - /// Removes a registration places on a cancellation token - let DisposeCancellationRegistration (registration: byref) = - match registration with - | Some r -> - registration <- None - r.Dispose() - | None -> () - - /// Cleans up a Timer, helper for Async.Sleep - let DisposeTimer (timer: byref) = - match timer with - | None -> () - | Some t -> - timer <- None - t.Dispose() - - /// Unregisters a RegisteredWaitHandle, helper for AwaitWaitHandle - let UnregisterWaitHandle (rwh: byref) = - match rwh with - | None -> () - | Some r -> - r.Unregister null |> ignore - rwh <- None - - /// Unregisters a delegate handler, helper for AwaitEvent - let RemoveHandler (event: IEvent<_, _>) (del: byref<'Delegate option>) = - match del with - | Some d -> - del <- None - event.RemoveHandler d + // OK, let's really wait for the Set signal. This may block. + let timeout = defaultArg timeout Threading.Timeout.Infinite + let ok = resHandle.WaitOne(millisecondsTimeout= timeout, exitContext=true) + if ok then + // Now the result really must be available + result + else + // timed out + None + + + /// Create an instance of an arbitrary delegate type delegating to the given F# function + type FuncDelegate<'T>(f) = + member _.Invoke(sender:obj, a:'T) : unit = ignore sender; f a + static member Create<'Delegate when 'Delegate :> Delegate>(f) = + let obj = FuncDelegate<'T>(f) + let invokeMeth = (typeof>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance) + System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate + + [] + let QueueAsync cancellationToken cont econt ccont computation = + let trampolineHolder = TrampolineHolder() + trampolineHolder.QueueWorkItemWithTrampoline (fun () -> + let ctxt = AsyncActivation.Create cancellationToken trampolineHolder cont econt ccont + computation.Invoke ctxt) + + /// Run the asynchronous workflow and wait for its result. + [] + let QueueAsyncAndWaitForResultSynchronously (token:CancellationToken) computation timeout = + let token, innerCTS = + // If timeout is provided, we govern the async by our own CTS, to cancel + // when execution times out. Otherwise, the user-supplied token governs the async. + match timeout with + | None -> token, None + | Some _ -> + let subSource = new LinkedSubSource(token) + subSource.Token, Some subSource + + use resultCell = new ResultCell>() + QueueAsync + token + (fun res -> resultCell.RegisterResult(AsyncResult.Ok res, reuseThread=true)) + (fun edi -> resultCell.RegisterResult(AsyncResult.Error edi, reuseThread=true)) + (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled exn, reuseThread=true)) + computation + |> unfake + + let res = resultCell.TryWaitForResultSynchronously(?timeout = timeout) + match res with + | None -> // timed out + // issue cancellation signal + if innerCTS.IsSome then innerCTS.Value.Cancel() + // wait for computation to quiesce; drop result on the floor + resultCell.TryWaitForResultSynchronously() |> ignore + // dispose the CancellationTokenSource + if innerCTS.IsSome then innerCTS.Value.Dispose() + raise (System.TimeoutException()) + | Some res -> + match innerCTS with + | Some subSource -> subSource.Dispose() | None -> () + res.Commit() - [] - type AsyncIAsyncResult<'T>(callback: System.AsyncCallback, state:obj) = - // This gets set to false if the result is not available by the - // time the IAsyncResult is returned to the caller of Begin - let mutable completedSynchronously = true - - let mutable disposed = false - - let cts = new CancellationTokenSource() - - let result = new ResultCell>() - - member s.SetResult(v: AsyncResult<'T>) = - result.RegisterResult(v, reuseThread=true) |> unfake - match callback with - | null -> () - | d -> - // The IASyncResult becomes observable here - d.Invoke (s :> System.IAsyncResult) - - member s.GetResult() = - match result.TryWaitForResultSynchronously (-1) with - | Some (AsyncResult.Ok v) -> v - | Some (AsyncResult.Error edi) -> edi.ThrowAny() - | Some (AsyncResult.Canceled err) -> raise err - | None -> failwith "unreachable" - - member x.IsClosed = disposed - - member x.Close() = - if not disposed then - disposed <- true - cts.Dispose() - result.Close() - - member x.Token = cts.Token - - member x.CancelAsync() = cts.Cancel() - - member x.CheckForNotSynchronous() = - if not result.ResultAvailable then - completedSynchronously <- false - - interface System.IAsyncResult with - member _.IsCompleted = result.ResultAvailable - member _.CompletedSynchronously = completedSynchronously - member _.AsyncWaitHandle = result.GetWaitHandle() - member _.AsyncState = state - - interface System.IDisposable with - member x.Dispose() = x.Close() - - module AsBeginEndHelpers = - let beginAction (computation, callback, state) = - let aiar = new AsyncIAsyncResult<'T>(callback, state) - let cont res = aiar.SetResult (AsyncResult.Ok res) - let econt edi = aiar.SetResult (AsyncResult.Error edi) - let ccont cexn = aiar.SetResult (AsyncResult.Canceled cexn) - StartWithContinuations aiar.Token computation cont econt ccont - aiar.CheckForNotSynchronous() - (aiar :> IAsyncResult) - - let endAction<'T> (iar:IAsyncResult) = - match iar with - | :? AsyncIAsyncResult<'T> as aiar -> - if aiar.IsClosed then - raise (System.ObjectDisposedException("AsyncResult")) - else - let res = aiar.GetResult() - aiar.Close () - res - | _ -> - invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) + [] + let RunImmediate (cancellationToken:CancellationToken) computation = + use resultCell = new ResultCell>() + let trampolineHolder = TrampolineHolder() + + trampolineHolder.ExecuteWithTrampoline (fun () -> + let ctxt = + AsyncActivation.Create + cancellationToken + trampolineHolder + (fun res -> resultCell.RegisterResult(AsyncResult.Ok res, reuseThread=true)) + (fun edi -> resultCell.RegisterResult(AsyncResult.Error edi, reuseThread=true)) + (fun exn -> resultCell.RegisterResult(AsyncResult.Canceled exn, reuseThread=true)) + computation.Invoke ctxt) + |> unfake + + let res = resultCell.TryWaitForResultSynchronously().Value + res.Commit() + + [] + let RunSynchronously cancellationToken (computation: Async<'T>) timeout = + // Reuse the current ThreadPool thread if possible. + match SynchronizationContext.Current, Thread.CurrentThread.IsThreadPoolThread, timeout with + | null, true, None -> RunImmediate cancellationToken computation + | _ -> QueueAsyncAndWaitForResultSynchronously cancellationToken computation timeout + + [] + let Start cancellationToken (computation:Async) = + QueueAsync + cancellationToken + (fun () -> fake()) // nothing to do on success + (fun edi -> edi.ThrowAny()) // raise exception in child + (fun _ -> fake()) // ignore cancellation in child + computation + |> unfake + + [] + let StartWithContinuations cancellationToken (computation:Async<'T>) cont econt ccont = + let trampolineHolder = TrampolineHolder() + trampolineHolder.ExecuteWithTrampoline (fun () -> + let ctxt = AsyncActivation.Create cancellationToken trampolineHolder (cont >> fake) (econt >> fake) (ccont >> fake) + computation.Invoke ctxt) + |> unfake + + [] + let StartAsTask cancellationToken (computation:Async<'T>) taskCreationOptions = + let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None + let tcs = TaskCompletionSource<_>(taskCreationOptions) + + // The contract: + // a) cancellation signal should always propagate to the computation + // b) when the task IsCompleted -> nothing is running anymore + let task = tcs.Task + QueueAsync + cancellationToken + (fun r -> tcs.SetResult r |> fake) + (fun edi -> tcs.SetException edi.SourceException |> fake) + (fun _ -> tcs.SetCanceled() |> fake) + computation + |> unfake + task + + // Call the appropriate continuation on completion of a task + [] + let OnTaskCompleted (completedTask: Task<'T>) (ctxt: AsyncActivation<'T>) = + assert completedTask.IsCompleted + if completedTask.IsCanceled then + let edi = ExceptionDispatchInfo.Capture(TaskCanceledException completedTask) + ctxt.econt edi + elif completedTask.IsFaulted then + let edi = ExceptionDispatchInfo.RestoreOrCapture completedTask.Exception + ctxt.econt edi + else + ctxt.cont completedTask.Result + + // Call the appropriate continuation on completion of a task. A cancelled task + // calls the exception continuation with TaskCanceledException, since it may not represent cancellation of + // the overall async (they may be governed by different cancellation tokens, or + // the task may not have a cancellation token at all). + [] + let OnUnitTaskCompleted (completedTask: Task) (ctxt: AsyncActivation) = + assert completedTask.IsCompleted + if completedTask.IsCanceled then + let edi = ExceptionDispatchInfo.Capture(TaskCanceledException(completedTask)) + ctxt.econt edi + elif completedTask.IsFaulted then + let edi = ExceptionDispatchInfo.RestoreOrCapture completedTask.Exception + ctxt.econt edi + else + ctxt.cont () + + // Helper to attach continuation to the given task, which is assumed not to be completed. + // When the task completes the continuation will be run synchronously on the thread + // completing the task. This will install a new trampoline on that thread and continue the + // execution of the async there. + [] + let AttachContinuationToTask (task: Task<'T>) (ctxt: AsyncActivation<'T>) = + task.ContinueWith(Action>(fun completedTask -> + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> + OnTaskCompleted completedTask ctxt) + |> unfake), TaskContinuationOptions.ExecuteSynchronously) + |> ignore + |> fake + + // Helper to attach continuation to the given task, which is assumed not to be completed + // When the task completes the continuation will be run synchronously on the thread + // completing the task. This will install a new trampoline on that thread and continue the + // execution of the async there. + [] + let AttachContinuationToUnitTask (task: Task) (ctxt: AsyncActivation) = + task.ContinueWith(Action(fun completedTask -> + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> + OnUnitTaskCompleted completedTask ctxt) + |> unfake), TaskContinuationOptions.ExecuteSynchronously) + |> ignore + |> fake + + /// Removes a registration places on a cancellation token + let DisposeCancellationRegistration (registration: byref) = + match registration with + | Some r -> + registration <- None + r.Dispose() + | None -> () + + /// Cleans up a Timer, helper for Async.Sleep + let DisposeTimer (timer: byref) = + match timer with + | None -> () + | Some t -> + timer <- None + t.Dispose() + + /// Unregisters a RegisteredWaitHandle, helper for AwaitWaitHandle + let UnregisterWaitHandle (rwh: byref) = + match rwh with + | None -> () + | Some r -> + r.Unregister null |> ignore + rwh <- None + + /// Unregisters a delegate handler, helper for AwaitEvent + let RemoveHandler (event: IEvent<_, _>) (del: byref<'Delegate option>) = + match del with + | Some d -> + del <- None + event.RemoveHandler d + | None -> () + + [] + type AsyncIAsyncResult<'T>(callback: System.AsyncCallback, state:obj) = + // This gets set to false if the result is not available by the + // time the IAsyncResult is returned to the caller of Begin + let mutable completedSynchronously = true + + let mutable disposed = false + + let cts = new CancellationTokenSource() + + let result = new ResultCell>() + + member s.SetResult(v: AsyncResult<'T>) = + result.RegisterResult(v, reuseThread=true) |> unfake + match callback with + | null -> () + | d -> + // The IASyncResult becomes observable here + d.Invoke (s :> System.IAsyncResult) + + member s.GetResult() = + match result.TryWaitForResultSynchronously (-1) with + | Some (AsyncResult.Ok v) -> v + | Some (AsyncResult.Error edi) -> edi.ThrowAny() + | Some (AsyncResult.Canceled err) -> raise err + | None -> failwith "unreachable" + + member x.IsClosed = disposed + + member x.Close() = + if not disposed then + disposed <- true + cts.Dispose() + result.Close() + + member x.Token = cts.Token + + member x.CancelAsync() = cts.Cancel() + + member x.CheckForNotSynchronous() = + if not result.ResultAvailable then + completedSynchronously <- false + + interface System.IAsyncResult with + member _.IsCompleted = result.ResultAvailable + member _.CompletedSynchronously = completedSynchronously + member _.AsyncWaitHandle = result.GetWaitHandle() + member _.AsyncState = state + + interface System.IDisposable with + member x.Dispose() = x.Close() + + module AsBeginEndHelpers = + let beginAction (computation, callback, state) = + let aiar = new AsyncIAsyncResult<'T>(callback, state) + let cont res = aiar.SetResult (AsyncResult.Ok res) + let econt edi = aiar.SetResult (AsyncResult.Error edi) + let ccont cexn = aiar.SetResult (AsyncResult.Canceled cexn) + StartWithContinuations aiar.Token computation cont econt ccont + aiar.CheckForNotSynchronous() + (aiar :> IAsyncResult) + + let endAction<'T> (iar:IAsyncResult) = + match iar with + | :? AsyncIAsyncResult<'T> as aiar -> + if aiar.IsClosed then + raise (System.ObjectDisposedException("AsyncResult")) + else + let res = aiar.GetResult() + aiar.Close () + res + | _ -> + invalidArg "iar" (SR.GetString(SR.mismatchIAREnd)) - let cancelAction<'T>(iar:IAsyncResult) = - match iar with - | :? AsyncIAsyncResult<'T> as aiar -> - aiar.CancelAsync() - | _ -> - invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) + let cancelAction<'T>(iar:IAsyncResult) = + match iar with + | :? AsyncIAsyncResult<'T> as aiar -> + aiar.CancelAsync() + | _ -> + invalidArg "iar" (SR.GetString(SR.mismatchIARCancel)) - open AsyncPrimitives +open AsyncPrimitives - [] - type AsyncBuilder() = - member _.Zero () = unitAsync +[] +type AsyncBuilder() = + member _.Zero () = unitAsync - member _.Delay generator = CreateDelayAsync generator + member _.Delay generator = CreateDelayAsync generator - member inline _.Return value = CreateReturnAsync value + member inline _.Return value = CreateReturnAsync value - member inline _.ReturnFrom (computation:Async<_>) = computation + member inline _.ReturnFrom (computation:Async<_>) = computation - member inline _.Bind (computation, binder) = CreateBindAsync computation binder + member inline _.Bind (computation, binder) = CreateBindAsync computation binder - member _.Using (resource, binder) = CreateUsingAsync resource binder + member _.Using (resource, binder) = CreateUsingAsync resource binder - member _.While (guard, computation) = CreateWhileAsync guard computation + member _.While (guard, computation) = CreateWhileAsync guard computation - member _.For (sequence, body) = CreateForLoopAsync sequence body + member _.For (sequence, body) = CreateForLoopAsync sequence body - member inline _.Combine (computation1, computation2) = CreateSequentialAsync computation1 computation2 + member inline _.Combine (computation1, computation2) = CreateSequentialAsync computation1 computation2 - member inline _.TryFinally (computation, compensation) = CreateTryFinallyAsync compensation computation + member inline _.TryFinally (computation, compensation) = CreateTryFinallyAsync compensation computation - member inline _.TryWith (computation, catchHandler) = CreateTryWithAsync catchHandler computation + member inline _.TryWith (computation, catchHandler) = CreateTryWithAsync catchHandler computation - // member inline _.TryWithFilter (computation, catchHandler) = CreateTryWithFilterAsync catchHandler computation + // member inline _.TryWithFilter (computation, catchHandler) = CreateTryWithFilterAsync catchHandler computation - [] - module AsyncBuilderImpl = - let async = AsyncBuilder() +[] +module AsyncBuilderImpl = + let async = AsyncBuilder() - [] - type Async = +[] +type Async = - static member CancellationToken = cancellationTokenAsync + static member CancellationToken = cancellationTokenAsync - static member CancelCheck () = unitAsync + static member CancelCheck () = unitAsync - static member FromContinuations (callback: ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> = - MakeAsyncWithCancelCheck (fun ctxt -> - let mutable underCurrentThreadStack = true - let mutable contToTailCall = None - let thread = Thread.CurrentThread - let latch = Latch() - let once cont x = - if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) - if Thread.CurrentThread.Equals thread && underCurrentThreadStack then - contToTailCall <- Some(fun () -> cont x) - elif Trampoline.ThisThreadHasTrampoline then - let syncCtxt = SynchronizationContext.Current - ctxt.trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> cont x) |> unfake - else - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake + static member FromContinuations (callback: ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> = + MakeAsyncWithCancelCheck (fun ctxt -> + let mutable underCurrentThreadStack = true + let mutable contToTailCall = None + let thread = Thread.CurrentThread + let latch = Latch() + let once cont x = + if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) + if Thread.CurrentThread.Equals thread && underCurrentThreadStack then + contToTailCall <- Some(fun () -> cont x) + elif Trampoline.ThisThreadHasTrampoline then + let syncCtxt = SynchronizationContext.Current + ctxt.trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> cont x) |> unfake + else + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake + try + callback (once ctxt.cont, (fun exn -> once ctxt.econt (ExceptionDispatchInfo.RestoreOrCapture exn)), once ctxt.ccont) + with exn -> + if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) + let edi = ExceptionDispatchInfo.RestoreOrCapture exn + ctxt.econt edi |> unfake + + underCurrentThreadStack <- false + + match contToTailCall with + | Some k -> k() + | _ -> fake()) + + static member DefaultCancellationToken = defaultCancellationTokenSource.Token + + static member CancelDefaultToken() = + let cts = defaultCancellationTokenSource + // set new CancellationTokenSource before calling Cancel - otherwise if Cancel throws token will stay unchanged + defaultCancellationTokenSource <- new CancellationTokenSource() + cts.Cancel() + // we do not dispose the old default CTS - let GC collect it + + static member Catch (computation: Async<'T>) = + MakeAsync (fun ctxt -> + // Turn the success or exception into data + let newCtxt = ctxt.WithContinuations(cont = (fun res -> ctxt.cont (Choice1Of2 res)), + econt = (fun edi -> ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())))) + computation.Invoke newCtxt) + + static member RunSynchronously (computation: Async<'T>, ?timeout, ?cancellationToken:CancellationToken) = + let timeout, cancellationToken = + match cancellationToken with + | None -> timeout, defaultCancellationTokenSource.Token + | Some token when not token.CanBeCanceled -> timeout, token + | Some token -> None, token + AsyncPrimitives.RunSynchronously cancellationToken computation timeout + + static member Start (computation, ?cancellationToken) = + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.Start cancellationToken computation + + static member StartAsTask (computation, ?taskCreationOptions, ?cancellationToken)= + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions + + static member StartChildAsTask (computation, ?taskCreationOptions) = + async { + let! cancellationToken = cancellationTokenAsync + return AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions + } + + static member Parallel (computations: seq>) = + Async.Parallel(computations, ?maxDegreeOfParallelism=None) + + static member Parallel (computations: seq>, ?maxDegreeOfParallelism: int) = + match maxDegreeOfParallelism with + | Some x when x < 1 -> raise(System.ArgumentException(String.Format(SR.GetString(SR.maxDegreeOfParallelismNotPositive), x), "maxDegreeOfParallelism")) + | _ -> () + + MakeAsyncWithCancelCheck (fun ctxt -> + // manually protect eval of seq + let result = try - callback (once ctxt.cont, (fun exn -> once ctxt.econt (ExceptionDispatchInfo.RestoreOrCapture exn)), once ctxt.ccont) + Choice1Of2 (Seq.toArray computations) with exn -> - if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) - let edi = ExceptionDispatchInfo.RestoreOrCapture exn - ctxt.econt edi |> unfake - - underCurrentThreadStack <- false - - match contToTailCall with - | Some k -> k() - | _ -> fake()) - - static member DefaultCancellationToken = defaultCancellationTokenSource.Token - - static member CancelDefaultToken() = - let cts = defaultCancellationTokenSource - // set new CancellationTokenSource before calling Cancel - otherwise if Cancel throws token will stay unchanged - defaultCancellationTokenSource <- new CancellationTokenSource() - cts.Cancel() - // we do not dispose the old default CTS - let GC collect it - - static member Catch (computation: Async<'T>) = - MakeAsync (fun ctxt -> - // Turn the success or exception into data - let newCtxt = ctxt.WithContinuations(cont = (fun res -> ctxt.cont (Choice1Of2 res)), - econt = (fun edi -> ctxt.cont (Choice2Of2 (edi.GetAssociatedSourceException())))) - computation.Invoke newCtxt) - - static member RunSynchronously (computation: Async<'T>, ?timeout, ?cancellationToken:CancellationToken) = - let timeout, cancellationToken = - match cancellationToken with - | None -> timeout, defaultCancellationTokenSource.Token - | Some token when not token.CanBeCanceled -> timeout, token - | Some token -> None, token - AsyncPrimitives.RunSynchronously cancellationToken computation timeout - - static member Start (computation, ?cancellationToken) = - let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.Start cancellationToken computation - - static member StartAsTask (computation, ?taskCreationOptions, ?cancellationToken)= - let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions - - static member StartChildAsTask (computation, ?taskCreationOptions) = - async { - let! cancellationToken = cancellationTokenAsync - return AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions - } - - static member Parallel (computations: seq>) = - Async.Parallel(computations, ?maxDegreeOfParallelism=None) + Choice2Of2 (ExceptionDispatchInfo.RestoreOrCapture exn) + + match result with + | Choice2Of2 edi -> ctxt.econt edi + | Choice1Of2 [| |] -> ctxt.cont [| |] + | Choice1Of2 computations -> + ctxt.ProtectCode (fun () -> + let ctxt = DelimitSyncContext ctxt // manually resync + let mutable count = computations.Length + let mutable firstExn = None + let results = Array.zeroCreate computations.Length + // Attempt to cancel the individual operations if an exception happens on any of the other threads + let innerCTS = new LinkedSubSource(ctxt.token) + + let finishTask remaining = + if (remaining = 0) then + innerCTS.Dispose() + match firstExn with + | None -> ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont results) + | Some (Choice1Of2 exn) -> ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.econt exn) + | Some (Choice2Of2 cexn) -> ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont cexn) + else + fake() - static member Parallel (computations: seq>, ?maxDegreeOfParallelism: int) = - match maxDegreeOfParallelism with - | Some x when x < 1 -> raise(System.ArgumentException(String.Format(SR.GetString(SR.maxDegreeOfParallelismNotPositive), x), "maxDegreeOfParallelism")) - | _ -> () + // recordSuccess and recordFailure between them decrement count to 0 and + // as soon as 0 is reached dispose innerCancellationSource - MakeAsyncWithCancelCheck (fun ctxt -> - // manually protect eval of seq - let result = - try - Choice1Of2 (Seq.toArray computations) - with exn -> - Choice2Of2 (ExceptionDispatchInfo.RestoreOrCapture exn) + let recordSuccess i res = + results.[i] <- res + finishTask(Interlocked.Decrement &count) - match result with - | Choice2Of2 edi -> ctxt.econt edi - | Choice1Of2 [| |] -> ctxt.cont [| |] - | Choice1Of2 computations -> - ctxt.ProtectCode (fun () -> - let ctxt = DelimitSyncContext ctxt // manually resync - let mutable count = computations.Length - let mutable firstExn = None - let results = Array.zeroCreate computations.Length - // Attempt to cancel the individual operations if an exception happens on any of the other threads - let innerCTS = new LinkedSubSource(ctxt.token) - - let finishTask remaining = - if (remaining = 0) then - innerCTS.Dispose() - match firstExn with - | None -> ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont results) - | Some (Choice1Of2 exn) -> ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.econt exn) - | Some (Choice2Of2 cexn) -> ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont cexn) - else - fake() - - // recordSuccess and recordFailure between them decrement count to 0 and - // as soon as 0 is reached dispose innerCancellationSource - - let recordSuccess i res = - results.[i] <- res - finishTask(Interlocked.Decrement &count) - - let recordFailure exn = - // capture first exception and then decrement the counter to avoid race when - // - thread 1 decremented counter and preempted by the scheduler - // - thread 2 decremented counter and called finishTask - // since exception is not yet captured - finishtask will fall into success branch - match Interlocked.CompareExchange(&firstExn, Some exn, None) with - | None -> - // signal cancellation before decrementing the counter - this guarantees that no other thread can sneak to finishTask and dispose innerCTS - // NOTE: Cancel may introduce reentrancy - i.e. when handler registered for the cancellation token invokes cancel continuation that will call 'recordFailure' - // to correctly handle this we need to return decremented value, not the current value of 'count' otherwise we may invoke finishTask with value '0' several times - innerCTS.Cancel() - | _ -> () - finishTask(Interlocked.Decrement &count) - - // If maxDegreeOfParallelism is set but is higher then the number of tasks we have we set it back to None to fall into the simple - // queue all items branch - let maxDegreeOfParallelism = - match maxDegreeOfParallelism with - | None -> None - | Some x when x >= computations.Length -> None - | Some _ as x -> x - - // Simple case (no maxDegreeOfParallelism) just queue all the work, if we have maxDegreeOfParallelism set we start that many workers - // which will make progress on the actual computations - match maxDegreeOfParallelism with + let recordFailure exn = + // capture first exception and then decrement the counter to avoid race when + // - thread 1 decremented counter and preempted by the scheduler + // - thread 2 decremented counter and called finishTask + // since exception is not yet captured - finishtask will fall into success branch + match Interlocked.CompareExchange(&firstExn, Some exn, None) with | None -> - computations |> Array.iteri (fun i p -> - QueueAsync - innerCTS.Token - // on success, record the result - (fun res -> recordSuccess i res) - // on exception... - (fun edi -> recordFailure (Choice1Of2 edi)) - // on cancellation... - (fun cexn -> recordFailure (Choice2Of2 cexn)) - p - |> unfake) - | Some maxDegreeOfParallelism -> - let mutable i = -1 - let rec worker (trampolineHolder : TrampolineHolder) = - if i < computations.Length then - let j = Interlocked.Increment &i - if j < computations.Length then - if innerCTS.Token.IsCancellationRequested then - let cexn = OperationCanceledException (innerCTS.Token) - recordFailure (Choice2Of2 cexn) |> unfake - worker trampolineHolder |> unfake - else - let taskCtxt = - AsyncActivation.Create - innerCTS.Token - trampolineHolder - (fun res -> recordSuccess j res |> unfake; worker trampolineHolder) - (fun edi -> recordFailure (Choice1Of2 edi) |> unfake; worker trampolineHolder) - (fun cexn -> recordFailure (Choice2Of2 cexn) |> unfake; worker trampolineHolder) - computations.[j].Invoke taskCtxt |> unfake - fake() - for x = 1 to maxDegreeOfParallelism do - let trampolineHolder = TrampolineHolder() - trampolineHolder.QueueWorkItemWithTrampoline (fun () -> - worker trampolineHolder) - |> unfake + // signal cancellation before decrementing the counter - this guarantees that no other thread can sneak to finishTask and dispose innerCTS + // NOTE: Cancel may introduce reentrancy - i.e. when handler registered for the cancellation token invokes cancel continuation that will call 'recordFailure' + // to correctly handle this we need to return decremented value, not the current value of 'count' otherwise we may invoke finishTask with value '0' several times + innerCTS.Cancel() + | _ -> () + finishTask(Interlocked.Decrement &count) + + // If maxDegreeOfParallelism is set but is higher then the number of tasks we have we set it back to None to fall into the simple + // queue all items branch + let maxDegreeOfParallelism = + match maxDegreeOfParallelism with + | None -> None + | Some x when x >= computations.Length -> None + | Some _ as x -> x - fake())) + // Simple case (no maxDegreeOfParallelism) just queue all the work, if we have maxDegreeOfParallelism set we start that many workers + // which will make progress on the actual computations + match maxDegreeOfParallelism with + | None -> + computations |> Array.iteri (fun i p -> + QueueAsync + innerCTS.Token + // on success, record the result + (fun res -> recordSuccess i res) + // on exception... + (fun edi -> recordFailure (Choice1Of2 edi)) + // on cancellation... + (fun cexn -> recordFailure (Choice2Of2 cexn)) + p + |> unfake) + | Some maxDegreeOfParallelism -> + let mutable i = -1 + let rec worker (trampolineHolder : TrampolineHolder) = + if i < computations.Length then + let j = Interlocked.Increment &i + if j < computations.Length then + if innerCTS.Token.IsCancellationRequested then + let cexn = OperationCanceledException (innerCTS.Token) + recordFailure (Choice2Of2 cexn) |> unfake + worker trampolineHolder |> unfake + else + let taskCtxt = + AsyncActivation.Create + innerCTS.Token + trampolineHolder + (fun res -> recordSuccess j res |> unfake; worker trampolineHolder) + (fun edi -> recordFailure (Choice1Of2 edi) |> unfake; worker trampolineHolder) + (fun cexn -> recordFailure (Choice2Of2 cexn) |> unfake; worker trampolineHolder) + computations.[j].Invoke taskCtxt |> unfake + fake() + for x = 1 to maxDegreeOfParallelism do + let trampolineHolder = TrampolineHolder() + trampolineHolder.QueueWorkItemWithTrampoline (fun () -> + worker trampolineHolder) + |> unfake - static member Sequential (computations: seq>) = - Async.Parallel(computations, maxDegreeOfParallelism=1) + fake())) - static member Choice(computations: Async<'T option> seq) : Async<'T option> = - MakeAsyncWithCancelCheck (fun ctxt -> - // manually protect eval of seq - let result = - try - Choice1Of2 (Seq.toArray computations) - with exn -> - Choice2Of2 (ExceptionDispatchInfo.RestoreOrCapture exn) + static member Sequential (computations: seq>) = + Async.Parallel(computations, maxDegreeOfParallelism=1) - match result with - | Choice2Of2 edi -> ctxt.econt edi - | Choice1Of2 [| |] -> ctxt.cont None - | Choice1Of2 computations -> - let ctxt = DelimitSyncContext ctxt - ctxt.ProtectCode (fun () -> - let mutable count = computations.Length - let mutable noneCount = 0 - let mutable someOrExnCount = 0 - let innerCts = new LinkedSubSource(ctxt.token) - - let scont (result: 'T option) = - let result = - match result with - | Some _ -> - if Interlocked.Increment &someOrExnCount = 1 then - innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont result) - else - fake() - - | None -> - if Interlocked.Increment &noneCount = computations.Length then - innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont None) - else - fake() - - if Interlocked.Decrement &count = 0 then - innerCts.Dispose() - - result - - let econt (exn: ExceptionDispatchInfo) = - let result = + static member Choice(computations: Async<'T option> seq) : Async<'T option> = + MakeAsyncWithCancelCheck (fun ctxt -> + // manually protect eval of seq + let result = + try + Choice1Of2 (Seq.toArray computations) + with exn -> + Choice2Of2 (ExceptionDispatchInfo.RestoreOrCapture exn) + + match result with + | Choice2Of2 edi -> ctxt.econt edi + | Choice1Of2 [| |] -> ctxt.cont None + | Choice1Of2 computations -> + let ctxt = DelimitSyncContext ctxt + ctxt.ProtectCode (fun () -> + let mutable count = computations.Length + let mutable noneCount = 0 + let mutable someOrExnCount = 0 + let innerCts = new LinkedSubSource(ctxt.token) + + let scont (result: 'T option) = + let result = + match result with + | Some _ -> if Interlocked.Increment &someOrExnCount = 1 then - innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.econt exn) + innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont result) else fake() - if Interlocked.Decrement &count = 0 then - innerCts.Dispose() - - result - - let ccont (cexn: OperationCanceledException) = - let result = - if Interlocked.Increment &someOrExnCount = 1 then - innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont cexn) + | None -> + if Interlocked.Increment &noneCount = computations.Length then + innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont None) else fake() - if Interlocked.Decrement &count = 0 then - innerCts.Dispose() + if Interlocked.Decrement &count = 0 then + innerCts.Dispose() - result + result - for computation in computations do - QueueAsync innerCts.Token scont econt ccont computation |> unfake + let econt (exn: ExceptionDispatchInfo) = + let result = + if Interlocked.Increment &someOrExnCount = 1 then + innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.econt exn) + else + fake() - fake())) + if Interlocked.Decrement &count = 0 then + innerCts.Dispose() - /// StartWithContinuations, except the exception continuation is given an ExceptionDispatchInfo - static member StartWithContinuationsUsingDispatchInfo(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = - let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.StartWithContinuations cancellationToken computation continuation exceptionContinuation cancellationContinuation + result - static member StartWithContinuations(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = - Async.StartWithContinuationsUsingDispatchInfo(computation, continuation, (fun edi -> exceptionContinuation (edi.GetAssociatedSourceException())), cancellationContinuation, ?cancellationToken=cancellationToken) + let ccont (cexn: OperationCanceledException) = + let result = + if Interlocked.Increment &someOrExnCount = 1 then + innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont cexn) + else + fake() - static member StartImmediateAsTask (computation: Async<'T>, ?cancellationToken ) : Task<'T>= - let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token - let ts = TaskCompletionSource<'T>() - let task = ts.Task - Async.StartWithContinuations( - computation, - (fun k -> ts.SetResult k), - (fun exn -> ts.SetException exn), - (fun _ -> ts.SetCanceled()), - cancellationToken) - task + if Interlocked.Decrement &count = 0 then + innerCts.Dispose() - static member StartImmediate(computation:Async, ?cancellationToken) : unit = - let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token - AsyncPrimitives.StartWithContinuations cancellationToken computation id (fun edi -> edi.ThrowAny()) ignore + result - static member Sleep (millisecondsDueTime: int64) : Async = - MakeAsyncWithCancelCheck (fun ctxt -> + for computation in computations do + QueueAsync innerCts.Token scont econt ccont computation |> unfake + + fake())) + + /// StartWithContinuations, except the exception continuation is given an ExceptionDispatchInfo + static member StartWithContinuationsUsingDispatchInfo(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartWithContinuations cancellationToken computation continuation exceptionContinuation cancellationContinuation + + static member StartWithContinuations(computation:Async<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = + Async.StartWithContinuationsUsingDispatchInfo(computation, continuation, (fun edi -> exceptionContinuation (edi.GetAssociatedSourceException())), cancellationContinuation, ?cancellationToken=cancellationToken) + + static member StartImmediateAsTask (computation: Async<'T>, ?cancellationToken ) : Task<'T>= + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + let ts = TaskCompletionSource<'T>() + let task = ts.Task + Async.StartWithContinuations( + computation, + (fun k -> ts.SetResult k), + (fun exn -> ts.SetException exn), + (fun _ -> ts.SetCanceled()), + cancellationToken) + task + + static member StartImmediate(computation:Async, ?cancellationToken) : unit = + let cancellationToken = defaultArg cancellationToken defaultCancellationTokenSource.Token + AsyncPrimitives.StartWithContinuations cancellationToken computation id (fun edi -> edi.ThrowAny()) ignore + + static member Sleep (millisecondsDueTime: int64) : Async = + MakeAsyncWithCancelCheck (fun ctxt -> + let ctxt = DelimitSyncContext ctxt + let mutable edi = null + let latch = Latch() + let mutable timer: Timer option = None + let mutable registration: CancellationTokenRegistration option = None + registration <- + ctxt.token.Register(Action(fun () -> + if latch.Enter() then + // Make sure we're not cancelled again + DisposeCancellationRegistration ®istration + DisposeTimer &timer + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont(OperationCanceledException(ctxt.token))) |> unfake) + ) |> Some + try + timer <- new Timer(TimerCallback(fun _ -> + if latch.Enter() then + // Ensure cancellation is not possible beyond this point + DisposeCancellationRegistration ®istration + DisposeTimer &timer + // Now we're done, so call the continuation + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont()) |> unfake), + null, dueTime=millisecondsDueTime, period = -1L) |> Some + with exn -> + if latch.Enter() then + // Ensure cancellation is not possible beyond this point + DisposeCancellationRegistration ®istration + // Prepare to call exception continuation + edi <- ExceptionDispatchInfo.RestoreOrCapture exn + + // Call exception continuation if necessary + match edi with + | null -> + fake() + | _ -> + ctxt.econt edi) + + static member Sleep (millisecondsDueTime: int32) : Async = + Async.Sleep (millisecondsDueTime |> int64) + + static member Sleep (dueTime: TimeSpan) = + if dueTime < TimeSpan.Zero then + raise (ArgumentOutOfRangeException("dueTime")) + else + Async.Sleep (dueTime.TotalMilliseconds |> Checked.int64) + + /// Wait for a wait handle. Both timeout and cancellation are supported + static member AwaitWaitHandle(waitHandle: WaitHandle, ?millisecondsTimeout:int) = + MakeAsyncWithCancelCheck (fun ctxt -> + let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite + if millisecondsTimeout = 0 then + let ok = waitHandle.WaitOne(0, exitContext=false) + ctxt.cont ok + else let ctxt = DelimitSyncContext ctxt let mutable edi = null let latch = Latch() - let mutable timer: Timer option = None + let mutable rwh: RegisteredWaitHandle option = None let mutable registration: CancellationTokenRegistration option = None registration <- ctxt.token.Register(Action(fun () -> if latch.Enter() then // Make sure we're not cancelled again - DisposeCancellationRegistration ®istration - DisposeTimer &timer - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont(OperationCanceledException(ctxt.token))) |> unfake) - ) |> Some + DisposeCancellationRegistration ®istration + + UnregisterWaitHandle &rwh + + // Call the cancellation continuation + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont(OperationCanceledException(ctxt.token))) |> unfake)) + |> Some + try - timer <- new Timer(TimerCallback(fun _ -> - if latch.Enter() then - // Ensure cancellation is not possible beyond this point - DisposeCancellationRegistration ®istration - DisposeTimer &timer - // Now we're done, so call the continuation - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont()) |> unfake), - null, dueTime=millisecondsDueTime, period = -1L) |> Some + rwh <- ThreadPool.RegisterWaitForSingleObject(waitObject=waitHandle, + callBack=WaitOrTimerCallback(fun _ timeOut -> + if latch.Enter() then + // Ensure cancellation is not possible beyond this point + DisposeCancellationRegistration ®istration + UnregisterWaitHandle &rwh + // Call the success continuation + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont (not timeOut)) |> unfake), + state=null, + millisecondsTimeOutInterval=millisecondsTimeout, + executeOnlyOnce=true) + |> Some with exn -> if latch.Enter() then // Ensure cancellation is not possible beyond this point @@ -1621,445 +1682,384 @@ namespace Microsoft.FSharp.Control | null -> fake() | _ -> + // Call the exception continuation ctxt.econt edi) - static member Sleep (millisecondsDueTime: int32) : Async = - Async.Sleep (millisecondsDueTime |> int64) - - static member Sleep (dueTime: TimeSpan) = - if dueTime < TimeSpan.Zero then - raise (ArgumentOutOfRangeException("dueTime")) + static member AwaitIAsyncResult(iar: IAsyncResult, ?millisecondsTimeout) = + async { + if iar.CompletedSynchronously then + return true else - Async.Sleep (dueTime.TotalMilliseconds |> Checked.int64) - - /// Wait for a wait handle. Both timeout and cancellation are supported - static member AwaitWaitHandle(waitHandle: WaitHandle, ?millisecondsTimeout:int) = - MakeAsyncWithCancelCheck (fun ctxt -> - let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite - if millisecondsTimeout = 0 then - let ok = waitHandle.WaitOne(0, exitContext=false) - ctxt.cont ok - else - let ctxt = DelimitSyncContext ctxt - let mutable edi = null - let latch = Latch() - let mutable rwh: RegisteredWaitHandle option = None - let mutable registration: CancellationTokenRegistration option = None - registration <- - ctxt.token.Register(Action(fun () -> - if latch.Enter() then - // Make sure we're not cancelled again - DisposeCancellationRegistration ®istration - - UnregisterWaitHandle &rwh - - // Call the cancellation continuation - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont(OperationCanceledException(ctxt.token))) |> unfake)) - |> Some - - try - rwh <- ThreadPool.RegisterWaitForSingleObject(waitObject=waitHandle, - callBack=WaitOrTimerCallback(fun _ timeOut -> - if latch.Enter() then - // Ensure cancellation is not possible beyond this point - DisposeCancellationRegistration ®istration - UnregisterWaitHandle &rwh - // Call the success continuation - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont (not timeOut)) |> unfake), - state=null, - millisecondsTimeOutInterval=millisecondsTimeout, - executeOnlyOnce=true) - |> Some - with exn -> - if latch.Enter() then - // Ensure cancellation is not possible beyond this point - DisposeCancellationRegistration ®istration - // Prepare to call exception continuation - edi <- ExceptionDispatchInfo.RestoreOrCapture exn - - // Call exception continuation if necessary - match edi with - | null -> - fake() - | _ -> - // Call the exception continuation - ctxt.econt edi) - - static member AwaitIAsyncResult(iar: IAsyncResult, ?millisecondsTimeout) = - async { - if iar.CompletedSynchronously then - return true - else - return! Async.AwaitWaitHandle(iar.AsyncWaitHandle, ?millisecondsTimeout=millisecondsTimeout) + return! Async.AwaitWaitHandle(iar.AsyncWaitHandle, ?millisecondsTimeout=millisecondsTimeout) + } + + /// Await and use the result of a result cell. The resulting async doesn't support cancellation + /// or timeout directly, rather the underlying computation must fill the result if cancellation + /// or timeout occurs. + static member AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell: ResultCell>) = + async { + let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout + return! CreateAsyncResultAsync result + } + + /// Await the result of a result cell belonging to a child computation. The resulting async supports timeout and if + /// it happens the child computation will be cancelled. The resulting async doesn't support cancellation + /// directly, rather the underlying computation must fill the result if cancellation occurs. + static member AwaitAndBindChildResult(innerCTS: CancellationTokenSource, resultCell: ResultCell>, millisecondsTimeout) : Async<'T> = + match millisecondsTimeout with + | None | Some -1 -> + resultCell |> Async.AwaitAndBindResult_NoDirectCancelOrTimeout + + | Some 0 -> + async { if resultCell.ResultAvailable then + let res = resultCell.GrabResult() + return res.Commit() + else + return raise (System.TimeoutException()) } + | _ -> + async { + try + if resultCell.ResultAvailable then + let res = resultCell.GrabResult() + return res.Commit() + else + let! ok = Async.AwaitWaitHandle (resultCell.GetWaitHandle(), ?millisecondsTimeout=millisecondsTimeout) + if ok then + let res = resultCell.GrabResult() + return res.Commit() + else // timed out + // issue cancellation signal + innerCTS.Cancel() + // wait for computation to quiesce + let! _ = Async.AwaitWaitHandle (resultCell.GetWaitHandle()) + return raise (System.TimeoutException()) + finally + resultCell.Close() } - /// Await and use the result of a result cell. The resulting async doesn't support cancellation - /// or timeout directly, rather the underlying computation must fill the result if cancellation - /// or timeout occurs. - static member AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell: ResultCell>) = - async { - let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout - return! CreateAsyncResultAsync result - } - /// Await the result of a result cell belonging to a child computation. The resulting async supports timeout and if - /// it happens the child computation will be cancelled. The resulting async doesn't support cancellation - /// directly, rather the underlying computation must fill the result if cancellation occurs. - static member AwaitAndBindChildResult(innerCTS: CancellationTokenSource, resultCell: ResultCell>, millisecondsTimeout) : Async<'T> = - match millisecondsTimeout with - | None | Some -1 -> - resultCell |> Async.AwaitAndBindResult_NoDirectCancelOrTimeout + static member FromBeginEnd(beginAction, endAction, ?cancelAction): Async<'T> = + async { + let! ct = cancellationTokenAsync + let resultCell = new ResultCell<_>() - | Some 0 -> - async { if resultCell.ResultAvailable then - let res = resultCell.GrabResult() - return res.Commit() - else - return raise (System.TimeoutException()) } - | _ -> - async { - try - if resultCell.ResultAvailable then - let res = resultCell.GrabResult() - return res.Commit() - else - let! ok = Async.AwaitWaitHandle (resultCell.GetWaitHandle(), ?millisecondsTimeout=millisecondsTimeout) - if ok then - let res = resultCell.GrabResult() - return res.Commit() - else // timed out - // issue cancellation signal - innerCTS.Cancel() - // wait for computation to quiesce - let! _ = Async.AwaitWaitHandle (resultCell.GetWaitHandle()) - return raise (System.TimeoutException()) - finally - resultCell.Close() - } - - - static member FromBeginEnd(beginAction, endAction, ?cancelAction): Async<'T> = - async { - let! ct = cancellationTokenAsync - let resultCell = new ResultCell<_>() + let latch = Latch() + let mutable registration: CancellationTokenRegistration option = None + registration <- + ct.Register(Action(fun () -> + if latch.Enter() then + // Make sure we're not cancelled again + DisposeCancellationRegistration ®istration - let latch = Latch() - let mutable registration: CancellationTokenRegistration option = None - registration <- - ct.Register(Action(fun () -> + // Call the cancellation function. Ignore any exceptions from the + // cancellation function. + match cancelAction with + | None -> () + | Some cancel -> + try cancel() with _ -> () + + // Register the cancellation result. + let canceledResult = Canceled (OperationCanceledException ct) + resultCell.RegisterResult(canceledResult, reuseThread=true) |> unfake)) + |> Some + + let callback = + AsyncCallback(fun iar -> + if not iar.CompletedSynchronously then if latch.Enter() then - // Make sure we're not cancelled again + // Ensure cancellation is not possible beyond this point DisposeCancellationRegistration ®istration - // Call the cancellation function. Ignore any exceptions from the - // cancellation function. - match cancelAction with - | None -> () - | Some cancel -> - try cancel() with _ -> () + // Run the endAction and collect its result. + let res = + try + Ok(endAction iar) + with exn -> + let edi = ExceptionDispatchInfo.RestoreOrCapture exn + Error edi + + // Register the result. + resultCell.RegisterResult(res, reuseThread=true) |> unfake) + + let (iar:IAsyncResult) = beginAction (callback, (null:obj)) + if iar.CompletedSynchronously then + // Ensure cancellation is not possible beyond this point + DisposeCancellationRegistration ®istration + return endAction iar + else + // Note: ok to use "NoDirectCancel" here because cancellation has been registered above + // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method + return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout resultCell + } + + + static member FromBeginEnd(arg, beginAction, endAction, ?cancelAction): Async<'T> = + Async.FromBeginEnd((fun (iar, state) -> beginAction(arg, iar, state)), endAction, ?cancelAction=cancelAction) + + static member FromBeginEnd(arg1, arg2, beginAction, endAction, ?cancelAction): Async<'T> = + Async.FromBeginEnd((fun (iar, state) -> beginAction(arg1, arg2, iar, state)), endAction, ?cancelAction=cancelAction) + + static member FromBeginEnd(arg1, arg2, arg3, beginAction, endAction, ?cancelAction): Async<'T> = + Async.FromBeginEnd((fun (iar, state) -> beginAction(arg1, arg2, arg3, iar, state)), endAction, ?cancelAction=cancelAction) + + static member AsBeginEnd<'Arg, 'T> (computation:('Arg -> Async<'T>)) : + // The 'Begin' member + ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) * + // The 'End' member + (System.IAsyncResult -> 'T) * + // The 'Cancel' member + (System.IAsyncResult -> unit) = + let beginAction = fun (a1, callback, state) -> AsBeginEndHelpers.beginAction ((computation a1), callback, state) + beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> + + static member AwaitEvent(event:IEvent<'Delegate, 'T>, ?cancelAction) : Async<'T> = + async { + let! ct = cancellationTokenAsync + let resultCell = new ResultCell<_>() + // Set up the handlers to listen to events and cancellation + let latch = Latch() + let mutable registration: CancellationTokenRegistration option = None + let mutable del: 'Delegate option = None + registration <- + ct.Register(Action(fun () -> + if latch.Enter() then + // Make sure we're not cancelled again + DisposeCancellationRegistration ®istration - // Register the cancellation result. - let canceledResult = Canceled (OperationCanceledException ct) - resultCell.RegisterResult(canceledResult, reuseThread=true) |> unfake)) - |> Some + // Stop listening to events + RemoveHandler event &del + + // Call the given cancellation routine if we've been given one + // Exceptions from a cooperative cancellation are ignored. + match cancelAction with + | None -> () + | Some cancel -> + try cancel() with _ -> () + + // Register the cancellation result. + resultCell.RegisterResult(Canceled (OperationCanceledException ct), reuseThread=true) |> unfake + )) |> Some + + let del = + FuncDelegate<'T>.Create<'Delegate>(fun eventArgs -> + if latch.Enter() then + // Ensure cancellation is not possible beyond this point + DisposeCancellationRegistration ®istration - let callback = - AsyncCallback(fun iar -> - if not iar.CompletedSynchronously then - if latch.Enter() then - // Ensure cancellation is not possible beyond this point - DisposeCancellationRegistration ®istration + // Stop listening to events + RemoveHandler event &del - // Run the endAction and collect its result. - let res = - try - Ok(endAction iar) - with exn -> - let edi = ExceptionDispatchInfo.RestoreOrCapture exn - Error edi + // Register the successful result. + resultCell.RegisterResult(Ok eventArgs, reuseThread=true) |> unfake) - // Register the result. - resultCell.RegisterResult(res, reuseThread=true) |> unfake) + // Start listening to events + event.AddHandler del - let (iar:IAsyncResult) = beginAction (callback, (null:obj)) - if iar.CompletedSynchronously then - // Ensure cancellation is not possible beyond this point - DisposeCancellationRegistration ®istration - return endAction iar - else - // Note: ok to use "NoDirectCancel" here because cancellation has been registered above - // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method - return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout resultCell - } + // Return the async computation that allows us to await the result + // Note: ok to use "NoDirectCancel" here because cancellation has been registered above + // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method + return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout resultCell } + static member Ignore (computation: Async<'T>) = CreateIgnoreAsync computation - static member FromBeginEnd(arg, beginAction, endAction, ?cancelAction): Async<'T> = - Async.FromBeginEnd((fun (iar, state) -> beginAction(arg, iar, state)), endAction, ?cancelAction=cancelAction) + static member SwitchToNewThread() = CreateSwitchToNewThreadAsync() - static member FromBeginEnd(arg1, arg2, beginAction, endAction, ?cancelAction): Async<'T> = - Async.FromBeginEnd((fun (iar, state) -> beginAction(arg1, arg2, iar, state)), endAction, ?cancelAction=cancelAction) + static member SwitchToThreadPool() = CreateSwitchToThreadPoolAsync() - static member FromBeginEnd(arg1, arg2, arg3, beginAction, endAction, ?cancelAction): Async<'T> = - Async.FromBeginEnd((fun (iar, state) -> beginAction(arg1, arg2, arg3, iar, state)), endAction, ?cancelAction=cancelAction) + static member StartChild (computation:Async<'T>, ?millisecondsTimeout) = + async { + let resultCell = new ResultCell<_>() + let! ct = cancellationTokenAsync + let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal + let mutable ctsRef = innerCTS + let registration = + ct.Register(Action(fun () -> + match ctsRef with + | null -> () + | otherwise -> otherwise.Cancel())) - static member AsBeginEnd<'Arg, 'T> (computation:('Arg -> Async<'T>)) : - // The 'Begin' member - ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) * - // The 'End' member - (System.IAsyncResult -> 'T) * - // The 'Cancel' member - (System.IAsyncResult -> unit) = - let beginAction = fun (a1, callback, state) -> AsBeginEndHelpers.beginAction ((computation a1), callback, state) - beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> + do QueueAsync + innerCTS.Token + // since innerCTS is not ever Disposed, can call reg.Dispose() without a safety Latch + (fun res -> ctsRef <- null; registration.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) + (fun edi -> ctsRef <- null; registration.Dispose(); resultCell.RegisterResult (Error edi, reuseThread=true)) + (fun err -> ctsRef <- null; registration.Dispose(); resultCell.RegisterResult (Canceled err, reuseThread=true)) + computation + |> unfake - static member AwaitEvent(event:IEvent<'Delegate, 'T>, ?cancelAction) : Async<'T> = - async { - let! ct = cancellationTokenAsync - let resultCell = new ResultCell<_>() - // Set up the handlers to listen to events and cancellation - let latch = Latch() - let mutable registration: CancellationTokenRegistration option = None - let mutable del: 'Delegate option = None - registration <- - ct.Register(Action(fun () -> + return Async.AwaitAndBindChildResult(innerCTS, resultCell, millisecondsTimeout) } + + static member SwitchToContext syncContext = + async { + match syncContext with + | null -> + // no synchronization context, just switch to the thread pool + do! Async.SwitchToThreadPool() + | syncCtxt -> + // post the continuation to the synchronization context + return! CreateSwitchToAsync syncCtxt + } + + static member OnCancel interruption = + async { + let! ct = cancellationTokenAsync + // latch protects cancellation and disposal contention + let latch = Latch() + let mutable registration: CancellationTokenRegistration option = None + registration <- + ct.Register(Action(fun () -> if latch.Enter() then // Make sure we're not cancelled again DisposeCancellationRegistration ®istration + try + interruption () + with _ -> ())) + |> Some + let disposer = + { new System.IDisposable with + member _.Dispose() = + // dispose CancellationTokenRegistration only if cancellation was not requested. + // otherwise - do nothing, disposal will be performed by the handler itself + if not ct.IsCancellationRequested then + if latch.Enter() then + // Ensure cancellation is not possible beyond this point + DisposeCancellationRegistration ®istration } + return disposer + } + + static member TryCancelled (computation: Async<'T>, compensation) = + CreateWhenCancelledAsync compensation computation + + static member AwaitTask (task:Task<'T>) : Async<'T> = + MakeAsyncWithCancelCheck (fun ctxt -> + if task.IsCompleted then + // Run synchronously without installing new trampoline + OnTaskCompleted task ctxt + else + // Continue asynchronously, via syncContext if necessary, installing new trampoline + let ctxt = DelimitSyncContext ctxt + ctxt.ProtectCode (fun () -> AttachContinuationToTask task ctxt)) - // Stop listening to events - RemoveHandler event &del - - // Call the given cancellation routine if we've been given one - // Exceptions from a cooperative cancellation are ignored. - match cancelAction with - | None -> () - | Some cancel -> - try cancel() with _ -> () - - // Register the cancellation result. - resultCell.RegisterResult(Canceled (OperationCanceledException ct), reuseThread=true) |> unfake - )) |> Some - - let del = - FuncDelegate<'T>.Create<'Delegate>(fun eventArgs -> - if latch.Enter() then - // Ensure cancellation is not possible beyond this point - DisposeCancellationRegistration ®istration + static member AwaitTask (task:Task) : Async = + MakeAsyncWithCancelCheck (fun ctxt -> + if task.IsCompleted then + // Continue synchronously without installing new trampoline + OnUnitTaskCompleted task ctxt + else + // Continue asynchronously, via syncContext if necessary, installing new trampoline + let ctxt = DelimitSyncContext ctxt + ctxt.ProtectCode (fun () -> AttachContinuationToUnitTask task ctxt)) - // Stop listening to events - RemoveHandler event &del +module CommonExtensions = - // Register the successful result. - resultCell.RegisterResult(Ok eventArgs, reuseThread=true) |> unfake) + type System.IO.Stream with - // Start listening to events - event.AddHandler del + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member stream.AsyncRead(buffer: byte[], ?offset, ?count) = + let offset = defaultArg offset 0 + let count = defaultArg count buffer.Length + Async.FromBeginEnd (buffer, offset, count, stream.BeginRead, stream.EndRead) - // Return the async computation that allows us to await the result - // Note: ok to use "NoDirectCancel" here because cancellation has been registered above - // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method - return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout resultCell } + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member stream.AsyncRead count = + async { + let buffer = Array.zeroCreate count + let mutable i = 0 + while i < count do + let! n = stream.AsyncRead(buffer, i, count - i) + i <- i + n + if n = 0 then + raise(System.IO.EndOfStreamException(SR.GetString(SR.failedReadEnoughBytes))) + return buffer + } - static member Ignore (computation: Async<'T>) = CreateIgnoreAsync computation + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member stream.AsyncWrite(buffer:byte[], ?offset:int, ?count:int) = + let offset = defaultArg offset 0 + let count = defaultArg count buffer.Length + Async.FromBeginEnd (buffer, offset, count, stream.BeginWrite, stream.EndWrite) - static member SwitchToNewThread() = CreateSwitchToNewThreadAsync() + type IObservable<'Args> with - static member SwitchToThreadPool() = CreateSwitchToThreadPoolAsync() + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member x.Add(callback: 'Args -> unit) = x.Subscribe callback |> ignore - static member StartChild (computation:Async<'T>, ?millisecondsTimeout) = - async { - let resultCell = new ResultCell<_>() - let! ct = cancellationTokenAsync - let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal - let mutable ctsRef = innerCTS - let registration = - ct.Register(Action(fun () -> - match ctsRef with - | null -> () - | otherwise -> otherwise.Cancel())) - - do QueueAsync - innerCTS.Token - // since innerCTS is not ever Disposed, can call reg.Dispose() without a safety Latch - (fun res -> ctsRef <- null; registration.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) - (fun edi -> ctsRef <- null; registration.Dispose(); resultCell.RegisterResult (Error edi, reuseThread=true)) - (fun err -> ctsRef <- null; registration.Dispose(); resultCell.RegisterResult (Canceled err, reuseThread=true)) - computation - |> unfake - - return Async.AwaitAndBindChildResult(innerCTS, resultCell, millisecondsTimeout) } - - static member SwitchToContext syncContext = - async { - match syncContext with - | null -> - // no synchronization context, just switch to the thread pool - do! Async.SwitchToThreadPool() - | syncCtxt -> - // post the continuation to the synchronization context - return! CreateSwitchToAsync syncCtxt - } + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member x.Subscribe callback = + x.Subscribe { new IObserver<'Args> with + member x.OnNext args = callback args + member x.OnError e = () + member x.OnCompleted() = () } - static member OnCancel interruption = - async { - let! ct = cancellationTokenAsync - // latch protects cancellation and disposal contention - let latch = Latch() - let mutable registration: CancellationTokenRegistration option = None - registration <- - ct.Register(Action(fun () -> - if latch.Enter() then - // Make sure we're not cancelled again - DisposeCancellationRegistration ®istration - try - interruption () - with _ -> ())) - |> Some - let disposer = - { new System.IDisposable with - member _.Dispose() = - // dispose CancellationTokenRegistration only if cancellation was not requested. - // otherwise - do nothing, disposal will be performed by the handler itself - if not ct.IsCancellationRequested then - if latch.Enter() then - // Ensure cancellation is not possible beyond this point - DisposeCancellationRegistration ®istration } - return disposer - } +module WebExtensions = - static member TryCancelled (computation: Async<'T>, compensation) = - CreateWhenCancelledAsync compensation computation + type System.Net.WebRequest with + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member req.AsyncGetResponse() : Async= - static member AwaitTask (task:Task<'T>) : Async<'T> = - MakeAsyncWithCancelCheck (fun ctxt -> - if task.IsCompleted then - // Run synchronously without installing new trampoline - OnTaskCompleted task ctxt - else - // Continue asynchronously, via syncContext if necessary, installing new trampoline - let ctxt = DelimitSyncContext ctxt - ctxt.ProtectCode (fun () -> AttachContinuationToTask task ctxt)) - - static member AwaitTask (task:Task) : Async = - MakeAsyncWithCancelCheck (fun ctxt -> - if task.IsCompleted then - // Continue synchronously without installing new trampoline - OnUnitTaskCompleted task ctxt - else - // Continue asynchronously, via syncContext if necessary, installing new trampoline - let ctxt = DelimitSyncContext ctxt - ctxt.ProtectCode (fun () -> AttachContinuationToUnitTask task ctxt)) - - module CommonExtensions = - - type System.IO.Stream with - - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member stream.AsyncRead(buffer: byte[], ?offset, ?count) = - let offset = defaultArg offset 0 - let count = defaultArg count buffer.Length - Async.FromBeginEnd (buffer, offset, count, stream.BeginRead, stream.EndRead) - - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member stream.AsyncRead count = - async { - let buffer = Array.zeroCreate count - let mutable i = 0 - while i < count do - let! n = stream.AsyncRead(buffer, i, count - i) - i <- i + n - if n = 0 then - raise(System.IO.EndOfStreamException(SR.GetString(SR.failedReadEnoughBytes))) - return buffer - } - - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member stream.AsyncWrite(buffer:byte[], ?offset:int, ?count:int) = - let offset = defaultArg offset 0 - let count = defaultArg count buffer.Length - Async.FromBeginEnd (buffer, offset, count, stream.BeginWrite, stream.EndWrite) - - type IObservable<'Args> with - - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member x.Add(callback: 'Args -> unit) = x.Subscribe callback |> ignore - - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member x.Subscribe callback = - x.Subscribe { new IObserver<'Args> with - member x.OnNext args = callback args - member x.OnError e = () - member x.OnCompleted() = () } - - module WebExtensions = - - type System.Net.WebRequest with - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member req.AsyncGetResponse() : Async= - - let mutable canceled = false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives - - // Use CreateTryWithFilterAsync to allow propagation of exception without losing stack - Async.FromBeginEnd(beginAction=req.BeginGetResponse, - endAction = req.EndGetResponse, - cancelAction = fun() -> canceled <- true; req.Abort()) - |> CreateTryWithFilterAsync (fun exn -> - match exn with - | :? System.Net.WebException as webExn - when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && canceled -> - - Some (CreateAsyncResultAsync(AsyncResult.Canceled (OperationCanceledException webExn.Message))) - | _ -> - None) - - type System.Net.WebClient with - member inline private this.Download(event: IEvent<'T, _>, handler: _ -> 'T, start, result) = - let downloadAsync = - Async.FromContinuations (fun (cont, econt, ccont) -> - let userToken = obj() - let rec delegate' (_: obj) (args: #ComponentModel.AsyncCompletedEventArgs) = - // ensure we handle the completed event from correct download call - if userToken = args.UserState then - event.RemoveHandler handle - if args.Cancelled then - ccont (OperationCanceledException()) - elif isNotNull args.Error then - econt args.Error - else - cont (result args) - and handle = handler delegate' - event.AddHandler handle - start userToken - ) - - async { - use! _holder = Async.OnCancel(fun _ -> this.CancelAsync()) - return! downloadAsync - } - - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member this.AsyncDownloadString (address:Uri) : Async = - this.Download( - event = this.DownloadStringCompleted, - handler = (fun action -> Net.DownloadStringCompletedEventHandler action), - start = (fun userToken -> this.DownloadStringAsync(address, userToken)), - result = (fun args -> args.Result) - ) + let mutable canceled = false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member this.AsyncDownloadData (address:Uri) : Async = - this.Download( - event = this.DownloadDataCompleted, - handler = (fun action -> Net.DownloadDataCompletedEventHandler action), - start = (fun userToken -> this.DownloadDataAsync(address, userToken)), - result = (fun args -> args.Result) - ) + // Use CreateTryWithFilterAsync to allow propagation of exception without losing stack + Async.FromBeginEnd(beginAction=req.BeginGetResponse, + endAction = req.EndGetResponse, + cancelAction = fun() -> canceled <- true; req.Abort()) + |> CreateTryWithFilterAsync (fun exn -> + match exn with + | :? System.Net.WebException as webExn + when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && canceled -> - [] // give the extension member a 'nice', unmangled compiled name, unique within this module - member this.AsyncDownloadFile (address:Uri, fileName:string) : Async = - this.Download( - event = this.DownloadFileCompleted, - handler = (fun action -> ComponentModel.AsyncCompletedEventHandler action), - start = (fun userToken -> this.DownloadFileAsync(address, fileName, userToken)), - result = (fun _ -> ()) + Some (CreateAsyncResultAsync(AsyncResult.Canceled (OperationCanceledException webExn.Message))) + | _ -> + None) + + type System.Net.WebClient with + member inline private this.Download(event: IEvent<'T, _>, handler: _ -> 'T, start, result) = + let downloadAsync = + Async.FromContinuations (fun (cont, econt, ccont) -> + let userToken = obj() + let rec delegate' (_: obj) (args: #ComponentModel.AsyncCompletedEventArgs) = + // ensure we handle the completed event from correct download call + if userToken = args.UserState then + event.RemoveHandler handle + if args.Cancelled then + ccont (OperationCanceledException()) + elif isNotNull args.Error then + econt args.Error + else + cont (result args) + and handle = handler delegate' + event.AddHandler handle + start userToken ) + + async { + use! _holder = Async.OnCancel(fun _ -> this.CancelAsync()) + return! downloadAsync + } + + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member this.AsyncDownloadString (address:Uri) : Async = + this.Download( + event = this.DownloadStringCompleted, + handler = (fun action -> Net.DownloadStringCompletedEventHandler action), + start = (fun userToken -> this.DownloadStringAsync(address, userToken)), + result = (fun args -> args.Result) + ) + + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member this.AsyncDownloadData (address:Uri) : Async = + this.Download( + event = this.DownloadDataCompleted, + handler = (fun action -> Net.DownloadDataCompletedEventHandler action), + start = (fun userToken -> this.DownloadDataAsync(address, userToken)), + result = (fun args -> args.Result) + ) + + [] // give the extension member a 'nice', unmangled compiled name, unique within this module + member this.AsyncDownloadFile (address:Uri, fileName:string) : Async = + this.Download( + event = this.DownloadFileCompleted, + handler = (fun action -> ComponentModel.AsyncCompletedEventHandler action), + start = (fun userToken -> this.DownloadFileAsync(address, fileName, userToken)), + result = (fun _ -> ()) + ) diff --git a/src/FSharp.Core/collections.fs b/src/FSharp.Core/collections.fs index f15cb4894a3..b08a1989622 100644 --- a/src/FSharp.Core/collections.fs +++ b/src/FSharp.Core/collections.fs @@ -2,49 +2,47 @@ namespace Microsoft.FSharp.Collections - #nowarn "51" - - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.Operators - open System.Collections.Generic - - module HashIdentity = - - - let inline Structural<'T when 'T : equality> : IEqualityComparer<'T> = - LanguagePrimitives.FastGenericEqualityComparer<'T> - - let inline LimitedStructural<'T when 'T : equality>(limit) : IEqualityComparer<'T> = - LanguagePrimitives.FastLimitedGenericEqualityComparer<'T>(limit) - - let Reference<'T when 'T : not struct > : IEqualityComparer<'T> = - { new IEqualityComparer<'T> with - member _.GetHashCode(x) = LanguagePrimitives.PhysicalHash(x) - member _.Equals(x,y) = LanguagePrimitives.PhysicalEquality x y } - - let inline NonStructural< 'T when 'T : equality and 'T : (static member ( = ) : 'T * 'T -> bool) > = - { new IEqualityComparer<'T> with - member _.GetHashCode(x) = NonStructuralComparison.hash x - member _.Equals(x, y) = NonStructuralComparison.(=) x y } - - 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) } - - - 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> = - { new IComparer<'T> with - member _.Compare(x,y) = NonStructuralComparison.compare x y } - - let FromFunction comparer = - let comparer = OptimizedClosures.FSharpFunc<'T,'T,int>.Adapt(comparer) - { new IComparer<'T> with - member _.Compare(x,y) = comparer.Invoke(x,y) } +#nowarn "51" + +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.Operators +open System.Collections.Generic + +module HashIdentity = + + let inline Structural<'T when 'T : equality> : IEqualityComparer<'T> = + LanguagePrimitives.FastGenericEqualityComparer<'T> + + let inline LimitedStructural<'T when 'T : equality>(limit) : IEqualityComparer<'T> = + LanguagePrimitives.FastLimitedGenericEqualityComparer<'T>(limit) + + let Reference<'T when 'T : not struct > : IEqualityComparer<'T> = + { new IEqualityComparer<'T> with + member _.GetHashCode(x) = LanguagePrimitives.PhysicalHash(x) + member _.Equals(x,y) = LanguagePrimitives.PhysicalEquality x y } + + let inline NonStructural< 'T when 'T : equality and 'T : (static member ( = ) : 'T * 'T -> bool) > = + { new IEqualityComparer<'T> with + member _.GetHashCode(x) = NonStructuralComparison.hash x + member _.Equals(x, y) = NonStructuralComparison.(=) x y } + + 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) } + +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> = + { new IComparer<'T> with + member _.Compare(x,y) = NonStructuralComparison.compare x y } + + let FromFunction comparer = + let comparer = OptimizedClosures.FSharpFunc<'T,'T,int>.Adapt(comparer) + { new IComparer<'T> with + member _.Compare(x,y) = comparer.Invoke(x,y) } diff --git a/src/FSharp.Core/event.fs b/src/FSharp.Core/event.fs index 8e1d0826f33..054b31cbd0b 100644 --- a/src/FSharp.Core/event.fs +++ b/src/FSharp.Core/event.fs @@ -2,153 +2,153 @@ namespace Microsoft.FSharp.Control - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Control - open System.Reflection - open System.Diagnostics - - module private Atomic = - open System.Threading - - 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 - - [] - 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.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 } - - type EventDelegee<'Args>(observer: System.IObserver<'Args>) = - static let makeTuple = - if Microsoft.FSharp.Reflection.FSharpType.IsTuple(typeof<'Args>) then - Microsoft.FSharp.Reflection.FSharpValue.PreComputeTupleConstructor(typeof<'Args>) - else - fun _ -> assert false; null // should not be called, one-argument case don't use makeTuple function - - 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 - observer.OnNext args - - - type EventWrapper<'Delegate,'Args> = delegate of 'Delegate * obj * 'Args -> unit - - [] - type Event<'Delegate, 'Args when 'Delegate : delegate<'Args, unit> and 'Delegate :> System.Delegate and 'Delegate: not struct>() = - - let mutable multicast : 'Delegate = Unchecked.defaultof<_> - - static let mi, argTypes = - let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly - let mi = typeof<'Delegate>.GetMethod("Invoke",instanceBindingFlags) - let 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. - // CreateDelegate creates a delegate that is fast to invoke. - static let invoker = - if argTypes.Length = 1 then - (System.Delegate.CreateDelegate(typeof>, 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>.GetMethods(instanceBindingFlags) - |> Seq.filter(fun mi -> mi.Name = "Invoke" && mi.GetParameters().Length = argTypes.Length + 1) - |> Seq.exactlyOne - if mi.IsGenericMethodDefinition then - mi.MakeGenericMethod argTypes - else - mi - - member x.Trigger(sender:obj,args: 'Args) = - // Copy multicast value into local variable to avoid changing during member call. - let multicast = multicast - match box multicast with - | null -> () +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Control +open System.Reflection +open System.Diagnostics + +module private Atomic = + open System.Threading + + 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 + +[] +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.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 } + +type EventDelegee<'Args>(observer: System.IObserver<'Args>) = + static let makeTuple = + if Microsoft.FSharp.Reflection.FSharpType.IsTuple(typeof<'Args>) then + Microsoft.FSharp.Reflection.FSharpValue.PreComputeTupleConstructor(typeof<'Args>) + else + fun _ -> assert false; null // should not be called, one-argument case don't use makeTuple function + + 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 + observer.OnNext args + + +type EventWrapper<'Delegate,'Args> = delegate of 'Delegate * obj * 'Args -> unit + +[] +type Event<'Delegate, 'Args when 'Delegate : delegate<'Args, unit> and 'Delegate :> System.Delegate and 'Delegate: not struct>() = + + let mutable multicast : 'Delegate = Unchecked.defaultof<_> + + static let mi, argTypes = + let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly + let mi = typeof<'Delegate>.GetMethod("Invoke",instanceBindingFlags) + let 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. + // CreateDelegate creates a delegate that is fast to invoke. + static let invoker = + if argTypes.Length = 1 then + (System.Delegate.CreateDelegate(typeof>, 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>.GetMethods(instanceBindingFlags) + |> Seq.filter(fun mi -> mi.Name = "Invoke" && mi.GetParameters().Length = argTypes.Length + 1) + |> Seq.exactlyOne + if mi.IsGenericMethodDefinition then + mi.MakeGenericMethod argTypes + else + mi + + member x.Trigger(sender:obj,args: 'Args) = + // 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)) + multicast.DynamicInvoke(args) |> ignore | _ -> - 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. - // CreateDelegate creates a delegate that is fast to invoke. - invoker.Invoke(multicast, sender, args) |> ignore - - member x.Publish = - { new obj() with - member x.ToString() = "" - 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) } } - - - [] - type Event<'T> = - val mutable multicast : Handler<'T> - new() = { multicast = null } - - member x.Trigger(arg:'T) = - match x.multicast with - | null -> () - | d -> d.Invoke(null,arg) |> ignore - member x.Publish = - { new obj() with - member x.ToString() = "" - 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) } } + // 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() = "" + 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) } } + + +[] +type Event<'T> = + val mutable multicast : Handler<'T> + new() = { multicast = null } + + member x.Trigger(arg:'T) = + match x.multicast with + | null -> () + | d -> d.Invoke(null,arg) |> ignore + member x.Publish = + { new obj() with + member x.ToString() = "" + 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) } } diff --git a/src/FSharp.Core/event.fsi b/src/FSharp.Core/event.fsi index d36bf9b6ca4..536b414ba54 100644 --- a/src/FSharp.Core/event.fsi +++ b/src/FSharp.Core/event.fsi @@ -23,7 +23,7 @@ type DelegateEvent<'Delegate when 'Delegate :> System.Delegate> = /// The parameters for the event. /// /// - member Trigger: args: obj [] -> unit + member Trigger: args: obj[] -> unit /// Publishes the event as a first class event value. /// diff --git a/src/FSharp.Core/eventmodule.fs b/src/FSharp.Core/eventmodule.fs index fe907373f59..b9776a692d9 100644 --- a/src/FSharp.Core/eventmodule.fs +++ b/src/FSharp.Core/eventmodule.fs @@ -2,80 +2,80 @@ namespace Microsoft.FSharp.Control - open Microsoft.FSharp.Core - open Microsoft.FSharp.Control +open Microsoft.FSharp.Core +open Microsoft.FSharp.Control - [] - [] - module Event = - [] - let create<'T>() = - let ev = new Event<'T>() - ev.Trigger, ev.Publish +[] +[] +module Event = + [] + let create<'T>() = + let ev = new Event<'T>() + ev.Trigger, ev.Publish - [] - let map mapping (sourceEvent: IEvent<'Delegate,'T>) = - let ev = new Event<_>() - sourceEvent.Add(fun x -> ev.Trigger(mapping x)) - ev.Publish + [] + let map mapping (sourceEvent: IEvent<'Delegate,'T>) = + let ev = new Event<_>() + sourceEvent.Add(fun x -> ev.Trigger(mapping x)) + ev.Publish - [] - let filter predicate (sourceEvent: IEvent<'Delegate,'T>) = - let ev = new Event<_>() - sourceEvent.Add(fun x -> if predicate x then ev.Trigger x) - ev.Publish + [] + let filter predicate (sourceEvent: IEvent<'Delegate,'T>) = + let ev = new Event<_>() + sourceEvent.Add(fun x -> if predicate x then ev.Trigger x) + ev.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 + [] + 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 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 + [] + 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 - [] - let scan collector state (sourceEvent: IEvent<'Delegate,'T>) = - let mutable state = state - let ev = new Event<_>() - sourceEvent.Add(fun msg -> - let z = state - let z = collector z msg - state <- z; - ev.Trigger(z)) - ev.Publish + [] + let scan collector state (sourceEvent: IEvent<'Delegate,'T>) = + let mutable state = state + let ev = new Event<_>() + sourceEvent.Add(fun msg -> + let z = state + let z = collector z msg + state <- z; + ev.Trigger(z)) + ev.Publish - [] - let add callback (sourceEvent: IEvent<'Delegate,'T>) = sourceEvent.Add(callback) + [] + let add callback (sourceEvent: IEvent<'Delegate,'T>) = sourceEvent.Add(callback) - [] - 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)) - lastArgs <- Some args2) + [] + 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)) + lastArgs <- Some args2) - ev.Publish + ev.Publish - [] - 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 + [] + 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 - [] - 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 diff --git a/src/FSharp.Core/fslib-extra-pervasives.fs b/src/FSharp.Core/fslib-extra-pervasives.fs index 789533419b0..2c0c462a9bc 100644 --- a/src/FSharp.Core/fslib-extra-pervasives.fs +++ b/src/FSharp.Core/fslib-extra-pervasives.fs @@ -8,11 +8,9 @@ module ExtraTopLevelOperators = open System.Collections.Generic open System.IO open System.Diagnostics - open System.Reflection open Microsoft.FSharp open Microsoft.FSharp.Core open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Text open Microsoft.FSharp.Collections open Microsoft.FSharp.Control open Microsoft.FSharp.Primitives.Basics @@ -46,70 +44,96 @@ module ExtraTopLevelOperators = #if NETSTANDARD static let emptyEnumerator = (Array.empty> :> seq<_>).GetEnumerator() #endif - member x.Count = t.Count + member _.Count = t.Count // Give a read-only view of the dictionary interface IDictionary<'Key, 'T> with - member s.Item + member _.Item with get x = dont_tail_call (fun () -> t.[makeSafeKey x]) and set _ _ = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) - member s.Keys = + + member _.Keys = let keys = t.Keys { new ICollection<'Key> with - member s.Add(x) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) - member s.Clear() = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) - member s.Remove(x) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) - member s.Contains(x) = t.ContainsKey (makeSafeKey x) - member s.CopyTo(arr,i) = + member _.Add(x) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) + + member _.Clear() = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) + + member _.Remove(x) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) + + member _.Contains(x) = t.ContainsKey (makeSafeKey x) + + member _.CopyTo(arr,i) = let mutable n = 0 for k in keys do arr.[i+n] <- getKey k n <- n + 1 - member s.IsReadOnly = true - member s.Count = keys.Count + + member _.IsReadOnly = true + + member _.Count = keys.Count + interface IEnumerable<'Key> with - member s.GetEnumerator() = (keys |> Seq.map getKey).GetEnumerator() + member _.GetEnumerator() = (keys |> Seq.map getKey).GetEnumerator() + interface System.Collections.IEnumerable with - member s.GetEnumerator() = ((keys |> Seq.map getKey) :> System.Collections.IEnumerable).GetEnumerator() } + member _.GetEnumerator() = ((keys |> Seq.map getKey) :> System.Collections.IEnumerable).GetEnumerator() } - member s.Values = upcast t.Values - member s.Add(_,_) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) - member s.ContainsKey(k) = dont_tail_call (fun () -> t.ContainsKey(makeSafeKey k)) - member s.TryGetValue(k,r) = + member _.Values = upcast t.Values + + member _.Add(_,_) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) + + member _.ContainsKey(k) = dont_tail_call (fun () -> t.ContainsKey(makeSafeKey k)) + + member _.TryGetValue(k,r) = let safeKey = makeSafeKey k if t.ContainsKey(safeKey) then (r <- t.[safeKey]; true) else false - member s.Remove(_ : 'Key) = (raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) : bool) + + member _.Remove(_ : 'Key) = (raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) : bool) interface IReadOnlyDictionary<'Key, 'T> with + 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 | false, _ -> false | true, value -> r <- value true + member _.Values = (t :> IReadOnlyDictionary<_,_>).Values + member _.ContainsKey k = t.ContainsKey (makeSafeKey k) interface ICollection> with - member s.Add(_) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) - member s.Clear() = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) - member s.Remove(_) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) - member s.Contains(KeyValue(k,v)) = ICollection_Contains t (KeyValuePair<_,_>(makeSafeKey k,v)) - member s.CopyTo(arr,i) = + + member _.Add(_) = raise (NotSupportedException(SR.GetString(SR.thisValueCannotBeMutated))) + + member _.Clear() = 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 _.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 s.IsReadOnly = true - member s.Count = t.Count + + member _.IsReadOnly = true + + member _.Count = t.Count interface IReadOnlyCollection> with member _.Count = t.Count interface IEnumerable> with - member s.GetEnumerator() = + + member _.GetEnumerator() = // We use an array comprehension here instead of seq {} as otherwise we get incorrect // 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. @@ -129,20 +153,24 @@ module ExtraTopLevelOperators = {new IEnumerator<_> with member _.Current = current () + interface System.Collections.IEnumerator with member _.Current = box(current()) + member _.MoveNext() = if index < endIndex then index <- index + 1 index < endIndex else false + member _.Reset() = index <- -1 + interface System.IDisposable with - member self.Dispose() = () } + member _.Dispose() = () } #endif interface System.Collections.IEnumerable with - member s.GetEnumerator() = + 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 @@ -150,7 +178,7 @@ module ExtraTopLevelOperators = and DictDebugView<'SafeKey,'Key,'T>(d:DictImpl<'SafeKey,'Key,'T>) = [] - member x.Items = Array.ofSeq d + member _.Items = Array.ofSeq d let inline dictImpl (comparer:IEqualityComparer<'SafeKey>) (makeSafeKey : 'Key->'SafeKey) (getKey : 'SafeKey->'Key) (l:seq<'Key*'T>) = let t = Dictionary comparer @@ -159,22 +187,26 @@ module ExtraTopLevelOperators = 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>) = dictImpl HashIdentity.Structural<'Key> id id l + 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>) = dictImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun k -> RuntimeHelpers.StructBox k) (fun sb -> sb.Value) l + let dictRefType (l:seq<'Key*'T>) = + dictImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun k -> RuntimeHelpers.StructBox k) (fun sb -> sb.Value) l [] let dict (keyValuePairs:seq<'Key*'T>) : IDictionary<'Key,'T> = - if typeof<'Key>.IsValueType - then dictValueType keyValuePairs :> _ - else dictRefType keyValuePairs :> _ + if typeof<'Key>.IsValueType then + dictValueType keyValuePairs + else + dictRefType keyValuePairs [] let readOnlyDict (keyValuePairs:seq<'Key*'T>) : IReadOnlyDictionary<'Key,'T> = - if typeof<'Key>.IsValueType - then dictValueType keyValuePairs :> _ - else dictRefType keyValuePairs :> _ + if typeof<'Key>.IsValueType then + dictValueType keyValuePairs + else + dictRefType keyValuePairs let getArray (vals : seq<'T>) = match vals with @@ -203,36 +235,41 @@ module ExtraTopLevelOperators = res.[i,j] <- rowiArr.[j] res - // -------------------------------------------------------------------- - // Printf - // -------------------------------------------------------------------- - [] - let sprintf format = Printf.sprintf format + let sprintf format = + Printf.sprintf format [] - let failwithf format = Printf.failwithf format + let failwithf format = + Printf.failwithf format [] - let fprintf (textWriter:TextWriter) format = Printf.fprintf textWriter format + let fprintf (textWriter:TextWriter) format = + Printf.fprintf textWriter format [] - let fprintfn (textWriter:TextWriter) format = Printf.fprintfn textWriter format + let fprintfn (textWriter:TextWriter) format = + Printf.fprintfn textWriter format [] - let printf format = Printf.printf format + let printf format = + Printf.printf format [] - let eprintf format = Printf.eprintf format + let eprintf format = + Printf.eprintf format [] - let printfn format = Printf.printfn format + let printfn format = + Printf.printfn format [] - let eprintfn format = Printf.eprintfn format + let eprintfn format = + Printf.eprintfn format [] - let failwith s = raise (Failure s) + let failwith s = + raise (Failure s) [] let async = AsyncBuilder() @@ -282,7 +319,8 @@ module ExtraTopLevelOperators = do() [] - let (|Lazy|) (input:Lazy<_>) = input.Force() + let (|Lazy|) (input:Lazy<_>) = + input.Force() let query = Microsoft.FSharp.Linq.QueryBuilder() @@ -291,9 +329,9 @@ namespace Microsoft.FSharp.Core.CompilerServices open System open System.Reflection - open System.Linq.Expressions - open System.Collections.Generic open Microsoft.FSharp.Core + open Microsoft.FSharp.Control + open Microsoft.FSharp.Quotations /// Represents the product of two measure expressions when returned as a generic argument of a provided type. [] @@ -315,11 +353,13 @@ namespace Microsoft.FSharp.Core.CompilerServices type TypeProviderAssemblyAttribute(assemblyName : string) = inherit System.Attribute() new () = TypeProviderAssemblyAttribute(null) + member _.AssemblyName = assemblyName [] type TypeProviderXmlDocAttribute(commentText: string) = inherit System.Attribute() + member _.CommentText = commentText [] @@ -328,8 +368,11 @@ namespace Microsoft.FSharp.Core.CompilerServices 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 _.Line with get() = line and set v = line <- v + member _.Column with get() = column and set v = column <- v [] @@ -342,41 +385,57 @@ namespace Microsoft.FSharp.Core.CompilerServices | 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 - member _.ResolutionFolder with get() = resolutionFolder and set v = resolutionFolder <- v - member _.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v - member _.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v - member _.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v - member _.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v + 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 _.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v + + member _.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v + + member _.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v + + member _.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v + member _.IsHostedExecution with get() = useResolutionFolderAtRuntime and set v = useResolutionFolderAtRuntime <- v - member _.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v - member _.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName + + member _.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v + + member _.SystemRuntimeContainsType (typeName: string) = systemRuntimeContainsType typeName type IProvidedNamespace = - abstract NamespaceName : string - abstract GetNestedNamespaces : unit -> IProvidedNamespace[] - abstract GetTypes : unit -> Type[] - abstract ResolveTypeName : typeName: string -> Type + abstract NamespaceName: string + + abstract GetNestedNamespaces: unit -> IProvidedNamespace[] + + abstract GetTypes: unit -> Type[] + + abstract ResolveTypeName: typeName: string -> Type type ITypeProvider = inherit System.IDisposable - abstract GetNamespaces : unit -> IProvidedNamespace[] - abstract GetStaticParameters : typeWithoutArguments:Type -> ParameterInfo[] - abstract ApplyStaticArguments : typeWithoutArguments:Type * typePathWithArguments:string[] * staticArguments:obj[] -> Type - abstract GetInvokerExpression : syntheticMethodBase:MethodBase * parameters:Microsoft.FSharp.Quotations.Expr[] -> Microsoft.FSharp.Quotations.Expr + + abstract GetNamespaces: unit -> IProvidedNamespace[] + + abstract GetStaticParameters: typeWithoutArguments: Type -> ParameterInfo[] + + abstract ApplyStaticArguments: typeWithoutArguments: Type * typePathWithArguments: string[] * staticArguments:obj[] -> Type + + abstract GetInvokerExpression: syntheticMethodBase:MethodBase * parameters:Expr[] -> Expr [] - abstract Invalidate : Microsoft.FSharp.Control.IEvent - abstract GetGeneratedAssemblyContents : assembly:System.Reflection.Assembly -> byte[] + abstract Invalidate : IEvent + abstract GetGeneratedAssemblyContents: assembly:System.Reflection.Assembly -> byte[] type ITypeProvider2 = - abstract GetStaticParametersForMethod : methodWithoutArguments:MethodBase -> ParameterInfo[] - abstract ApplyStaticArgumentsForMethod : methodWithoutArguments:MethodBase * methodNameWithArguments:string * staticArguments:obj[] -> MethodBase + abstract GetStaticParametersForMethod: methodWithoutArguments:MethodBase -> ParameterInfo[] + + abstract ApplyStaticArgumentsForMethod: methodWithoutArguments:MethodBase * methodNameWithArguments:string * staticArguments:obj[] -> MethodBase diff --git a/src/FSharp.Core/list.fs b/src/FSharp.Core/list.fs index d0eeda4e854..cd8b7ae3ad1 100644 --- a/src/FSharp.Core/list.fs +++ b/src/FSharp.Core/list.fs @@ -2,785 +2,784 @@ namespace Microsoft.FSharp.Collections - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.LanguagePrimitives - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Core.CompilerServices - open System.Collections.Generic - - - [] - [] - module List = - - let inline checkNonNull argName arg = - if isNull arg then - nullArg argName - - let inline indexNotFound() = raise (KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt))) - - [] - let length (list: 'T list) = list.Length - - [] - let last (list: 'T list) = - match Microsoft.FSharp.Primitives.Basics.List.tryLastV list with - | ValueSome x -> x - | ValueNone -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) - - [] - let rec tryLast (list: 'T list) = - match Microsoft.FSharp.Primitives.Basics.List.tryLastV list with - | ValueSome x -> Some x - | ValueNone -> None - - [] - let rev list = Microsoft.FSharp.Primitives.Basics.List.rev list - - [] - let concat lists = Microsoft.FSharp.Primitives.Basics.List.concat lists - - let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] projection: 'T->'SafeKey) ([] getKey:'SafeKey->'Key) (list: 'T list) = - let dict = Dictionary comparer - let rec loop srcList = - match srcList with - | [] -> () - | h :: t -> - let safeKey = projection h - let mutable prev = 0 - if dict.TryGetValue(safeKey, &prev) then dict.[safeKey] <- prev + 1 else dict.[safeKey] <- 1 - loop t - loop list - Microsoft.FSharp.Primitives.Basics.List.countBy dict getKey - - // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let countByValueType (projection: 'T->'Key) (list: 'T list) = countByImpl HashIdentity.Structural<'Key> projection id list - - // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let countByRefType (projection: 'T->'Key) (list: 'T list) = countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (projection t)) (fun sb -> sb.Value) list - - [] - let countBy (projection: 'T->'Key) (list: 'T list) = - match list with - | [] -> [] - | _ -> - if typeof<'Key>.IsValueType - then countByValueType projection list - else countByRefType projection list - - [] - let map mapping list = Microsoft.FSharp.Primitives.Basics.List.map mapping list - - [] - let mapi mapping list = Microsoft.FSharp.Primitives.Basics.List.mapi mapping list - - [] - let indexed list = Microsoft.FSharp.Primitives.Basics.List.indexed list - - [] - let mapFold<'T, 'State, 'Result> (mapping:'State -> 'T -> 'Result * 'State) state list = - Microsoft.FSharp.Primitives.Basics.List.mapFold mapping state list - - [] - let mapFoldBack<'T, 'State, 'Result> (mapping: 'T -> 'State -> 'Result * 'State) list state = - match list with - | [] -> [], state - | [h] -> let h', s' = mapping h state in [h'], s' - | _ -> - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(mapping) - let rec loop res list = - match list, res with - | [], _ -> res - | h :: t, (list', acc') -> - let h', s' = f.Invoke(h, acc') - loop (h' :: list', s') t - loop ([], state) (rev list) - - [] - let inline iter ([] action) (list: 'T list) = for x in list do action x - - [] - let distinct (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctWithComparer HashIdentity.Structural<'T> list - - [] - let distinctBy projection (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctByWithComparer HashIdentity.Structural<_> projection list - - [] - let ofArray (array: 'T array) = Microsoft.FSharp.Primitives.Basics.List.ofArray array - - [] - let toArray (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.toArray list - - [] - let empty<'T> = ([ ] : 'T list) - - [] - let head list = match list with x :: _ -> x | [] -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) - - [] - let tryHead list = match list with x :: _ -> Some x | [] -> None - - [] - let tail list = match list with _ :: t -> t | [] -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) - - [] - let isEmpty list = match list with [] -> true | _ -> false - - [] - let append list1 list2 = list1 @ list2 - - [] - let rec item index list = - match list with - | h :: t when index >= 0 -> - if index = 0 then h else item (index - 1) t - | _ -> - invalidArg "index" (SR.GetString(SR.indexOutOfBounds)) - - [] - let rec tryItem index list = - match list with - | h :: t when index >= 0 -> - if index = 0 then Some h else tryItem (index - 1) t - | _ -> - None - - [] - let nth list index = item index list - - [] - let choose chooser list = Microsoft.FSharp.Primitives.Basics.List.choose chooser list - - [] - let splitAt index (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.splitAt index list - - [] - let take count (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.take count list - - [] - let takeWhile predicate (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.takeWhile predicate list - - [] - let inline iteri ([] action) (list: 'T list) = - let mutable n = 0 - for x in list do action n x; n <- n + 1 - - [] - let init length initializer = Microsoft.FSharp.Primitives.Basics.List.init length initializer - - [] - let replicate count initial = - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) - let mutable result = [] - for i in 0..count-1 do - result <- initial :: result - result - - [] - let iter2 action list1 list2 = - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(action) - let rec loop list1 list2 = - match list1, list2 with - | [], [] -> () - | h1 :: t1, h2 :: t2 -> f.Invoke(h1, h2); loop t1 t2 - | [], xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length - | xs1, [] -> invalidArgDifferentListLength "list2" "list1" xs1.Length - loop list1 list2 - - [] - let iteri2 action list1 list2 = - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(action) - let rec loop n list1 list2 = - match list1, list2 with - | [], [] -> () - | h1 :: t1, h2 :: t2 -> f.Invoke(n, h1, h2); loop (n+1) t1 t2 - | [], xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length - | xs1, [] -> invalidArgDifferentListLength "list2" "list1" xs1.Length - loop 0 list1 list2 - - [] - let map3 mapping list1 list2 list3 = - Microsoft.FSharp.Primitives.Basics.List.map3 mapping list1 list2 list3 - - [] - let mapi2 mapping list1 list2 = - Microsoft.FSharp.Primitives.Basics.List.mapi2 mapping list1 list2 - - [] - let map2 mapping list1 list2 = Microsoft.FSharp.Primitives.Basics.List.map2 mapping list1 list2 - - [] - let fold<'T, 'State> folder (state:'State) (list: 'T list) = - match list with - | [] -> state - | _ -> - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) - let mutable acc = state - for x in list do - acc <- f.Invoke(acc, x) - acc - - [] - let pairwise (list: 'T list) = - Microsoft.FSharp.Primitives.Basics.List.pairwise list - - [] - let reduce reduction list = - match list with - | [] -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) - | h :: t -> fold reduction h t - - [] - let scan<'T, 'State> folder (state:'State) (list: 'T list) = - Microsoft.FSharp.Primitives.Basics.List.scan folder state list - - [] - let inline singleton value = [value] - - [] - let fold2<'T1, 'T2, 'State> folder (state:'State) (list1:'T1 list) (list2:'T2 list) = - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(folder) - let rec loop acc list1 list2 = - match list1, list2 with - | [], [] -> acc - | h1 :: t1, h2 :: t2 -> loop (f.Invoke(acc, h1, h2)) t1 t2 - | [], xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length - | xs1, [] -> invalidArgDifferentListLength "list2" "list1" xs1.Length - loop state list1 list2 - - let foldArraySubRight (f:OptimizedClosures.FSharpFunc<'T, _, _>) (arr: 'T[]) start fin acc = - let mutable state = acc - for i = fin downto start do - state <- f.Invoke(arr.[i], state) - state - - // this version doesn't causes stack overflow - it uses a private stack - [] - let foldBack<'T, 'State> folder (list: 'T list) (state:'State) = - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) - match list with - | [] -> state - | [h] -> f.Invoke(h, state) - | [h1; h2] -> f.Invoke(h1, f.Invoke(h2, state)) - | [h1; h2; h3] -> f.Invoke(h1, f.Invoke(h2, f.Invoke(h3, state))) - | [h1; h2; h3; h4] -> f.Invoke(h1, f.Invoke(h2, f.Invoke(h3, f.Invoke(h4, state)))) - | _ -> - // It is faster to allocate and iterate an array than to create all those - // highly nested stacks. It also means we won't get stack overflows here. - let arr = toArray list - let arrn = arr.Length - foldArraySubRight f arr 0 (arrn - 1) state - - [] - let reduceBack reduction list = - match list with - | [] -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) - | _ -> - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(reduction) - let arr = toArray list - let arrn = arr.Length - foldArraySubRight f arr 0 (arrn - 2) arr.[arrn - 1] - - let scanArraySubRight<'T, 'State> (f:OptimizedClosures.FSharpFunc<'T, 'State, 'State>) (arr: _[]) start fin initState = - let mutable state = initState - let mutable res = [state] - for i = fin downto start do - state <- f.Invoke(arr.[i], state) - res <- state :: res - res - - [] - let scanBack<'T, 'State> folder (list: 'T list) (state:'State) = - match list with - | [] -> [state] - | [h] -> - [folder h state; state] - | _ -> - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) - // It is faster to allocate and iterate an array than to create all those - // highly nested stacks. It also means we won't get stack overflows here. - let arr = toArray list - let arrn = arr.Length - scanArraySubRight f arr 0 (arrn - 1) state - - let foldBack2UsingArrays (f:OptimizedClosures.FSharpFunc<_, _, _, _>) list1 list2 acc = - let arr1 = toArray list1 - let arr2 = toArray list2 - let n1 = arr1.Length - let n2 = arr2.Length - if n1 <> n2 then - invalidArgFmt "list1, list2" - "{0}\nlist1.Length = {1}, list2.Length = {2}" - [|SR.GetString SR.listsHadDifferentLengths; arr1.Length; arr2.Length|] - let mutable res = acc - for i = n1 - 1 downto 0 do - res <- f.Invoke(arr1.[i], arr2.[i], res) - res - - [] - let rec foldBack2<'T1, 'T2, 'State> folder (list1:'T1 list) (list2:'T2 list) (state:'State) = +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Core.LanguagePrimitives +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Core.CompilerServices +open System.Collections.Generic + +[] +[] +module List = + + let inline checkNonNull argName arg = + if isNull arg then + nullArg argName + + let inline indexNotFound() = raise (KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt))) + + [] + let length (list: 'T list) = list.Length + + [] + let last (list: 'T list) = + match Microsoft.FSharp.Primitives.Basics.List.tryLastV list with + | ValueSome x -> x + | ValueNone -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) + + [] + let rec tryLast (list: 'T list) = + match Microsoft.FSharp.Primitives.Basics.List.tryLastV list with + | ValueSome x -> Some x + | ValueNone -> None + + [] + let rev list = Microsoft.FSharp.Primitives.Basics.List.rev list + + [] + let concat lists = Microsoft.FSharp.Primitives.Basics.List.concat lists + + let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] projection: 'T->'SafeKey) ([] getKey:'SafeKey->'Key) (list: 'T list) = + let dict = Dictionary comparer + let rec loop srcList = + match srcList with + | [] -> () + | h :: t -> + let safeKey = projection h + let mutable prev = 0 + if dict.TryGetValue(safeKey, &prev) then dict.[safeKey] <- prev + 1 else dict.[safeKey] <- 1 + loop t + loop list + Microsoft.FSharp.Primitives.Basics.List.countBy dict getKey + + // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance + let countByValueType (projection: 'T->'Key) (list: 'T list) = countByImpl HashIdentity.Structural<'Key> projection id list + + // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation + let countByRefType (projection: 'T->'Key) (list: 'T list) = countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (projection t)) (fun sb -> sb.Value) list + + [] + let countBy (projection: 'T->'Key) (list: 'T list) = + match list with + | [] -> [] + | _ -> + if typeof<'Key>.IsValueType + then countByValueType projection list + else countByRefType projection list + + [] + let map mapping list = Microsoft.FSharp.Primitives.Basics.List.map mapping list + + [] + let mapi mapping list = Microsoft.FSharp.Primitives.Basics.List.mapi mapping list + + [] + let indexed list = Microsoft.FSharp.Primitives.Basics.List.indexed list + + [] + let mapFold<'T, 'State, 'Result> (mapping:'State -> 'T -> 'Result * 'State) state list = + Microsoft.FSharp.Primitives.Basics.List.mapFold mapping state list + + [] + let mapFoldBack<'T, 'State, 'Result> (mapping: 'T -> 'State -> 'Result * 'State) list state = + match list with + | [] -> [], state + | [h] -> let h', s' = mapping h state in [h'], s' + | _ -> + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(mapping) + let rec loop res list = + match list, res with + | [], _ -> res + | h :: t, (list', acc') -> + let h', s' = f.Invoke(h, acc') + loop (h' :: list', s') t + loop ([], state) (rev list) + + [] + let inline iter ([] action) (list: 'T list) = for x in list do action x + + [] + let distinct (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctWithComparer HashIdentity.Structural<'T> list + + [] + let distinctBy projection (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctByWithComparer HashIdentity.Structural<_> projection list + + [] + let ofArray (array: 'T array) = Microsoft.FSharp.Primitives.Basics.List.ofArray array + + [] + let toArray (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.toArray list + + [] + let empty<'T> = ([ ] : 'T list) + + [] + let head list = match list with x :: _ -> x | [] -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) + + [] + let tryHead list = match list with x :: _ -> Some x | [] -> None + + [] + let tail list = match list with _ :: t -> t | [] -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) + + [] + let isEmpty list = match list with [] -> true | _ -> false + + [] + let append list1 list2 = list1 @ list2 + + [] + let rec item index list = + match list with + | h :: t when index >= 0 -> + if index = 0 then h else item (index - 1) t + | _ -> + invalidArg "index" (SR.GetString(SR.indexOutOfBounds)) + + [] + let rec tryItem index list = + match list with + | h :: t when index >= 0 -> + if index = 0 then Some h else tryItem (index - 1) t + | _ -> + None + + [] + let nth list index = item index list + + [] + let choose chooser list = Microsoft.FSharp.Primitives.Basics.List.choose chooser list + + [] + let splitAt index (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.splitAt index list + + [] + let take count (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.take count list + + [] + let takeWhile predicate (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.takeWhile predicate list + + [] + let inline iteri ([] action) (list: 'T list) = + let mutable n = 0 + for x in list do action n x; n <- n + 1 + + [] + let init length initializer = Microsoft.FSharp.Primitives.Basics.List.init length initializer + + [] + let replicate count initial = + if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + let mutable result = [] + for i in 0..count-1 do + result <- initial :: result + result + + [] + let iter2 action list1 list2 = + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(action) + let rec loop list1 list2 = match list1, list2 with - | [], [] -> state - | h1 :: rest1, k1 :: rest2 -> - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(folder) - match rest1, rest2 with - | [], [] -> f.Invoke(h1, k1, state) - | [h2], [k2] -> f.Invoke(h1, k1, f.Invoke(h2, k2, state)) - | [h2; h3], [k2; k3] -> f.Invoke(h1, k1, f.Invoke(h2, k2, f.Invoke(h3, k3, state))) - | [h2; h3; h4], [k2; k3; k4] -> f.Invoke(h1, k1, f.Invoke(h2, k2, f.Invoke(h3, k3, f.Invoke(h4, k4, state)))) - | _ -> foldBack2UsingArrays f list1 list2 state + | [], [] -> () + | h1 :: t1, h2 :: t2 -> f.Invoke(h1, h2); loop t1 t2 | [], xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length | xs1, [] -> invalidArgDifferentListLength "list2" "list1" xs1.Length + loop list1 list2 - let rec forall2aux (f:OptimizedClosures.FSharpFunc<_, _, _>) list1 list2 = + [] + let iteri2 action list1 list2 = + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(action) + let rec loop n list1 list2 = match list1, list2 with - | [], [] -> true - | h1 :: t1, h2 :: t2 -> f.Invoke(h1, h2) && forall2aux f t1 t2 + | [], [] -> () + | h1 :: t1, h2 :: t2 -> f.Invoke(n, h1, h2); loop (n+1) t1 t2 | [], xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length | xs1, [] -> invalidArgDifferentListLength "list2" "list1" xs1.Length + loop 0 list1 list2 - [] - let forall2 predicate list1 list2 = - match list1, list2 with - | [], [] -> true - | _ -> - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(predicate) - forall2aux f list1 list2 - - [] - let forall predicate list = Microsoft.FSharp.Primitives.Basics.List.forall predicate list - - [] - let exists predicate list = Microsoft.FSharp.Primitives.Basics.List.exists predicate list - - [] - let inline contains value source = - let rec contains e xs1 = - match xs1 with - | [] -> false - | h1 :: t1 -> e = h1 || contains e t1 - contains value source - - let rec exists2aux (f:OptimizedClosures.FSharpFunc<_, _, _>) list1 list2 = - match list1, list2 with - | [], [] -> false - | h1 :: t1, h2 :: t2 ->f.Invoke(h1, h2) || exists2aux f t1 t2 - | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + [] + let map3 mapping list1 list2 list3 = + Microsoft.FSharp.Primitives.Basics.List.map3 mapping list1 list2 list3 - [] - let rec exists2 predicate list1 list2 = - match list1, list2 with - | [], [] -> false - | _ -> - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(predicate) - exists2aux f list1 list2 - - [] - let rec find predicate list = - match list with - | [] -> indexNotFound() - | h :: t -> if predicate h then h else find predicate t - - [] - let rec tryFind predicate list = - match list with - | [] -> None - | h :: t -> if predicate h then Some h else tryFind predicate t + [] + let mapi2 mapping list1 list2 = + Microsoft.FSharp.Primitives.Basics.List.mapi2 mapping list1 list2 - [] - let findBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.findBack predicate - - [] - let tryFindBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.tryFindBack predicate - - [] - let rec tryPick chooser list = - match list with - | [] -> None - | h :: t -> - match chooser h with - | None -> tryPick chooser t - | r -> r + [] + let map2 mapping list1 list2 = Microsoft.FSharp.Primitives.Basics.List.map2 mapping list1 list2 - [] - let rec pick chooser list = - match list with + [] + let fold<'T, 'State> folder (state:'State) (list: 'T list) = + match list with + | [] -> state + | _ -> + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) + let mutable acc = state + for x in list do + acc <- f.Invoke(acc, x) + acc + + [] + let pairwise (list: 'T list) = + Microsoft.FSharp.Primitives.Basics.List.pairwise list + + [] + let reduce reduction list = + match list with + | [] -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) + | h :: t -> fold reduction h t + + [] + let scan<'T, 'State> folder (state:'State) (list: 'T list) = + Microsoft.FSharp.Primitives.Basics.List.scan folder state list + + [] + let inline singleton value = [value] + + [] + let fold2<'T1, 'T2, 'State> folder (state:'State) (list1:'T1 list) (list2:'T2 list) = + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(folder) + let rec loop acc list1 list2 = + match list1, list2 with + | [], [] -> acc + | h1 :: t1, h2 :: t2 -> loop (f.Invoke(acc, h1, h2)) t1 t2 + | [], xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1, [] -> invalidArgDifferentListLength "list2" "list1" xs1.Length + loop state list1 list2 + + let foldArraySubRight (f:OptimizedClosures.FSharpFunc<'T, _, _>) (arr: 'T[]) start fin acc = + let mutable state = acc + for i = fin downto start do + state <- f.Invoke(arr.[i], state) + state + + // this version doesn't causes stack overflow - it uses a private stack + [] + let foldBack<'T, 'State> folder (list: 'T list) (state:'State) = + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) + match list with + | [] -> state + | [h] -> f.Invoke(h, state) + | [h1; h2] -> f.Invoke(h1, f.Invoke(h2, state)) + | [h1; h2; h3] -> f.Invoke(h1, f.Invoke(h2, f.Invoke(h3, state))) + | [h1; h2; h3; h4] -> f.Invoke(h1, f.Invoke(h2, f.Invoke(h3, f.Invoke(h4, state)))) + | _ -> + // It is faster to allocate and iterate an array than to create all those + // highly nested stacks. It also means we won't get stack overflows here. + let arr = toArray list + let arrn = arr.Length + foldArraySubRight f arr 0 (arrn - 1) state + + [] + let reduceBack reduction list = + match list with + | [] -> invalidArg "list" (SR.GetString(SR.inputListWasEmpty)) + | _ -> + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(reduction) + let arr = toArray list + let arrn = arr.Length + foldArraySubRight f arr 0 (arrn - 2) arr.[arrn - 1] + + let scanArraySubRight<'T, 'State> (f:OptimizedClosures.FSharpFunc<'T, 'State, 'State>) (arr: _[]) start fin initState = + let mutable state = initState + let mutable res = [state] + for i = fin downto start do + state <- f.Invoke(arr.[i], state) + res <- state :: res + res + + [] + let scanBack<'T, 'State> folder (list: 'T list) (state:'State) = + match list with + | [] -> [state] + | [h] -> + [folder h state; state] + | _ -> + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) + // It is faster to allocate and iterate an array than to create all those + // highly nested stacks. It also means we won't get stack overflows here. + let arr = toArray list + let arrn = arr.Length + scanArraySubRight f arr 0 (arrn - 1) state + + let foldBack2UsingArrays (f:OptimizedClosures.FSharpFunc<_, _, _, _>) list1 list2 acc = + let arr1 = toArray list1 + let arr2 = toArray list2 + let n1 = arr1.Length + let n2 = arr2.Length + if n1 <> n2 then + invalidArgFmt "list1, list2" + "{0}\nlist1.Length = {1}, list2.Length = {2}" + [|SR.GetString SR.listsHadDifferentLengths; arr1.Length; arr2.Length|] + let mutable res = acc + for i = n1 - 1 downto 0 do + res <- f.Invoke(arr1.[i], arr2.[i], res) + res + + [] + let rec foldBack2<'T1, 'T2, 'State> folder (list1:'T1 list) (list2:'T2 list) (state:'State) = + match list1, list2 with + | [], [] -> state + | h1 :: rest1, k1 :: rest2 -> + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(folder) + match rest1, rest2 with + | [], [] -> f.Invoke(h1, k1, state) + | [h2], [k2] -> f.Invoke(h1, k1, f.Invoke(h2, k2, state)) + | [h2; h3], [k2; k3] -> f.Invoke(h1, k1, f.Invoke(h2, k2, f.Invoke(h3, k3, state))) + | [h2; h3; h4], [k2; k3; k4] -> f.Invoke(h1, k1, f.Invoke(h2, k2, f.Invoke(h3, k3, f.Invoke(h4, k4, state)))) + | _ -> foldBack2UsingArrays f list1 list2 state + | [], xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1, [] -> invalidArgDifferentListLength "list2" "list1" xs1.Length + + let rec forall2aux (f:OptimizedClosures.FSharpFunc<_, _, _>) list1 list2 = + match list1, list2 with + | [], [] -> true + | h1 :: t1, h2 :: t2 -> f.Invoke(h1, h2) && forall2aux f t1 t2 + | [], xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1, [] -> invalidArgDifferentListLength "list2" "list1" xs1.Length + + [] + let forall2 predicate list1 list2 = + match list1, list2 with + | [], [] -> true + | _ -> + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(predicate) + forall2aux f list1 list2 + + [] + let forall predicate list = Microsoft.FSharp.Primitives.Basics.List.forall predicate list + + [] + let exists predicate list = Microsoft.FSharp.Primitives.Basics.List.exists predicate list + + [] + let inline contains value source = + let rec contains e xs1 = + match xs1 with + | [] -> false + | h1 :: t1 -> e = h1 || contains e t1 + contains value source + + let rec exists2aux (f:OptimizedClosures.FSharpFunc<_, _, _>) list1 list2 = + match list1, list2 with + | [], [] -> false + | h1 :: t1, h2 :: t2 ->f.Invoke(h1, h2) || exists2aux f t1 t2 + | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + + [] + let rec exists2 predicate list1 list2 = + match list1, list2 with + | [], [] -> false + | _ -> + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(predicate) + exists2aux f list1 list2 + + [] + let rec find predicate list = + match list with + | [] -> indexNotFound() + | h :: t -> if predicate h then h else find predicate t + + [] + let rec tryFind predicate list = + match list with + | [] -> None + | h :: t -> if predicate h then Some h else tryFind predicate t + + [] + let findBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.findBack predicate + + [] + let tryFindBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.tryFindBack predicate + + [] + let rec tryPick chooser list = + match list with + | [] -> None + | h :: t -> + match chooser h with + | None -> tryPick chooser t + | r -> r + + [] + let rec pick chooser list = + match list with + | [] -> indexNotFound() + | h :: t -> + match chooser h with + | None -> pick chooser t + | Some r -> r + + [] + let filter predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list + + [] + let except (itemsToExclude: seq<'T>) list = + checkNonNull "itemsToExclude" itemsToExclude + match list with + | [] -> list + | _ -> + let cached = HashSet(itemsToExclude, HashIdentity.Structural) + list |> filter cached.Add + + [] + let where predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list + + let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) (keyf: 'T->'SafeKey) (getKey:'SafeKey->'Key) (list: 'T list) = + Microsoft.FSharp.Primitives.Basics.List.groupBy comparer keyf getKey list + + // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance + let groupByValueType (keyf: 'T->'Key) (list: 'T list) = groupByImpl HashIdentity.Structural<'Key> keyf id list + + // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation + let groupByRefType (keyf: 'T->'Key) (list: 'T list) = groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) list + + [] + let groupBy (projection: 'T->'Key) (list: 'T list) = + match list with + | [] -> [] + | _ -> + if typeof<'Key>.IsValueType + then groupByValueType projection list + else groupByRefType projection list + + [] + let partition predicate list = Microsoft.FSharp.Primitives.Basics.List.partition predicate list + + [] + let unzip list = Microsoft.FSharp.Primitives.Basics.List.unzip list + + [] + let unzip3 list = Microsoft.FSharp.Primitives.Basics.List.unzip3 list + + [] + let windowed windowSize list = Microsoft.FSharp.Primitives.Basics.List.windowed windowSize list + + [] + let chunkBySize chunkSize list = Microsoft.FSharp.Primitives.Basics.List.chunkBySize chunkSize list + + [] + let splitInto count list = Microsoft.FSharp.Primitives.Basics.List.splitInto count list + + [] + let zip list1 list2 = Microsoft.FSharp.Primitives.Basics.List.zip list1 list2 + + [] + let zip3 list1 list2 list3 = Microsoft.FSharp.Primitives.Basics.List.zip3 list1 list2 list3 + + [] + let skip count list = + if count <= 0 then list else + let rec loop i lst = + match lst with + | _ when i = 0 -> lst + | _ :: t -> loop (i-1) t + | [] -> invalidArgOutOfRange "count" count "distance past the list" i + loop count list + + [] + let rec skipWhile predicate list = + match list with + | head :: tail when predicate head -> skipWhile predicate tail + | _ -> list + + [] + let sortWith comparer list = + match list with + | [] | [_] -> list + | _ -> + let array = Microsoft.FSharp.Primitives.Basics.List.toArray list + Microsoft.FSharp.Primitives.Basics.Array.stableSortInPlaceWith comparer array + Microsoft.FSharp.Primitives.Basics.List.ofArray array + + [] + let sortBy projection list = + match list with + | [] | [_] -> list + | _ -> + let array = Microsoft.FSharp.Primitives.Basics.List.toArray list + Microsoft.FSharp.Primitives.Basics.Array.stableSortInPlaceBy projection array + Microsoft.FSharp.Primitives.Basics.List.ofArray array + + [] + let sort list = + match list with + | [] | [_] -> list + | _ -> + let array = Microsoft.FSharp.Primitives.Basics.List.toArray list + Microsoft.FSharp.Primitives.Basics.Array.stableSortInPlace array + Microsoft.FSharp.Primitives.Basics.List.ofArray array + + [] + let inline sortByDescending projection list = + let inline compareDescending a b = compare (projection b) (projection a) + sortWith compareDescending list + + [] + let inline sortDescending list = + let inline compareDescending a b = compare b a + sortWith compareDescending list + + [] + let ofSeq source = Seq.toList source + + [] + let toSeq list = Seq.ofList list + + [] + let findIndex predicate list = + let rec loop n list = + match list with | [] -> indexNotFound() - | h :: t -> - match chooser h with - | None -> pick chooser t - | Some r -> r + | h :: t -> if predicate h then n else loop (n + 1) t - [] - let filter predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list + loop 0 list - [] - let except (itemsToExclude: seq<'T>) list = - checkNonNull "itemsToExclude" itemsToExclude + [] + let tryFindIndex predicate list = + let rec loop n list = match list with - | [] -> list - | _ -> - let cached = HashSet(itemsToExclude, HashIdentity.Structural) - list |> filter cached.Add - - [] - let where predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list - - let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) (keyf: 'T->'SafeKey) (getKey:'SafeKey->'Key) (list: 'T list) = - Microsoft.FSharp.Primitives.Basics.List.groupBy comparer keyf getKey list - - // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let groupByValueType (keyf: 'T->'Key) (list: 'T list) = groupByImpl HashIdentity.Structural<'Key> keyf id list - - // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let groupByRefType (keyf: 'T->'Key) (list: 'T list) = groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) list - - [] - let groupBy (projection: 'T->'Key) (list: 'T list) = - match list with - | [] -> [] - | _ -> - if typeof<'Key>.IsValueType - then groupByValueType projection list - else groupByRefType projection list - - [] - let partition predicate list = Microsoft.FSharp.Primitives.Basics.List.partition predicate list - - [] - let unzip list = Microsoft.FSharp.Primitives.Basics.List.unzip list - - [] - let unzip3 list = Microsoft.FSharp.Primitives.Basics.List.unzip3 list - - [] - let windowed windowSize list = Microsoft.FSharp.Primitives.Basics.List.windowed windowSize list - - [] - let chunkBySize chunkSize list = Microsoft.FSharp.Primitives.Basics.List.chunkBySize chunkSize list - - [] - let splitInto count list = Microsoft.FSharp.Primitives.Basics.List.splitInto count list - - [] - let zip list1 list2 = Microsoft.FSharp.Primitives.Basics.List.zip list1 list2 - - [] - let zip3 list1 list2 list3 = Microsoft.FSharp.Primitives.Basics.List.zip3 list1 list2 list3 - - [] - let skip count list = - if count <= 0 then list else - let rec loop i lst = - match lst with - | _ when i = 0 -> lst - | _ :: t -> loop (i-1) t - | [] -> invalidArgOutOfRange "count" count "distance past the list" i - loop count list - - [] - let rec skipWhile predicate list = - match list with - | head :: tail when predicate head -> skipWhile predicate tail - | _ -> list - - [] - let sortWith comparer list = - match list with - | [] | [_] -> list - | _ -> - let array = Microsoft.FSharp.Primitives.Basics.List.toArray list - Microsoft.FSharp.Primitives.Basics.Array.stableSortInPlaceWith comparer array - Microsoft.FSharp.Primitives.Basics.List.ofArray array - - [] - let sortBy projection list = - match list with - | [] | [_] -> list - | _ -> - let array = Microsoft.FSharp.Primitives.Basics.List.toArray list - Microsoft.FSharp.Primitives.Basics.Array.stableSortInPlaceBy projection array - Microsoft.FSharp.Primitives.Basics.List.ofArray array - - [] - let sort list = - match list with - | [] | [_] -> list - | _ -> - let array = Microsoft.FSharp.Primitives.Basics.List.toArray list - Microsoft.FSharp.Primitives.Basics.Array.stableSortInPlace array - Microsoft.FSharp.Primitives.Basics.List.ofArray array - - [] - let inline sortByDescending projection list = - let inline compareDescending a b = compare (projection b) (projection a) - sortWith compareDescending list - - [] - let inline sortDescending list = - let inline compareDescending a b = compare b a - sortWith compareDescending list - - [] - let ofSeq source = Seq.toList source - - [] - let toSeq list = Seq.ofList list - - [] - let findIndex predicate list = - let rec loop n list = - match list with - | [] -> indexNotFound() - | h :: t -> if predicate h then n else loop (n + 1) t - - loop 0 list - - [] - let tryFindIndex predicate list = - let rec loop n list = - match list with - | [] -> None - | h :: t -> if predicate h then Some n else loop (n + 1) t - - loop 0 list - - [] - let findIndexBack predicate list = - list - |> toArray - |> Microsoft.FSharp.Primitives.Basics.Array.findIndexBack predicate - - [] - let tryFindIndexBack predicate list = - list - |> toArray - |> Microsoft.FSharp.Primitives.Basics.Array.tryFindIndexBack predicate - - [] - let inline sum (list: 'T list) = - match list with - | [] -> LanguagePrimitives.GenericZero<'T> - | t -> - let mutable acc = LanguagePrimitives.GenericZero<'T> - for x in t do - acc <- Checked.(+) acc x - acc - - [] - let inline sumBy ([] projection: 'T -> 'U) (list: 'T list) = - match list with - | [] -> LanguagePrimitives.GenericZero<'U> - | t -> - let mutable acc = LanguagePrimitives.GenericZero<'U> - for x in t do - acc <- Checked.(+) acc (projection x) - acc - - [] - let inline max (list: _ list) = - match list with - | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | h :: t -> - let mutable acc = h - for x in t do - if x > acc then - acc <- x - acc - - [] - let inline maxBy projection (list: _ list) = - match list with - | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | h :: t -> - let mutable acc = h - let mutable accv = projection h - for x in t do - let currv = projection x - if currv > accv then - acc <- x - accv <- currv - acc - - [] - let inline min (list: _ list) = - match list with - | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | h :: t -> - let mutable acc = h - for x in t do - if x < acc then - acc <- x - acc - - [] - let inline minBy projection (list: _ list) = - match list with - | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | h :: t -> - let mutable acc = h - let mutable accv = projection h - for x in t do - let currv = projection x - if currv < accv then - acc <- x - accv <- currv - acc - - [] - let inline average (list: 'T list) = - match list with - | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | xs -> - let mutable sum = LanguagePrimitives.GenericZero<'T> - let mutable count = 0 - for x in xs do - sum <- Checked.(+) sum x - count <- count + 1 - LanguagePrimitives.DivideByInt sum count - - [] - let inline averageBy ([] projection: 'T -> 'U) (list: 'T list) = - match list with - | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | xs -> - let mutable sum = LanguagePrimitives.GenericZero<'U> - let mutable count = 0 - for x in xs do - sum <- Checked.(+) sum (projection x) - count <- count + 1 - LanguagePrimitives.DivideByInt sum count - - [] - let collect mapping list = Microsoft.FSharp.Primitives.Basics.List.collect mapping list - - [] - let allPairs list1 list2 = Microsoft.FSharp.Primitives.Basics.List.allPairs list1 list2 - - [] - let inline compareWith ([] comparer: 'T -> 'T -> int) (list1: 'T list) (list2: 'T list) = - let rec loop list1 list2 = - match list1, list2 with - | head1 :: tail1, head2 :: tail2 -> - let c = comparer head1 head2 - if c = 0 then loop tail1 tail2 else c - | [], [] -> 0 - | _, [] -> 1 - | [], _ -> -1 - - loop list1 list2 - - [] - let permute indexMap list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.permute indexMap |> ofArray - - [] - let exactlyOne (list: _ list) = - match list with - | [x] -> x - | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | _ -> invalidArg "source" (SR.GetString(SR.inputSequenceTooLong)) - - [] - let tryExactlyOne (list: _ list) = - match list with - | [x] -> Some x - | _ -> None - - [] - let transpose (lists: seq<'T list>) = - checkNonNull "lists" lists - Microsoft.FSharp.Primitives.Basics.List.transpose (ofSeq lists) - - [] - let truncate count list = Microsoft.FSharp.Primitives.Basics.List.truncate count list - - [] - let unfold<'T, 'State> (generator:'State -> ('T*'State) option) (state:'State) = Microsoft.FSharp.Primitives.Basics.List.unfold generator state - - [] - let removeAt (index: int) (source: 'T list) : 'T list = - if index < 0 then invalidArg "index" "index must be within bounds of the list" - - let mutable i = 0 - let mutable coll = ListCollector() - let mutable curr = source - while i < index do // traverse and save the linked list until item to be removed - match curr with - | [] -> invalidArg "index" "index must be within bounds of the list" - | h::t -> - coll.Add(h) - curr <- t - i <- i + 1 - if curr.IsEmpty then invalidArg "index" "index must be within bounds of the list" - else coll.AddManyAndClose(curr.Tail) // when i = index, Head is the item which is ignored and Tail is the rest of the list - - [] - let removeManyAt (index: int) (count: int) (source: 'T list) : 'T list = - if index < 0 then invalidArg "index" "index must be within bounds of the list" - - let mutable i = 0 - let mutable coll = ListCollector() - let mutable curr = source - while i < index + count do // traverse and save the linked list until the last item to be removed - match curr with - | [] -> invalidArg "index" "index must be within bounds of the list" - | h::t -> - if i < index then coll.Add(h) //items before index we keep - curr <- t - i <- i + 1 - coll.AddManyAndClose(curr) // when i = index + count, we keep the rest of the list - - [] - let updateAt (index: int) (value: 'T) (source: 'T list) : 'T list = - if index < 0 then invalidArg "index" "index must be within bounds of the list" - - let mutable i = 0 - let mutable coll = ListCollector() - let mutable curr = source - while i < index do // Traverse and save the linked list until index - match curr with - | [] -> invalidArg "index" "index must be within bounds of the list" - | h::t -> - coll.Add(h) - curr <- t - i <- i + 1 - coll.Add(value) // add value instead of Head - if curr.IsEmpty then invalidArg "index" "index must be within bounds of the list" - else coll.AddManyAndClose(curr.Tail) - - [] - let insertAt (index: int) (value: 'T) (source: 'T list) : 'T list = - if index < 0 then invalidArg "index" "index must be within bounds of the list" - - let mutable i = 0 - let mutable coll = ListCollector() - let mutable curr = source - while i < index do // traverse and save the linked list until index - match curr with - | [] -> invalidArg "index" "index must be within bounds of the list" - | h::t -> - coll.Add(h) - curr <- t - i <- i + 1 - - coll.Add(value) - coll.AddManyAndClose(curr) // insert item BEFORE the item at the index - - [] - let insertManyAt (index: int) (values: seq<'T>) (source: 'T list) : 'T list = - if index < 0 then invalidArg "index" "index must be within bounds of the list" - - let mutable i = 0 - let mutable coll = ListCollector() - let mutable curr = source - while i < index do // traverse and save the linked list until index - match curr with - | [] -> invalidArg "index" "index must be within bounds of the list" - | h::t -> - coll.Add(h) - curr <- t - i <- i + 1 - coll.AddMany(values) // insert values BEFORE the item at the index - coll.AddManyAndClose(curr) \ No newline at end of file + | [] -> None + | h :: t -> if predicate h then Some n else loop (n + 1) t + + loop 0 list + + [] + let findIndexBack predicate list = + list + |> toArray + |> Microsoft.FSharp.Primitives.Basics.Array.findIndexBack predicate + + [] + let tryFindIndexBack predicate list = + list + |> toArray + |> Microsoft.FSharp.Primitives.Basics.Array.tryFindIndexBack predicate + + [] + let inline sum (list: 'T list) = + match list with + | [] -> LanguagePrimitives.GenericZero<'T> + | t -> + let mutable acc = LanguagePrimitives.GenericZero<'T> + for x in t do + acc <- Checked.(+) acc x + acc + + [] + let inline sumBy ([] projection: 'T -> 'U) (list: 'T list) = + match list with + | [] -> LanguagePrimitives.GenericZero<'U> + | t -> + let mutable acc = LanguagePrimitives.GenericZero<'U> + for x in t do + acc <- Checked.(+) acc (projection x) + acc + + [] + let inline max (list: _ list) = + match list with + | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | h :: t -> + let mutable acc = h + for x in t do + if x > acc then + acc <- x + acc + + [] + let inline maxBy projection (list: _ list) = + match list with + | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | h :: t -> + let mutable acc = h + let mutable accv = projection h + for x in t do + let currv = projection x + if currv > accv then + acc <- x + accv <- currv + acc + + [] + let inline min (list: _ list) = + match list with + | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | h :: t -> + let mutable acc = h + for x in t do + if x < acc then + acc <- x + acc + + [] + let inline minBy projection (list: _ list) = + match list with + | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | h :: t -> + let mutable acc = h + let mutable accv = projection h + for x in t do + let currv = projection x + if currv < accv then + acc <- x + accv <- currv + acc + + [] + let inline average (list: 'T list) = + match list with + | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | xs -> + let mutable sum = LanguagePrimitives.GenericZero<'T> + let mutable count = 0 + for x in xs do + sum <- Checked.(+) sum x + count <- count + 1 + LanguagePrimitives.DivideByInt sum count + + [] + let inline averageBy ([] projection: 'T -> 'U) (list: 'T list) = + match list with + | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | xs -> + let mutable sum = LanguagePrimitives.GenericZero<'U> + let mutable count = 0 + for x in xs do + sum <- Checked.(+) sum (projection x) + count <- count + 1 + LanguagePrimitives.DivideByInt sum count + + [] + let collect mapping list = Microsoft.FSharp.Primitives.Basics.List.collect mapping list + + [] + let allPairs list1 list2 = Microsoft.FSharp.Primitives.Basics.List.allPairs list1 list2 + + [] + let inline compareWith ([] comparer: 'T -> 'T -> int) (list1: 'T list) (list2: 'T list) = + let rec loop list1 list2 = + match list1, list2 with + | head1 :: tail1, head2 :: tail2 -> + let c = comparer head1 head2 + if c = 0 then loop tail1 tail2 else c + | [], [] -> 0 + | _, [] -> 1 + | [], _ -> -1 + + loop list1 list2 + + [] + let permute indexMap list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.permute indexMap |> ofArray + + [] + let exactlyOne (list: _ list) = + match list with + | [x] -> x + | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | _ -> invalidArg "source" (SR.GetString(SR.inputSequenceTooLong)) + + [] + let tryExactlyOne (list: _ list) = + match list with + | [x] -> Some x + | _ -> None + + [] + let transpose (lists: seq<'T list>) = + checkNonNull "lists" lists + Microsoft.FSharp.Primitives.Basics.List.transpose (ofSeq lists) + + [] + let truncate count list = Microsoft.FSharp.Primitives.Basics.List.truncate count list + + [] + let unfold<'T, 'State> (generator:'State -> ('T*'State) option) (state:'State) = Microsoft.FSharp.Primitives.Basics.List.unfold generator state + + [] + let removeAt (index: int) (source: 'T list) : 'T list = + if index < 0 then invalidArg "index" "index must be within bounds of the list" + + let mutable i = 0 + let mutable coll = ListCollector() + let mutable curr = source + while i < index do // traverse and save the linked list until item to be removed + match curr with + | [] -> invalidArg "index" "index must be within bounds of the list" + | h::t -> + coll.Add(h) + curr <- t + i <- i + 1 + if curr.IsEmpty then invalidArg "index" "index must be within bounds of the list" + else coll.AddManyAndClose(curr.Tail) // when i = index, Head is the item which is ignored and Tail is the rest of the list + + [] + let removeManyAt (index: int) (count: int) (source: 'T list) : 'T list = + if index < 0 then invalidArg "index" "index must be within bounds of the list" + + let mutable i = 0 + let mutable coll = ListCollector() + let mutable curr = source + while i < index + count do // traverse and save the linked list until the last item to be removed + match curr with + | [] -> invalidArg "index" "index must be within bounds of the list" + | h::t -> + if i < index then coll.Add(h) //items before index we keep + curr <- t + i <- i + 1 + coll.AddManyAndClose(curr) // when i = index + count, we keep the rest of the list + + [] + let updateAt (index: int) (value: 'T) (source: 'T list) : 'T list = + if index < 0 then invalidArg "index" "index must be within bounds of the list" + + let mutable i = 0 + let mutable coll = ListCollector() + let mutable curr = source + while i < index do // Traverse and save the linked list until index + match curr with + | [] -> invalidArg "index" "index must be within bounds of the list" + | h::t -> + coll.Add(h) + curr <- t + i <- i + 1 + coll.Add(value) // add value instead of Head + if curr.IsEmpty then invalidArg "index" "index must be within bounds of the list" + else coll.AddManyAndClose(curr.Tail) + + [] + let insertAt (index: int) (value: 'T) (source: 'T list) : 'T list = + if index < 0 then invalidArg "index" "index must be within bounds of the list" + + let mutable i = 0 + let mutable coll = ListCollector() + let mutable curr = source + while i < index do // traverse and save the linked list until index + match curr with + | [] -> invalidArg "index" "index must be within bounds of the list" + | h::t -> + coll.Add(h) + curr <- t + i <- i + 1 + + coll.Add(value) + coll.AddManyAndClose(curr) // insert item BEFORE the item at the index + + [] + let insertManyAt (index: int) (values: seq<'T>) (source: 'T list) : 'T list = + if index < 0 then invalidArg "index" "index must be within bounds of the list" + + let mutable i = 0 + let mutable coll = ListCollector() + let mutable curr = source + while i < index do // traverse and save the linked list until index + match curr with + | [] -> invalidArg "index" "index must be within bounds of the list" + | h::t -> + coll.Add(h) + curr <- t + i <- i + 1 + coll.AddMany(values) // insert values BEFORE the item at the index + coll.AddManyAndClose(curr) \ No newline at end of file diff --git a/src/FSharp.Core/local.fs b/src/FSharp.Core/local.fs index 16c7c77e63e..a00cbbb43b2 100644 --- a/src/FSharp.Core/local.fs +++ b/src/FSharp.Core/local.fs @@ -2,8 +2,10 @@ namespace Microsoft.FSharp.Core + [] module internal DetailedExceptions = + open System open Microsoft.FSharp.Core @@ -85,9 +87,6 @@ module internal List = let inline arrayZeroCreate (n:int) = (# "newarr !0" type ('T) n : 'T array #) - [] - let nonempty x = match x with [] -> false | _ -> true - // optimized mutation-based implementation. This code is only valid in fslib, where mutation of private // tail cons cells is permitted in carefully written library code. let inline setFreshConsTail cons t = cons.( :: ).1 <- t diff --git a/src/FSharp.Core/local.fsi b/src/FSharp.Core/local.fsi index 65a9cd21aa9..ddf14b9c2bc 100644 --- a/src/FSharp.Core/local.fsi +++ b/src/FSharp.Core/local.fsi @@ -70,10 +70,10 @@ module internal List = val splitInto: int -> 'T list -> 'T list list val zip: 'T1 list -> 'T2 list -> ('T1 * 'T2) list val zip3: 'T1 list -> 'T2 list -> 'T3 list -> ('T1 * 'T2 * 'T3) list - val ofArray: 'T [] -> 'T list + val ofArray: 'T[] -> 'T list val take: int -> 'T list -> 'T list val takeWhile: ('T -> bool) -> 'T list -> 'T list - val toArray: 'T list -> 'T [] + val toArray: 'T list -> 'T[] val inline ofSeq: seq<'T> -> 'T List val splitAt: int -> 'T list -> ('T list * 'T list) val transpose: 'T list list -> 'T list list @@ -82,40 +82,40 @@ module internal List = module internal Array = // The input parameter should be checked by callers if necessary - val inline zeroCreateUnchecked: int -> 'T [] + val inline zeroCreateUnchecked: int -> 'T[] - val inline init: int -> (int -> 'T) -> 'T [] + val inline init: int -> (int -> 'T) -> 'T[] - val splitInto: int -> 'T [] -> 'T [] [] + val splitInto: int -> 'T[] -> 'T[][] - val findBack: predicate: ('T -> bool) -> array: 'T [] -> 'T + val findBack: predicate: ('T -> bool) -> array: 'T[] -> 'T - val tryFindBack: predicate: ('T -> bool) -> array: 'T [] -> 'T option + val tryFindBack: predicate: ('T -> bool) -> array: 'T[] -> 'T option - val findIndexBack: predicate: ('T -> bool) -> array: 'T [] -> int + val findIndexBack: predicate: ('T -> bool) -> array: 'T[] -> int - val tryFindIndexBack: predicate: ('T -> bool) -> array: 'T [] -> int option + val tryFindIndexBack: predicate: ('T -> bool) -> array: 'T[] -> int option - val mapFold: ('State -> 'T -> 'U * 'State) -> 'State -> 'T [] -> 'U [] * 'State + val mapFold: ('State -> 'T -> 'U * 'State) -> 'State -> 'T[] -> 'U[] * 'State - val mapFoldBack: ('T -> 'State -> 'U * 'State) -> 'T [] -> 'State -> 'U [] * 'State + val mapFoldBack: ('T -> 'State -> 'U * 'State) -> 'T[] -> 'State -> 'U[] * 'State - val permute: indexMap: (int -> int) -> 'T [] -> 'T [] + val permute: indexMap: (int -> int) -> 'T[] -> 'T[] val scanSubRight: - f: ('T -> 'State -> 'State) -> array: 'T [] -> start: int -> fin: int -> initState: 'State -> 'State [] + f: ('T -> 'State -> 'State) -> array: 'T[] -> start: int -> fin: int -> initState: 'State -> 'State[] - val inline subUnchecked: int -> int -> 'T [] -> 'T [] + val inline subUnchecked: int -> int -> 'T[] -> 'T[] - val unstableSortInPlaceBy: projection: ('T -> 'Key) -> array: 'T [] -> unit when 'Key: comparison + val unstableSortInPlaceBy: projection: ('T -> 'Key) -> array: 'T[] -> unit when 'Key: comparison - val unstableSortInPlace: array: 'T [] -> unit when 'T: comparison + val unstableSortInPlace: array: 'T[] -> unit when 'T: comparison - val stableSortInPlaceBy: projection: ('T -> 'Key) -> array: 'T [] -> unit when 'Key: comparison + val stableSortInPlaceBy: projection: ('T -> 'Key) -> array: 'T[] -> unit when 'Key: comparison - val stableSortInPlaceWith: comparer: ('T -> 'T -> int) -> array: 'T [] -> unit + val stableSortInPlaceWith: comparer: ('T -> 'T -> int) -> array: 'T[] -> unit - val stableSortInPlace: array: 'T [] -> unit when 'T: comparison + val stableSortInPlace: array: 'T[] -> unit when 'T: comparison module internal Seq = val tryLastV: 'T seq -> 'T ValueOption diff --git a/src/FSharp.Core/mailbox.fs b/src/FSharp.Core/mailbox.fs index 96782fa1e15..78035f34727 100644 --- a/src/FSharp.Core/mailbox.fs +++ b/src/FSharp.Core/mailbox.fs @@ -2,439 +2,439 @@ namespace Microsoft.FSharp.Control - open System - open System.Threading - open System.Collections.Generic - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Control - open Microsoft.FSharp.Control.AsyncBuilderImpl - open Microsoft.FSharp.Control.AsyncPrimitives - open Microsoft.FSharp.Collections - - module AsyncHelpers = - - let awaitEither a1 a2 = - 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), - cancellationToken = cancellationToken - ) - start a1 Choice1Of2 - start a2 Choice2Of2 - // 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 there is no specific timeout log to this routine. - let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout - return! CreateAsyncResultAsync result - } - - let timeout msec cancellationToken = - assert (msec >= 0) +open System +open System.Threading +open System.Collections.Generic +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Control +open Microsoft.FSharp.Control.AsyncBuilderImpl +open Microsoft.FSharp.Control.AsyncPrimitives +open Microsoft.FSharp.Collections + +module AsyncHelpers = + + let awaitEither a1 a2 = + async { let resultCell = new ResultCell<_>() - Async.StartWithContinuations( - computation=Async.Sleep msec, - continuation=(fun () -> resultCell.RegisterResult((), reuseThread = false) |> ignore), - exceptionContinuation=ignore, - cancellationContinuation=ignore, - cancellationToken = cancellationToken) + 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), + cancellationToken = cancellationToken + ) + start a1 Choice1Of2 + start a2 Choice2Of2 // 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. - resultCell.AwaitResult_NoDirectCancelOrTimeout - - [] - [] - type Mailbox<'Msg>(cancellationSupported: bool) = - let mutable inboxStore = null - let arrivals = Queue<'Msg>() - let syncRoot = arrivals - - // Control elements indicating the state of the reader. When the reader is "blocked" at an - // 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 - - // Readers who have a timeout use this event - let mutable pulse : AutoResetEvent = null - - // Make sure that the "pulse" value is created - let ensurePulse() = - match pulse with - | null -> - pulse <- new AutoResetEvent(false) - | _ -> - () - pulse - - let waitOneNoTimeoutOrCancellation = - MakeAsync (fun ctxt -> - match savedCont with - | None -> - let descheduled = - // An arrival may have happened while we're preparing to deschedule - lock syncRoot (fun () -> - if arrivals.Count = 0 then - // OK, no arrival so deschedule - savedCont <- Some(fun res -> ctxt.QueueContinuationWithTrampoline res) - 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") - - let waitOneWithCancellation timeout = - Async.AwaitWaitHandle(ensurePulse(), millisecondsTimeout=timeout) - - let waitOne timeout = - if timeout < 0 && not cancellationSupported then - waitOneNoTimeoutOrCancellation - else - waitOneWithCancellation timeout - - member _.inbox = - 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.ScanArrivalsUnsafe f = - if arrivals.Count = 0 then - None + // Note: It is ok to use "NoDirectTimeout" here because there is no specific timeout log to this routine. + let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout + return! CreateAsyncResultAsync result + } + + 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) + // 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. + resultCell.AwaitResult_NoDirectCancelOrTimeout + +[] +[] +type Mailbox<'Msg>(cancellationSupported: bool) = + let mutable inboxStore = null + let arrivals = Queue<'Msg>() + let syncRoot = arrivals + + // Control elements indicating the state of the reader. When the reader is "blocked" at an + // 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 + + // Readers who have a timeout use this event + let mutable pulse : AutoResetEvent = null + + // Make sure that the "pulse" value is created + let ensurePulse() = + match pulse with + | null -> + pulse <- new AutoResetEvent(false) + | _ -> + () + pulse + + let waitOneNoTimeoutOrCancellation = + MakeAsync (fun ctxt -> + match savedCont with + | None -> + let descheduled = + // An arrival may have happened while we're preparing to deschedule + lock syncRoot (fun () -> + if arrivals.Count = 0 then + // OK, no arrival so deschedule + savedCont <- Some(fun res -> ctxt.QueueContinuationWithTrampoline res) + 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") + + let waitOneWithCancellation timeout = + Async.AwaitWaitHandle(ensurePulse(), millisecondsTimeout=timeout) + + let waitOne timeout = + if timeout < 0 && not cancellationSupported then + waitOneNoTimeoutOrCancellation + else + waitOneWithCancellation timeout + + member _.inbox = + 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.ScanArrivalsUnsafe f = + if arrivals.Count = 0 then + None + else + let msg = arrivals.Dequeue() + match f msg with + | None -> + x.inbox.Add msg + x.ScanArrivalsUnsafe f + | res -> res + + // Lock the arrivals queue while we scan that + member x.ScanArrivals f = + lock syncRoot (fun () -> x.ScanArrivalsUnsafe f) + + member x.ScanInbox(f, n) = + match inboxStore with + | null -> None + | inbox -> + if n >= inbox.Count + then None else - let msg = arrivals.Dequeue() + let msg = inbox.[n] match f msg with - | None -> - x.inbox.Add msg - x.ScanArrivalsUnsafe f - | res -> res - - // Lock the arrivals queue while we scan that - member x.ScanArrivals f = - lock syncRoot (fun () -> x.ScanArrivalsUnsafe f) - - member x.ScanInbox(f, n) = - match inboxStore with - | null -> None - | inbox -> - 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 - - member x.ReceiveFromArrivalsUnsafe() = - if arrivals.Count = 0 then + | None -> x.ScanInbox (f, n+1) + | res -> inbox.RemoveAt n; res + + member x.ReceiveFromArrivalsUnsafe() = + if arrivals.Count = 0 then + None + else + Some(arrivals.Dequeue()) + + member x.ReceiveFromArrivals() = + lock syncRoot (fun () -> x.ReceiveFromArrivalsUnsafe()) + + member x.ReceiveFromInbox() = + match inboxStore with + | null -> None + | inbox -> + if inbox.Count = 0 then None else - Some(arrivals.Dequeue()) - - member x.ReceiveFromArrivals() = - lock syncRoot (fun () -> x.ReceiveFromArrivalsUnsafe()) - - member x.ReceiveFromInbox() = - match inboxStore with - | null -> None - | inbox -> - if inbox.Count = 0 then - None - else - let x = inbox.[0] - inbox.RemoveAt 0 - Some x - - member x.Post msg = - lock syncRoot (fun () -> - - // Add the message to the arrivals queue - arrivals.Enqueue msg - - // Cooperatively unblock any waiting reader. If there is no waiting - // reader we just leave the message in the incoming queue - match savedCont with - | None -> - match pulse with - | null -> - () // no one waiting, leaving the message in the queue is sufficient - | ev -> - // someone is waiting on the wait handle - ev.Set() |> ignore - - | Some action -> - savedCont <- None - action true |> ignore) - - 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 false -> - return failwith "should not happen - waitOneNoTimeoutOrCancellation always returns true" - | Choice2Of2 () -> - lock syncRoot (fun () -> - // Cancel the outstanding wait for messages installed by waitOneWithCancellation - // - // HERE BE DRAGONS. This is bestowed on us because we only support - // a single mailbox reader at any one time. - // If awaitEither returned control because timeoutAsync has terminated, waitOneNoTimeoutOrCancellation - // might still be in-flight. In practical terms, it means that the push-to-async-result-cell - // continuation that awaitEither registered on it is still pending, i.e. it is still in savedCont. - // That continuation is a no-op now, but it is still a registered reader for arriving messages. - // Therefore we just abandon it - a brutal way of canceling. - // This ugly non-compositionality is only needed because we only support a single mailbox reader - // (i.e. the user is not allowed to run several Receive/TryReceive/Scan/TryScan in parallel) - otherwise - // we would just have an extra no-op reader in the queue. - savedCont <- None) - - return None - | Some resP -> - timeoutCts.Cancel() // cancel the timeout watcher - 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() - else - return (failwith "Timed out with infinite timeout??") - | Some resP -> - let! res = resP - return Some res - } - - // Look in the inbox first + let x = inbox.[0] + inbox.RemoveAt 0 + Some x + + member x.Post msg = + lock syncRoot (fun () -> + + // Add the message to the arrivals queue + arrivals.Enqueue msg + + // Cooperatively unblock any waiting reader. If there is no waiting + // reader we just leave the message in the incoming queue + match savedCont with + | None -> + match pulse with + | null -> + () // no one waiting, leaving the message in the queue is sufficient + | ev -> + // someone is waiting on the wait handle + ev.Set() |> ignore + + | Some action -> + savedCont <- None + action true |> ignore) + + member x.TryScan ((f: 'Msg -> (Async<'T>) option), timeout) : Async<'T option> = + let rec scan timeoutAsync (timeoutCts:CancellationTokenSource) = async { - match x.ScanInbox(f, 0) with - | None when timeout < 0 -> - return! scanNoTimeout() + match x.ScanArrivals f with | None -> - let! cancellationToken = Async.CancellationToken - let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, CancellationToken.None) - let timeoutAsync = AsyncHelpers.timeout timeout timeoutCts.Token - return! scan timeoutAsync timeoutCts + // 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 false -> + return failwith "should not happen - waitOneNoTimeoutOrCancellation always returns true" + | Choice2Of2 () -> + lock syncRoot (fun () -> + // Cancel the outstanding wait for messages installed by waitOneWithCancellation + // + // HERE BE DRAGONS. This is bestowed on us because we only support + // a single mailbox reader at any one time. + // If awaitEither returned control because timeoutAsync has terminated, waitOneNoTimeoutOrCancellation + // might still be in-flight. In practical terms, it means that the push-to-async-result-cell + // continuation that awaitEither registered on it is still pending, i.e. it is still in savedCont. + // That continuation is a no-op now, but it is still a registered reader for arriving messages. + // Therefore we just abandon it - a brutal way of canceling. + // This ugly non-compositionality is only needed because we only support a single mailbox reader + // (i.e. the user is not allowed to run several Receive/TryReceive/Scan/TryScan in parallel) - otherwise + // we would just have an extra no-op reader in the queue. + savedCont <- None) + + return None | Some resP -> + timeoutCts.Cancel() // cancel the timeout watcher let! res = resP return Some res } - - member x.Scan((f: 'Msg -> (Async<'T>) option), timeout) = + let rec scanNoTimeout () = async { - let! resOpt = x.TryScan(f, timeout) - match resOpt with - | None -> return raise(TimeoutException(SR.GetString(SR.mailboxScanTimedOut))) - | Some res -> return res + match x.ScanArrivals f with + | None -> + let! ok = waitOne Timeout.Infinite + if ok then + return! scanNoTimeout() + else + return (failwith "Timed out with infinite timeout??") + | Some resP -> + let! res = resP + return Some res } - member x.TryReceive timeout = - let rec processFirstArrival() = - async { - match x.ReceiveFromArrivals() with - | None -> - // Make sure the pulse is created if it is going to be needed. - // If it isn't, then create it, and go back to the start to - // check arrivals again. - match pulse with - | null when timeout >= 0 || cancellationSupported -> - 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() - else - return None - | res -> return res - } - - // look in the inbox first + // Look in the inbox first + async { + match x.ScanInbox(f, 0) with + | None when timeout < 0 -> + return! scanNoTimeout() + | None -> + let! cancellationToken = Async.CancellationToken + let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, CancellationToken.None) + let timeoutAsync = AsyncHelpers.timeout timeout timeoutCts.Token + return! scan timeoutAsync timeoutCts + | Some resP -> + let! res = resP + return Some res + } + + 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))) + | Some res -> return res + } + + member x.TryReceive timeout = + let rec processFirstArrival() = async { - match x.ReceiveFromInbox() with - | None -> return! processFirstArrival() + match x.ReceiveFromArrivals() with + | None -> + // Make sure the pulse is created if it is going to be needed. + // If it isn't, then create it, and go back to the start to + // check arrivals again. + match pulse with + | null when timeout >= 0 || cancellationSupported -> + 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() + else + return None | res -> return res } - member x.Receive timeout = - - let rec processFirstArrival() = - async { - match x.ReceiveFromArrivals() with - | None -> - // Make sure the pulse is created if it is going to be needed. - // If it isn't, then create it, and go back to the start to - // check arrivals again. - match pulse with - | null when timeout >= 0 || cancellationSupported -> - 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() - else - return raise(TimeoutException(SR.GetString(SR.mailboxReceiveTimedOut))) - | Some res -> return res - } - - // look in the inbox first + // look in the inbox first + async { + match x.ReceiveFromInbox() with + | None -> return! processFirstArrival() + | res -> return res + } + + member x.Receive timeout = + + let rec processFirstArrival() = async { - match x.ReceiveFromInbox() with - | None -> return! processFirstArrival() + match x.ReceiveFromArrivals() with + | None -> + // Make sure the pulse is created if it is going to be needed. + // If it isn't, then create it, and go back to the start to + // check arrivals again. + match pulse with + | null when timeout >= 0 || cancellationSupported -> + 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() + else + return raise(TimeoutException(SR.GetString(SR.mailboxReceiveTimedOut))) | Some res -> return res } - interface System.IDisposable with - member _.Dispose() = - if isNotNull pulse then (pulse :> IDisposable).Dispose() + // look in the inbox first + async { + match x.ReceiveFromInbox() with + | None -> return! processFirstArrival() + | Some res -> return res + } + + interface System.IDisposable with + member _.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 - [] - [] - type AsyncReplyChannel<'Reply>(replyf : 'Reply -> unit) = - member x.Reply value = replyf value +[] +[] +type AsyncReplyChannel<'Reply>(replyf : 'Reply -> unit) = + member x.Reply value = replyf value - [] - [] - [] - type MailboxProcessor<'Msg>(body, ?cancellationToken) = +[] +[] +[] +type MailboxProcessor<'Msg>(body, ?cancellationToken) = - let cancellationSupported = cancellationToken.IsSome - let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let mailbox = new Mailbox<'Msg>(cancellationSupported) - let mutable defaultTimeout = Threading.Timeout.Infinite - let mutable started = false - let errorEvent = new Event() + let cancellationSupported = cancellationToken.IsSome + let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + let mailbox = new Mailbox<'Msg>(cancellationSupported) + let mutable defaultTimeout = Threading.Timeout.Infinite + let mutable started = false + let errorEvent = new Event() - member _.CurrentQueueLength = mailbox.CurrentQueueLength // nb. unprotected access gives an approximation of the queue length + member _.CurrentQueueLength = mailbox.CurrentQueueLength // nb. unprotected access gives an approximation of the queue length - member _.DefaultTimeout - with get() = defaultTimeout - and set v = defaultTimeout <- v + member _.DefaultTimeout + with get() = defaultTimeout + and set v = defaultTimeout <- v - [] - member _.Error = errorEvent.Publish + [] + member _.Error = errorEvent.Publish #if DEBUG - member _.UnsafeMessageQueueContents = mailbox.UnsafeContents + member _.UnsafeMessageQueueContents = mailbox.UnsafeContents #endif - member x.Start() = - if started then - raise (new InvalidOperationException(SR.GetString(SR.mailboxProcessorAlreadyStarted))) - else - started <- true - - // Protect the execution and send errors to the event. - // 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.Start(computation=p, cancellationToken=cancellationToken) - - member _.Post message = mailbox.Post message - - 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)) + member x.Start() = + if started then + raise (new InvalidOperationException(SR.GetString(SR.mailboxProcessorAlreadyStarted))) + else + started <- true + + // Protect the execution and send errors to the event. + // 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.Start(computation=p, cancellationToken=cancellationToken) + + member _.Post message = mailbox.Post message + + 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)) + mailbox.Post msg + resultCell.TryWaitForResultSynchronously(timeout=timeout) + + member x.PostAndReply(buildMessage, ?timeout) : 'Reply = + 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)) + mailbox.Post msg + match timeout with + | Threading.Timeout.Infinite when not cancellationSupported -> + 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 } + + 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)) mailbox.Post msg - resultCell.TryWaitForResultSynchronously(timeout=timeout) + 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 } - member x.PostAndReply(buildMessage, ?timeout) : 'Reply = - match x.TryPostAndReply(buildMessage, ?timeout=timeout) with - | None -> raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndReplyTimedOut))) - | Some res -> res + member _.Receive(?timeout) = + mailbox.Receive(timeout=defaultArg timeout defaultTimeout) - 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)) - mailbox.Post msg - match timeout with - | Threading.Timeout.Infinite when not cancellationSupported -> - 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 } - - 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)) - 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 } - - member _.Receive(?timeout) = - mailbox.Receive(timeout=defaultArg timeout defaultTimeout) - - member _.TryReceive(?timeout) = - mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout) - - member _.Scan(scanner: 'Msg -> (Async<'T>) option, ?timeout) = - mailbox.Scan(scanner, timeout=defaultArg timeout defaultTimeout) - - member _.TryScan(scanner: 'Msg -> (Async<'T>) option, ?timeout) = - mailbox.TryScan(scanner, timeout=defaultArg timeout defaultTimeout) - - interface System.IDisposable with - member _.Dispose() = (mailbox :> IDisposable).Dispose() - - static member Start(body, ?cancellationToken) = - let mailboxProcessor = new MailboxProcessor<'Msg>(body, ?cancellationToken=cancellationToken) - mailboxProcessor.Start() - mailboxProcessor + member _.TryReceive(?timeout) = + mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout) + + member _.Scan(scanner: 'Msg -> (Async<'T>) option, ?timeout) = + mailbox.Scan(scanner, timeout=defaultArg timeout defaultTimeout) + + member _.TryScan(scanner: 'Msg -> (Async<'T>) option, ?timeout) = + mailbox.TryScan(scanner, timeout=defaultArg timeout defaultTimeout) + + interface System.IDisposable with + member _.Dispose() = (mailbox :> IDisposable).Dispose() + + static member Start(body, ?cancellationToken) = + let mailboxProcessor = new MailboxProcessor<'Msg>(body, ?cancellationToken=cancellationToken) + mailboxProcessor.Start() + mailboxProcessor diff --git a/src/FSharp.Core/map.fs b/src/FSharp.Core/map.fs index 8a4c0b64fb0..7a72f29b1d8 100644 --- a/src/FSharp.Core/map.fs +++ b/src/FSharp.Core/map.fs @@ -561,7 +561,6 @@ module MapTree = [>)>] [] [] -[] [] type Map<[]'Key, []'Value when 'Key : comparison >(comparer: IComparer<'Key>, tree: MapTree<'Key, 'Value>) = diff --git a/src/FSharp.Core/map.fsi b/src/FSharp.Core/map.fsi index d21c0bc2e9b..d500c9a0ebe 100644 --- a/src/FSharp.Core/map.fsi +++ b/src/FSharp.Core/map.fsi @@ -293,7 +293,7 @@ module Map = /// /// [] - val ofArray: elements: ('Key * 'T) [] -> Map<'Key, 'T> + val ofArray: elements: ('Key * 'T)[] -> Map<'Key, 'T> /// Returns a new map made from the given bindings. /// @@ -360,7 +360,7 @@ module Map = /// /// [] - val toArray: table: Map<'Key, 'T> -> ('Key * 'T) [] + val toArray: table: Map<'Key, 'T> -> ('Key * 'T)[] /// Is the map empty? /// diff --git a/src/FSharp.Core/math/z.fs b/src/FSharp.Core/math/z.fs index fa65994315f..b79ad3671fd 100644 --- a/src/FSharp.Core/math/z.fs +++ b/src/FSharp.Core/math/z.fs @@ -14,72 +14,72 @@ namespace Microsoft.FSharp.Math namespace Microsoft.FSharp.Core - type bigint = System.Numerics.BigInteger +type bigint = System.Numerics.BigInteger - open System - open System.Diagnostics.CodeAnalysis - open System.Globalization - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open System.Numerics +open System +open System.Diagnostics.CodeAnalysis +open System.Globalization +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open System.Numerics - [] - module NumericLiterals = +[] +module NumericLiterals = - module NumericLiteralI = + module NumericLiteralI = - let tab64 = new System.Collections.Generic.Dictionary() - let tabParse = new System.Collections.Generic.Dictionary() - - 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() + let tabParse = new System.Collections.Generic.Dictionary() + + let FromInt64Dynamic (value:int64) : obj = + lock tab64 (fun () -> + let mutable res = Unchecked.defaultof<_> + let ok = tab64.TryGetValue(value,&res) + if ok then res else + res <- BigInteger(value) + tab64.[value] <- res + res) - let inline get32 (x32:int32) = FromInt64Dynamic (int64 x32) + let inline get32 (x32:int32) = FromInt64Dynamic (int64 x32) - let inline isOX s = not (System.String.IsNullOrEmpty(s)) && s.Length > 2 && s.[0] = '0' && s.[1] = 'x' - - let FromZero () : 'T = - (get32 0 :?> 'T) - when 'T : BigInteger = BigInteger.Zero + let inline isOX s = not (System.String.IsNullOrEmpty(s)) && s.Length > 2 && s.[0] = '0' && s.[1] = 'x' + + let FromZero () : 'T = + (get32 0 :?> 'T) + when 'T : BigInteger = BigInteger.Zero - let FromOne () : 'T = - (get32 1 :?> 'T) - when 'T : BigInteger = BigInteger.One + let 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 FromInt32 (value:int32): 'T = + (get32 value :?> 'T) + when 'T : BigInteger = new BigInteger(value) + + let FromInt64 (value:int64): 'T = + (FromInt64Dynamic value :?> 'T) + when 'T : BigInteger = new BigInteger(value) - let FromInt64 (value:int64): 'T = - (FromInt64Dynamic value :?> 'T) - when 'T : BigInteger = new BigInteger(value) - - let getParse s = - lock tabParse (fun () -> - let mutable res = Unchecked.defaultof<_> - let ok = tabParse.TryGetValue(s,&res) - 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 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 FromStringDynamic (text:string) : obj = + getParse text + + let FromString (text:string) : 'T = + (FromStringDynamic text :?> 'T) + when 'T : BigInteger = getParse text diff --git a/src/FSharp.Core/observable.fs b/src/FSharp.Core/observable.fs index 75ef1d081b1..4e5af5232c7 100644 --- a/src/FSharp.Core/observable.fs +++ b/src/FSharp.Core/observable.fs @@ -2,176 +2,176 @@ namespace Microsoft.FSharp.Control - open System - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Control - - [] - [] - module Observable = - - let inline protect f succeed fail = - match (try Choice1Of2 (f ()) with e -> Choice2Of2 e) with - | Choice1Of2 x -> (succeed x) - | Choice2Of2 e -> (fail e) - - [] - type BasicObserver<'T>() = - - let mutable stopped = false - - abstract Next : value : 'T -> unit - - abstract Error : error : exn -> unit - - abstract Completed : unit -> unit - - interface IObserver<'T> with - - member x.OnNext value = - if not stopped then - x.Next value - - member x.OnError e = - if not stopped then - stopped <- true - x.Error e - - member x.OnCompleted () = - if not stopped then - stopped <- true - x.Completed () - - [] - 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() } } - - [] - let choose chooser (source: IObservable<'T>) = - { 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.Error(e) = observer.OnError(e) - - member x.Completed() = observer.OnCompleted() } } - - [] - let filter predicate (source: IObservable<'T>) = - choose (fun x -> if predicate x then Some x else None) source - - [] - let partition predicate (source: IObservable<'T>) = - filter predicate source, filter (predicate >> not) source - - [] - 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 - - 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() } } - - [] - let add callback (source: IObservable<'T>) = source.Add(callback) - - [] - let subscribe (callback: 'T -> unit) (source: IObservable<'T>) = source.Subscribe(callback) - - [] - let pairwise (source : IObservable<'T>) : IObservable<'T * 'T> = - { new IObservable<_> with - member x.Subscribe(observer) = - let mutable lastArgs = None - source.Subscribe - { new BasicObserver<'T>() with - - member x.Next(args2) = - match lastArgs with - | None -> () - | Some args1 -> observer.OnNext (args1,args2) - lastArgs <- Some args2 - - member x.Error(e) = observer.OnError(e) - - member x.Completed() = observer.OnCompleted() } } - - [] - 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 - - member x.OnError(e) = - if not stopped then +open System +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Control + +[] +[] +module Observable = + + let inline protect f succeed fail = + match (try Choice1Of2 (f ()) with e -> Choice2Of2 e) with + | Choice1Of2 x -> (succeed x) + | Choice2Of2 e -> (fail e) + + [] + type BasicObserver<'T>() = + + let mutable stopped = false + + abstract Next : value : 'T -> unit + + abstract Error : error : exn -> unit + + abstract Completed : unit -> unit + + interface IObserver<'T> with + + member x.OnNext value = + if not stopped then + x.Next value + + member x.OnError e = + if not stopped then + stopped <- true + x.Error e + + member x.OnCompleted () = + if not stopped then + stopped <- true + x.Completed () + + [] + 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() } } + + [] + let choose chooser (source: IObservable<'T>) = + { 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.Error(e) = observer.OnError(e) + + member x.Completed() = observer.OnCompleted() } } + + [] + let filter predicate (source: IObservable<'T>) = + choose (fun x -> if predicate x then Some x else None) source + + [] + let partition predicate (source: IObservable<'T>) = + filter predicate source, filter (predicate >> not) source + + [] + 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 + + 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() } } + + [] + let add callback (source: IObservable<'T>) = source.Add(callback) + + [] + let subscribe (callback: 'T -> unit) (source: IObservable<'T>) = source.Subscribe(callback) + + [] + let pairwise (source : IObservable<'T>) : IObservable<'T * 'T> = + { new IObservable<_> with + member x.Subscribe(observer) = + let mutable lastArgs = None + source.Subscribe + { new BasicObserver<'T>() with + + member x.Next(args2) = + match lastArgs with + | None -> () + | Some args1 -> observer.OnNext (args1,args2) + lastArgs <- Some args2 + + member x.Error(e) = observer.OnError(e) + + member x.Completed() = observer.OnCompleted() } } + + [] + 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 + + member x.OnError(e) = + if not stopped then + stopped <- true + observer.OnError(e) + + member x.OnCompleted() = + if not stopped then + completed1 <- true + if completed1 && completed2 then stopped <- true - observer.OnError(e) - - 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 + 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.OnCompleted() = + if not stopped then + completed2 <- true + if completed1 && completed2 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() } } - - [] - 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 + observer.OnCompleted() } + + { new IDisposable with + member x.Dispose() = + h1.Dispose() + h2.Dispose() } } + + [] + 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 diff --git a/src/FSharp.Core/option.fsi b/src/FSharp.Core/option.fsi index 000c1b28827..57d9807e11c 100644 --- a/src/FSharp.Core/option.fsi +++ b/src/FSharp.Core/option.fsi @@ -6,7 +6,6 @@ open System open Microsoft.FSharp.Core open Microsoft.FSharp.Collections - /// Contains operations for working with options. /// /// Options @@ -381,7 +380,7 @@ module Option = /// /// [] - val toArray: option: 'T option -> 'T [] + val toArray: option: 'T option -> 'T[] /// Convert the option to a list of length 0 or 1. /// @@ -829,7 +828,7 @@ module ValueOption = /// /// [] - val toArray: voption: 'T voption -> 'T [] + val toArray: voption: 'T voption -> 'T[] /// Convert the value option to a list of length 0 or 1. /// diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index baa7fd5cb0b..907d34488ac 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -555,7 +555,6 @@ namespace Microsoft.FSharp.Core [] let InputMustBeNonNegativeString = SR.GetString(SR.inputMustBeNonNegative) - [] // nested module OK module IntrinsicOperators = //------------------------------------------------------------------------- // Lazy and/or. Laziness added by the F# compiler. @@ -584,7 +583,7 @@ namespace Microsoft.FSharp.Core (# "throw" (e :> System.Exception) : nativeptr<'T> #) open IntrinsicOperators - [] // nested module OK + module IntrinsicFunctions = // Unboxing, type casts, type tests @@ -2081,7 +2080,6 @@ namespace Microsoft.FSharp.Core let Float32IEquality = MakeGenericEqualityComparer() let DecimalIEquality = MakeGenericEqualityComparer() - [] type FastGenericEqualityComparerTable<'T>() = static let f : IEqualityComparer<'T> = match typeof<'T> with @@ -2162,7 +2160,6 @@ namespace Microsoft.FSharp.Core /// Use a type-indexed table to ensure we only create a single FastStructuralComparison function /// for each type - [] type FastGenericComparerTable<'T>() = // The CLI implementation of mscorlib optimizes array sorting @@ -2435,7 +2432,6 @@ namespace Microsoft.FSharp.Core let inline ParseSingle (s:string) = Single.Parse(removeUnderscores s,NumberStyles.Float, CultureInfo.InvariantCulture) - [] type GenericZeroDynamicImplTable<'T>() = static let result : 'T = // The dynamic implementation @@ -2459,7 +2455,6 @@ namespace Microsoft.FSharp.Core unboxPrim<'T> (pinfo.GetValue(null,null)) static member Result : 'T = result - [] type GenericOneDynamicImplTable<'T>() = static let result : 'T = // The dynamic implementation @@ -3417,19 +3412,15 @@ namespace Microsoft.FSharp.Core // Note: this is not made public in the signature, because of conflicts with the Converter overload. // The method remains in case someone is calling it via reflection. - [] - static member op_Implicit(converter : Func<_,_>) : ('T -> 'Res) = (fun t -> converter.Invoke(t)) + static member op_Implicit(converter: Func<_,_>) : ('T -> 'Res) = (fun t -> converter.Invoke(t)) // Note: this is not made public in the signature, because of conflicts with the Converter overload. // The method remains in case someone is calling it via reflection. - [] - static member op_Implicit(func : ('T -> 'Res) ) = new Func<'T,'Res>(func) + static member op_Implicit(func: ('T -> 'Res) ) = new Func<'T,'Res>(func) - [] - static member op_Implicit(f : Converter<_,_>) : ('T -> 'Res) = (fun t -> f.Invoke(t)) + static member op_Implicit(f: Converter<_,_>) : ('T -> 'Res) = (fun t -> f.Invoke(t)) - [] - static member op_Implicit (func : ('T -> 'Res) ) = new Converter<'T,'Res>(func) + static member op_Implicit (func: ('T -> 'Res) ) = new Converter<'T,'Res>(func) static member FromConverter (converter: Converter<_,_>) : ('T -> 'Res) = (fun t -> converter.Invoke(t)) @@ -3511,7 +3502,6 @@ namespace Microsoft.FSharp.Core [] [] [] - [] [] [] type Option<'T> = @@ -3607,7 +3597,6 @@ namespace Microsoft.FSharp.Collections [] [>)>] [] - [] [] [] type List<'T> = @@ -3845,7 +3834,6 @@ namespace Microsoft.FSharp.Core open Microsoft.FSharp.Core.BasicInlinedOperations open Microsoft.FSharp.Collections - [] module Operators = [] @@ -3909,17 +3897,14 @@ namespace Microsoft.FSharp.Core let inline failwith message = raise (Failure(message)) [] - [] let inline invalidArg (argumentName:string) (message:string) = raise (new ArgumentException(message,argumentName)) [] - [] let inline nullArg (argumentName:string) = raise (new ArgumentNullException(argumentName)) [] - [] let inline invalidOp message = raise (InvalidOperationException(message)) [] @@ -3931,18 +3916,15 @@ namespace Microsoft.FSharp.Core let inline reraise() = unbox(# "rethrow ldnull" : Object #) [] - [] let inline fst (a, _) = a [] - [] let inline snd (_, b) = b [] let inline ignore _ = () [] - [] let ref value = { contents = value } let (:=) cell value = cell.contents <- value @@ -4869,7 +4851,6 @@ namespace Microsoft.FSharp.Core [] let inline hash (obj: 'T) = LanguagePrimitives.GenericHash obj - [] let inline limitedHash (limit:int) (obj: 'T) = LanguagePrimitives.GenericLimitedHash limit obj @@ -5558,46 +5539,32 @@ namespace Microsoft.FSharp.Core loop n - [] let PowByte (x:byte) n = ComputePowerGenericInlined 1uy Checked.( * ) x n - [] let PowSByte (x:sbyte) n = ComputePowerGenericInlined 1y Checked.( * ) x n - [] let PowInt16 (x:int16) n = ComputePowerGenericInlined 1s Checked.( * ) x n - [] let PowUInt16 (x:uint16) n = ComputePowerGenericInlined 1us Checked.( * ) x n - [] let PowInt32 (x:int32) n = ComputePowerGenericInlined 1 Checked.( * ) x n - [] let PowUInt32 (x:uint32) n = ComputePowerGenericInlined 1u Checked.( * ) x n - [] let PowInt64 (x:int64) n = ComputePowerGenericInlined 1L Checked.( * ) x n - [] let PowUInt64 (x:uint64) n = ComputePowerGenericInlined 1UL Checked.( * ) x n - [] let PowIntPtr (x:nativeint) n = ComputePowerGenericInlined 1n Checked.( * ) x n - [] let PowUIntPtr (x:unativeint) n = ComputePowerGenericInlined 1un Checked.( * ) x n - [] let PowSingle (x:float32) n = ComputePowerGenericInlined 1.0f Checked.( * ) x n - [] let PowDouble (x:float) n = ComputePowerGenericInlined 1.0 Checked.( * ) x n - [] let PowDecimal (x:decimal) n = ComputePowerGenericInlined 1.0M Checked.( * ) x n - [] let PowGeneric (one, mul, value: 'T, exponent) = ComputePowerGenericInlined one mul value exponent let inline ComputeSlice bound start finish length = @@ -6188,7 +6155,6 @@ namespace Microsoft.FSharp.Core when ^T : float = Math.Pow((retype x : float), (retype y: float)) when ^T : float32 = Math.Pow(toFloat (retype x), toFloat(retype y)) |> toFloat32 - [] type AbsDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6203,7 +6169,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Abs" static member Result : ('T -> 'T) = result - [] type AcosDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6212,7 +6177,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Acos" static member Result : ('T -> 'T) = result - [] type AsinDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6221,7 +6185,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Asin" static member Result : ('T -> 'T) = result - [] type AtanDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6230,7 +6193,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Atan" static member Result : ('T -> 'T) = result - [] type Atan2DynamicImplTable<'T,'U>() = static let result : ('T -> 'T -> 'U) = let aty = typeof<'T> @@ -6239,7 +6201,6 @@ namespace Microsoft.FSharp.Core else BinaryDynamicImpl "Atan2" static member Result : ('T -> 'T -> 'U) = result - [] type CeilingDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6248,7 +6209,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Ceiling" static member Result : ('T -> 'T) = result - [] type ExpDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6257,7 +6217,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Exp" static member Result : ('T -> 'T) = result - [] type FloorDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6266,7 +6225,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Floor" static member Result : ('T -> 'T) = result - [] type TruncateDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6275,7 +6233,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Truncate" static member Result : ('T -> 'T) = result - [] type RoundDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6284,7 +6241,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Round" static member Result : ('T -> 'T) = result - [] type SignDynamicImplTable<'T>() = static let result : ('T -> int) = let aty = typeof<'T> @@ -6299,7 +6255,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Sign" static member Result : ('T -> int) = result - [] type LogDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6308,7 +6263,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Log" static member Result : ('T -> 'T) = result - [] type Log10DynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6317,7 +6271,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Log10" static member Result : ('T -> 'T) = result - [] type SqrtDynamicImplTable<'T,'U>() = static let result : ('T -> 'U) = let aty = typeof<'T> @@ -6326,7 +6279,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Sqrt" static member Result : ('T -> 'U) = result - [] type CosDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6335,7 +6287,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Cos" static member Result : ('T -> 'T) = result - [] type CoshDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6344,7 +6295,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Cosh" static member Result : ('T -> 'T) = result - [] type SinDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6353,7 +6303,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Sin" static member Result : ('T -> 'T) = result - [] type SinhDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6362,7 +6311,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Sinh" static member Result : ('T -> 'T) = result - [] type TanDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6371,7 +6319,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Tan" static member Result : ('T -> 'T) = result - [] type TanhDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> @@ -6380,7 +6327,6 @@ namespace Microsoft.FSharp.Core else UnaryDynamicImpl "Tanh" static member Result : ('T -> 'T) = result - [] type PowDynamicImplTable<'T,'U>() = static let result : ('T -> 'U -> 'T) = let aty = typeof<'T> @@ -6389,27 +6335,47 @@ namespace Microsoft.FSharp.Core else BinaryDynamicImpl "Pow" static member Result : ('T -> 'U -> 'T) = result - let AbsDynamic x = AbsDynamicImplTable<_>.Result x - let AcosDynamic x = AcosDynamicImplTable<_>.Result x - let AsinDynamic x = AsinDynamicImplTable<_>.Result x - let AtanDynamic x = AtanDynamicImplTable<_>.Result x - let Atan2Dynamic y x = Atan2DynamicImplTable<_,_>.Result y x - let CeilingDynamic x = CeilingDynamicImplTable<_>.Result x - let ExpDynamic x = ExpDynamicImplTable<_>.Result x - let FloorDynamic x = FloorDynamicImplTable<_>.Result x - let TruncateDynamic x = TruncateDynamicImplTable<_>.Result x - let RoundDynamic x = RoundDynamicImplTable<_>.Result x - let SignDynamic x = SignDynamicImplTable<_>.Result x - let LogDynamic x = LogDynamicImplTable<_>.Result x - let Log10Dynamic x = Log10DynamicImplTable<_>.Result x - let SqrtDynamic x = SqrtDynamicImplTable<_,_>.Result x - let CosDynamic x = CosDynamicImplTable<_>.Result x - let CoshDynamic x = CoshDynamicImplTable<_>.Result x - let SinDynamic x = SinDynamicImplTable<_>.Result x - let SinhDynamic x = SinhDynamicImplTable<_>.Result x - let TanDynamic x = TanDynamicImplTable<_>.Result x - let TanhDynamic x = TanhDynamicImplTable<_>.Result x - let PowDynamic x y = PowDynamicImplTable<_,_>.Result x y + let AbsDynamic x = AbsDynamicImplTable<_>.Result x + + let AcosDynamic x = AcosDynamicImplTable<_>.Result x + + let AsinDynamic x = AsinDynamicImplTable<_>.Result x + + let AtanDynamic x = AtanDynamicImplTable<_>.Result x + + let Atan2Dynamic y x = Atan2DynamicImplTable<_,_>.Result y x + + let CeilingDynamic x = CeilingDynamicImplTable<_>.Result x + + let ExpDynamic x = ExpDynamicImplTable<_>.Result x + + let FloorDynamic x = FloorDynamicImplTable<_>.Result x + + let TruncateDynamic x = TruncateDynamicImplTable<_>.Result x + + let RoundDynamic x = RoundDynamicImplTable<_>.Result x + + let SignDynamic x = SignDynamicImplTable<_>.Result x + + let LogDynamic x = LogDynamicImplTable<_>.Result x + + let Log10Dynamic x = Log10DynamicImplTable<_>.Result x + + let SqrtDynamic x = SqrtDynamicImplTable<_,_>.Result x + + let CosDynamic x = CosDynamicImplTable<_>.Result x + + let CoshDynamic x = CoshDynamicImplTable<_>.Result x + + let SinDynamic x = SinDynamicImplTable<_>.Result x + + let SinhDynamic x = SinhDynamicImplTable<_>.Result x + + let TanDynamic x = TanDynamicImplTable<_>.Result x + + let TanhDynamic x = TanhDynamicImplTable<_>.Result x + + let PowDynamic x y = PowDynamicImplTable<_,_>.Result x y open OperatorIntrinsics diff --git a/src/FSharp.Core/printf.fsi b/src/FSharp.Core/printf.fsi index f992c932731..0171baecad6 100644 --- a/src/FSharp.Core/printf.fsi +++ b/src/FSharp.Core/printf.fsi @@ -30,14 +30,14 @@ type PrintfFormat<'Printer, 'State, 'Residue, 'Result> = /// The captured expressions in an interpolated string. /// The types of expressions for %A holes in interpolated string. /// The PrintfFormat containing the formatted result. - new: value: string * captures: obj [] * captureTys: Type [] -> PrintfFormat<'Printer, 'State, 'Residue, 'Result> + new: value: string * captures: obj[] * captureTys: Type[] -> PrintfFormat<'Printer, 'State, 'Residue, 'Result> /// The raw text of the format string. member Value: string - member Captures: obj [] + member Captures: obj[] - member CaptureTypes: System.Type [] + member CaptureTypes: System.Type[] /// Type of a formatting expression. /// @@ -67,7 +67,7 @@ type PrintfFormat<'Printer, 'State, 'Residue, 'Result, 'Tuple> = /// /// The created format string. new: - value: string * captures: obj [] * captureTys: Type [] -> + value: string * captures: obj[] * captureTys: Type[] -> PrintfFormat<'Printer, 'State, 'Residue, 'Result, 'Tuple> /// Type of a formatting expression. diff --git a/src/FSharp.Core/quotations.fs b/src/FSharp.Core/quotations.fs index ed8829414d6..3ef11b97bd3 100644 --- a/src/FSharp.Core/quotations.fs +++ b/src/FSharp.Core/quotations.fs @@ -78,7 +78,6 @@ open Helpers [] [] -[] type Var(name: string, typ: Type, ?isMutable: bool) = inherit obj() @@ -91,10 +90,13 @@ type Var(name: string, typ: Type, ?isMutable: bool) = let stamp = getStamp () let isMutable = defaultArg isMutable false - member v.Name = name - member v.IsMutable = isMutable - member v.Type = typ - member v.Stamp = stamp + member _.Name = name + + member _.IsMutable = isMutable + + member _.Type = typ + + member _.Stamp = stamp static member Global(name, typ: Type) = checkNonNull "name" name @@ -107,9 +109,9 @@ type Var(name: string, typ: Type, ?isMutable: bool) = globals.[(name, typ)] <- res res) - override v.ToString() = name + override _.ToString() = name - override v.GetHashCode() = base.GetHashCode() + override _.GetHashCode() = base.GetHashCode() override v.Equals(obj:obj) = match obj with diff --git a/src/FSharp.Core/quotations.fsi b/src/FSharp.Core/quotations.fsi index 42946640323..5ec624e1438 100644 --- a/src/FSharp.Core/quotations.fsi +++ b/src/FSharp.Core/quotations.fsi @@ -1253,7 +1253,7 @@ type Expr = /// /// The resulting expression. static member Deserialize: - qualifyingType: Type * spliceTypes: Type list * spliceExprs: Expr list * bytes: byte [] -> Expr + qualifyingType: Type * spliceTypes: Type list * spliceExprs: Expr list * bytes: byte[] -> Expr /// This function is called automatically when quotation syntax (<@ @>) and other sources of /// quotations are used. @@ -1266,7 +1266,7 @@ type Expr = /// /// The resulting expression. static member Deserialize40: - qualifyingType: Type * referencedTypes: Type [] * spliceTypes: Type [] * spliceExprs: Expr [] * bytes: byte [] -> + qualifyingType: Type * referencedTypes: Type[] * spliceTypes: Type[] * spliceExprs: Expr[] * bytes: byte[] -> Expr /// Permits interactive environments such as F# Interactive @@ -1277,7 +1277,7 @@ type Expr = /// The unique name for the resources being added. /// The serialized resource to register with the environment. /// - static member RegisterReflectedDefinitions: assembly: Assembly * resource: string * serializedValue: byte [] -> unit + static member RegisterReflectedDefinitions: assembly: Assembly * resource: string * serializedValue: byte[] -> unit /// Permits interactive environments such as F# Interactive /// to explicitly register new pickled resources that represent persisted @@ -1289,7 +1289,7 @@ type Expr = /// The serialized resource to register with the environment. /// static member RegisterReflectedDefinitions: - assembly: Assembly * resource: string * serializedValue: byte [] * referencedTypes: Type [] -> unit + assembly: Assembly * resource: string * serializedValue: byte[] * referencedTypes: Type[] -> unit /// Fetches or creates a new variable with the given name and type from a global pool of shared variables /// indexed by name and type. The type is given by the explicit or inferred type parameter diff --git a/src/FSharp.Core/reflect.fsi b/src/FSharp.Core/reflect.fsi index 6a2c21dd916..881c95331c9 100644 --- a/src/FSharp.Core/reflect.fsi +++ b/src/FSharp.Core/reflect.fsi @@ -81,7 +81,7 @@ type UnionCaseInfo = /// VariantNumber = 0;}|]|] /// /// - member GetCustomAttributes: unit -> obj [] + member GetCustomAttributes: unit -> obj[] /// Returns the custom attributes associated with the case matching the given attribute type. /// The type of attributes to return. @@ -110,7 +110,7 @@ type UnionCaseInfo = /// TypeId = FSI_0147+Signal;}|]|] /// /// - member GetCustomAttributes: attributeType: System.Type -> obj [] + member GetCustomAttributes: attributeType: System.Type -> obj[] /// Returns the custom attributes data associated with the case. /// An list of custom attribute data items. @@ -175,7 +175,7 @@ type UnionCaseInfo = /// [|("width", "Double"); ("Item2", "Double"); ("height", "Double")|]|] /// /// - member GetFields: unit -> PropertyInfo [] + member GetFields: unit -> PropertyInfo[] /// The integer tag for the case. /// @@ -240,7 +240,7 @@ type FSharpValue = /// The created record. /// /// - static member MakeRecord: recordType: Type * values: obj [] * ?bindingFlags: BindingFlags -> obj + static member MakeRecord: recordType: Type * values: obj[] * ?bindingFlags: BindingFlags -> obj /// Reads all the fields from a record value. /// @@ -253,7 +253,7 @@ type FSharpValue = /// The array of fields from the record. /// /// - static member GetRecordFields: record: obj * ?bindingFlags: BindingFlags -> obj [] + static member GetRecordFields: record: obj * ?bindingFlags: BindingFlags -> obj[] /// Precompute a function for reading all the fields from a record. The fields are returned in the /// same order as the fields reported by a call to Microsoft.FSharp.Reflection.Type.GetInfo for @@ -274,7 +274,7 @@ type FSharpValue = /// An optimized reader for the given record type. /// /// - static member PreComputeRecordReader: recordType: Type * ?bindingFlags: BindingFlags -> (obj -> obj []) + static member PreComputeRecordReader: recordType: Type * ?bindingFlags: BindingFlags -> (obj -> obj[]) /// Precompute a function for constructing a record value. /// @@ -289,7 +289,7 @@ type FSharpValue = /// A function to construct records of the given type. /// /// - static member PreComputeRecordConstructor: recordType: Type * ?bindingFlags: BindingFlags -> (obj [] -> obj) + static member PreComputeRecordConstructor: recordType: Type * ?bindingFlags: BindingFlags -> (obj[] -> obj) /// Get a ConstructorInfo for a record type /// @@ -310,7 +310,7 @@ type FSharpValue = /// The constructed union case. /// /// - static member MakeUnion: unionCase: UnionCaseInfo * args: obj [] * ?bindingFlags: BindingFlags -> obj + static member MakeUnion: unionCase: UnionCaseInfo * args: obj[] * ?bindingFlags: BindingFlags -> obj /// Identify the union case and its fields for an object /// @@ -328,7 +328,7 @@ type FSharpValue = /// The description of the union case and its fields. /// /// - static member GetUnionFields: value: obj * unionType: Type * ?bindingFlags: BindingFlags -> UnionCaseInfo * obj [] + static member GetUnionFields: value: obj * unionType: Type * ?bindingFlags: BindingFlags -> UnionCaseInfo * obj[] /// Assumes the given type is a union type. /// If not, is raised during pre-computation. @@ -365,7 +365,7 @@ type FSharpValue = /// A function to for reading the fields of the given union case. /// /// - static member PreComputeUnionReader: unionCase: UnionCaseInfo * ?bindingFlags: BindingFlags -> (obj -> obj []) + static member PreComputeUnionReader: unionCase: UnionCaseInfo * ?bindingFlags: BindingFlags -> (obj -> obj[]) /// Precompute a function for constructing a discriminated union value for a particular union case. /// @@ -375,7 +375,7 @@ type FSharpValue = /// A function for constructing values of the given union case. /// /// - static member PreComputeUnionConstructor: unionCase: UnionCaseInfo * ?bindingFlags: BindingFlags -> (obj [] -> obj) + static member PreComputeUnionConstructor: unionCase: UnionCaseInfo * ?bindingFlags: BindingFlags -> (obj[] -> obj) /// A method that constructs objects of the given case /// @@ -399,7 +399,7 @@ type FSharpValue = /// The fields from the given exception. /// /// - static member GetExceptionFields: exn: obj * ?bindingFlags: BindingFlags -> obj [] + static member GetExceptionFields: exn: obj * ?bindingFlags: BindingFlags -> obj[] /// Creates an instance of a tuple type /// @@ -413,7 +413,7 @@ type FSharpValue = /// An instance of the tuple type with the given elements. /// /// - static member MakeTuple: tupleElements: obj [] * tupleType: Type -> obj + static member MakeTuple: tupleElements: obj[] * tupleType: Type -> obj /// Reads a field from a tuple value. /// @@ -438,7 +438,7 @@ type FSharpValue = /// An array of the fields from the given tuple. /// /// - static member GetTupleFields: tuple: obj -> obj [] + static member GetTupleFields: tuple: obj -> obj[] /// Precompute a function for reading the values of a particular tuple type /// @@ -452,7 +452,7 @@ type FSharpValue = /// A function to read values of the given tuple type. /// /// - static member PreComputeTupleReader: tupleType: Type -> (obj -> obj []) + static member PreComputeTupleReader: tupleType: Type -> (obj -> obj[]) /// Gets information that indicates how to read a field of a tuple /// @@ -476,7 +476,7 @@ type FSharpValue = /// A function to read a particular tuple type. /// /// - static member PreComputeTupleConstructor: tupleType: Type -> (obj [] -> obj) + static member PreComputeTupleConstructor: tupleType: Type -> (obj[] -> obj) /// Gets a method that constructs objects of the given tuple type. /// For small tuples, no additional type will be returned. @@ -520,7 +520,7 @@ type FSharpType = /// An array of descriptions of the properties of the record type. /// /// - static member GetRecordFields: recordType: Type * ?bindingFlags: BindingFlags -> PropertyInfo [] + static member GetRecordFields: recordType: Type * ?bindingFlags: BindingFlags -> PropertyInfo[] /// Gets the cases of a union type. /// @@ -534,7 +534,7 @@ type FSharpType = /// An array of descriptions of the cases of the given union type. /// /// - static member GetUnionCases: unionType: Type * ?bindingFlags: BindingFlags -> UnionCaseInfo [] + static member GetUnionCases: unionType: Type * ?bindingFlags: BindingFlags -> UnionCaseInfo[] /// Return true if the typ is a representation of an F# record type /// @@ -568,7 +568,7 @@ type FSharpType = /// An array containing the PropertyInfo of each field in the exception. /// /// - static member GetExceptionFields: exceptionType: Type * ?bindingFlags: BindingFlags -> PropertyInfo [] + static member GetExceptionFields: exceptionType: Type * ?bindingFlags: BindingFlags -> PropertyInfo[] /// Returns true if the typ is a representation of an F# exception declaration /// @@ -597,7 +597,7 @@ type FSharpType = /// The type representing the tuple containing the input elements. /// /// - static member MakeTupleType: types: Type [] -> Type + static member MakeTupleType: types: Type[] -> Type /// Returns a representing an F# tuple type with the given element types /// @@ -607,7 +607,7 @@ type FSharpType = /// The type representing the tuple containing the input elements. /// /// - static member MakeTupleType: asm: Assembly * types: Type [] -> Type + static member MakeTupleType: asm: Assembly * types: Type[] -> Type /// Returns a representing an F# struct tuple type with the given element types /// @@ -617,7 +617,7 @@ type FSharpType = /// The type representing the struct tuple containing the input elements. /// /// - static member MakeStructTupleType: asm: Assembly * types: Type [] -> Type + static member MakeStructTupleType: asm: Assembly * types: Type[] -> Type /// Return true if the typ is a representation of an F# tuple type /// @@ -653,7 +653,7 @@ type FSharpType = /// An array of the types contained in the given tuple type. /// /// - static member GetTupleElements: tupleType: Type -> Type [] + static member GetTupleElements: tupleType: Type -> Type[] /// Gets the domain and range types from an F# function type or from the runtime type of a closure implementing an F# type /// @@ -682,7 +682,7 @@ module FSharpReflectionExtensions = /// The created record. /// /// - static member MakeRecord: recordType: Type * values: obj [] * ?allowAccessToPrivateRepresentation: bool -> obj + static member MakeRecord: recordType: Type * values: obj[] * ?allowAccessToPrivateRepresentation: bool -> obj /// Reads all the fields from a record value. /// @@ -696,7 +696,7 @@ module FSharpReflectionExtensions = /// The array of fields from the record. /// /// - static member GetRecordFields: record: obj * ?allowAccessToPrivateRepresentation: bool -> obj [] + static member GetRecordFields: record: obj * ?allowAccessToPrivateRepresentation: bool -> obj[] /// Precompute a function for reading all the fields from a record. The fields are returned in the /// same order as the fields reported by a call to Microsoft.FSharp.Reflection.Type.GetInfo for @@ -718,7 +718,7 @@ module FSharpReflectionExtensions = /// /// static member PreComputeRecordReader: - recordType: Type * ?allowAccessToPrivateRepresentation: bool -> (obj -> obj []) + recordType: Type * ?allowAccessToPrivateRepresentation: bool -> (obj -> obj[]) /// Precompute a function for constructing a record value. /// @@ -734,7 +734,7 @@ module FSharpReflectionExtensions = /// /// static member PreComputeRecordConstructor: - recordType: Type * ?allowAccessToPrivateRepresentation: bool -> (obj [] -> obj) + recordType: Type * ?allowAccessToPrivateRepresentation: bool -> (obj[] -> obj) /// Get a ConstructorInfo for a record type /// @@ -757,7 +757,7 @@ module FSharpReflectionExtensions = /// /// static member MakeUnion: - unionCase: UnionCaseInfo * args: obj [] * ?allowAccessToPrivateRepresentation: bool -> obj + unionCase: UnionCaseInfo * args: obj[] * ?allowAccessToPrivateRepresentation: bool -> obj /// Identify the union case and its fields for an object /// @@ -777,7 +777,7 @@ module FSharpReflectionExtensions = /// /// static member GetUnionFields: - value: obj * unionType: Type * ?allowAccessToPrivateRepresentation: bool -> UnionCaseInfo * obj [] + value: obj * unionType: Type * ?allowAccessToPrivateRepresentation: bool -> UnionCaseInfo * obj[] /// Assumes the given type is a union type. /// If not, is raised during pre-computation. @@ -817,7 +817,7 @@ module FSharpReflectionExtensions = /// /// static member PreComputeUnionReader: - unionCase: UnionCaseInfo * ?allowAccessToPrivateRepresentation: bool -> (obj -> obj []) + unionCase: UnionCaseInfo * ?allowAccessToPrivateRepresentation: bool -> (obj -> obj[]) /// Precompute a function for constructing a discriminated union value for a particular union case. /// @@ -828,7 +828,7 @@ module FSharpReflectionExtensions = /// /// static member PreComputeUnionConstructor: - unionCase: UnionCaseInfo * ?allowAccessToPrivateRepresentation: bool -> (obj [] -> obj) + unionCase: UnionCaseInfo * ?allowAccessToPrivateRepresentation: bool -> (obj[] -> obj) /// A method that constructs objects of the given case /// @@ -853,7 +853,7 @@ module FSharpReflectionExtensions = /// The fields from the given exception. /// /// - static member GetExceptionFields: exn: obj * ?allowAccessToPrivateRepresentation: bool -> obj [] + static member GetExceptionFields: exn: obj * ?allowAccessToPrivateRepresentation: bool -> obj[] type FSharpType with @@ -867,7 +867,7 @@ module FSharpReflectionExtensions = /// An array of descriptions of the properties of the record type. /// /// - static member GetRecordFields: recordType: Type * ?allowAccessToPrivateRepresentation: bool -> PropertyInfo [] + static member GetRecordFields: recordType: Type * ?allowAccessToPrivateRepresentation: bool -> PropertyInfo[] /// Gets the cases of a union type. /// @@ -881,7 +881,7 @@ module FSharpReflectionExtensions = /// An array of descriptions of the cases of the given union type. /// /// - static member GetUnionCases: unionType: Type * ?allowAccessToPrivateRepresentation: bool -> UnionCaseInfo [] + static member GetUnionCases: unionType: Type * ?allowAccessToPrivateRepresentation: bool -> UnionCaseInfo[] /// Return true if the typ is a representation of an F# record type /// @@ -916,7 +916,7 @@ module FSharpReflectionExtensions = /// /// static member GetExceptionFields: - exceptionType: Type * ?allowAccessToPrivateRepresentation: bool -> PropertyInfo [] + exceptionType: Type * ?allowAccessToPrivateRepresentation: bool -> PropertyInfo[] /// Returns true if the exceptionType is a representation of an F# exception declaration /// diff --git a/src/FSharp.Core/result.fs b/src/FSharp.Core/result.fs index bc371582e06..ae9a7ca545a 100644 --- a/src/FSharp.Core/result.fs +++ b/src/FSharp.Core/result.fs @@ -5,11 +5,11 @@ namespace Microsoft.FSharp.Core [] module Result = - [] - 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) - [] - 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 - [] - 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 diff --git a/src/FSharp.Core/seq.fs b/src/FSharp.Core/seq.fs index fb6fd554ff7..27699c40abb 100644 --- a/src/FSharp.Core/seq.fs +++ b/src/FSharp.Core/seq.fs @@ -1,78 +1,84 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. namespace Microsoft.FSharp.Collections - #nowarn "52" // The value has been copied to ensure the original is not mutated by this operation - - open System - open System.Diagnostics - open System.Collections - open System.Collections.Generic - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Control - open Microsoft.FSharp.Collections - - module Internal = - module IEnumerator = - open Microsoft.FSharp.Collections.IEnumerator - - let rec tryItem index (e : IEnumerator<'T>) = - if not (e.MoveNext()) then None - elif index = 0 then Some e.Current - else tryItem (index-1) e - - let rec nth index (e : IEnumerator<'T>) = - if not (e.MoveNext()) then - let shortBy = index + 1 - invalidArgFmt "index" - "{0}\nseq was short by {1} {2}" - [|SR.GetString SR.notEnoughElements; shortBy; (if shortBy = 1 then "element" else "elements")|] - if index = 0 then e.Current - else nth (index - 1) e - - [] - type MapEnumeratorState = - | NotStarted - | InProcess - | Finished - - [] - type MapEnumerator<'T> () = - let mutable state = NotStarted - - [] - val mutable private curr : 'T - - member this.GetCurrent () = - match state with - | NotStarted -> notStarted() - | Finished -> alreadyFinished() - | InProcess -> () - this.curr - - abstract DoMoveNext : byref<'T> -> bool - abstract Dispose : unit -> unit - - interface IEnumerator<'T> with - member this.Current = this.GetCurrent() - - interface IEnumerator with - member this.Current = box(this.GetCurrent()) - member this.MoveNext () = - state <- InProcess - if this.DoMoveNext(&this.curr) then - true - else - state <- Finished - false - member _.Reset() = noReset() - interface System.IDisposable with - member this.Dispose() = this.Dispose() - - let map f (e : IEnumerator<_>) : IEnumerator<_>= - upcast - { new MapEnumerator<_>() with + +#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation + +open System +open System.Diagnostics +open System.Collections +open System.Collections.Generic +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.CompilerServices +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Control +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Primitives.Basics + +module Internal = + + module IEnumerator = + + open Microsoft.FSharp.Collections.IEnumerator + + let rec tryItem index (e : IEnumerator<'T>) = + if not (e.MoveNext()) then None + elif index = 0 then Some e.Current + else tryItem (index-1) e + + let rec nth index (e : IEnumerator<'T>) = + if not (e.MoveNext()) then + let shortBy = index + 1 + invalidArgFmt "index" + "{0}\nseq was short by {1} {2}" + [|SR.GetString SR.notEnoughElements; shortBy; (if shortBy = 1 then "element" else "elements")|] + if index = 0 then e.Current + else nth (index - 1) e + + [] + type MapEnumeratorState = + | NotStarted + | InProcess + | Finished + + [] + type MapEnumerator<'T> () = + let mutable state = NotStarted + + [] + val mutable private curr : 'T + + member this.GetCurrent () = + match state with + | NotStarted -> notStarted() + | Finished -> alreadyFinished() + | InProcess -> () + this.curr + + abstract DoMoveNext : byref<'T> -> bool + abstract Dispose : unit -> unit + + interface IEnumerator<'T> with + member this.Current = this.GetCurrent() + + interface IEnumerator with + member this.Current = box(this.GetCurrent()) + member this.MoveNext () = + state <- InProcess + if this.DoMoveNext(&this.curr) then + true + else + state <- Finished + false + member _.Reset() = noReset() + + interface System.IDisposable with + member this.Dispose() = this.Dispose() + + let map f (e : IEnumerator<_>) : IEnumerator<_>= + upcast + { new MapEnumerator<_>() with member _.DoMoveNext (curr : byref<_>) = if e.MoveNext() then curr <- f e.Current @@ -80,97 +86,101 @@ namespace Microsoft.FSharp.Collections else false member _.Dispose() = e.Dispose() - } - - let mapi f (e : IEnumerator<_>) : IEnumerator<_> = - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f) - let mutable i = -1 - upcast - { new MapEnumerator<_>() with - member _.DoMoveNext curr = + } + + let mapi f (e : IEnumerator<_>) : IEnumerator<_> = + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f) + let mutable i = -1 + upcast + { new MapEnumerator<_>() with + member _.DoMoveNext curr = i <- i + 1 if e.MoveNext() then - curr <- f.Invoke(i, e.Current) - true + curr <- f.Invoke(i, e.Current) + true else - false - member _.Dispose() = e.Dispose() - } - - let map2 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) : IEnumerator<_>= - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f) - upcast - { new MapEnumerator<_>() with - member _.DoMoveNext curr = + false + member _.Dispose() = e.Dispose() + } + + let map2 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) : IEnumerator<_>= + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f) + upcast + { new MapEnumerator<_>() with + member _.DoMoveNext curr = let n1 = e1.MoveNext() let n2 = e2.MoveNext() if n1 && n2 then - curr <- f.Invoke(e1.Current, e2.Current) - true + curr <- f.Invoke(e1.Current, e2.Current) + true else - false + false + member _.Dispose() = try e1.Dispose() finally e2.Dispose() - } - - let mapi2 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) : IEnumerator<_> = - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(f) - let mutable i = -1 - upcast - { new MapEnumerator<_>() with - member _.DoMoveNext curr = + } + + let mapi2 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) : IEnumerator<_> = + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(f) + let mutable i = -1 + upcast + { new MapEnumerator<_>() with + member _.DoMoveNext curr = i <- i + 1 if (e1.MoveNext() && e2.MoveNext()) then curr <- f.Invoke(i, e1.Current, e2.Current) true else false - member _.Dispose() = + + member _.Dispose() = try e1.Dispose() finally e2.Dispose() - } - - let map3 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) (e3 : IEnumerator<_>) : IEnumerator<_> = - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(f) - upcast - { new MapEnumerator<_>() with - member _.DoMoveNext curr = - let n1 = e1.MoveNext() - let n2 = e2.MoveNext() - let n3 = e3.MoveNext() - - if n1 && n2 && n3 then - curr <- f.Invoke(e1.Current, e2.Current, e3.Current) - true - else - false - member _.Dispose() = - try - e1.Dispose() - finally - try - e2.Dispose() - finally - e3.Dispose() - } - - let choose f (e : IEnumerator<'T>) = - let mutable started = false - let mutable curr = None - let get() = - check started - match curr with - | None -> alreadyFinished() - | Some x -> x - - { new IEnumerator<'U> with + } + + let map3 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) (e3 : IEnumerator<_>) : IEnumerator<_> = + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(f) + upcast + { new MapEnumerator<_>() with + member _.DoMoveNext curr = + let n1 = e1.MoveNext() + let n2 = e2.MoveNext() + let n3 = e3.MoveNext() + + if n1 && n2 && n3 then + curr <- f.Invoke(e1.Current, e2.Current, e3.Current) + true + else + false + + member _.Dispose() = + try + e1.Dispose() + finally + try + e2.Dispose() + finally + e3.Dispose() + } + + let choose f (e : IEnumerator<'T>) = + let mutable started = false + let mutable curr = None + let get() = + check started + match curr with + | None -> alreadyFinished() + | Some x -> x + + { new IEnumerator<'U> with member _.Current = get() - interface IEnumerator with + + interface IEnumerator with member _.Current = box (get()) member _.MoveNext() = if not started then started <- true @@ -178,74 +188,87 @@ namespace Microsoft.FSharp.Collections while (curr.IsNone && e.MoveNext()) do curr <- f e.Current Option.isSome curr + member _.Reset() = noReset() - interface System.IDisposable with + + interface System.IDisposable with member _.Dispose() = e.Dispose() } - let filter f (e : IEnumerator<'T>) = - let mutable started = false - let this = - { new IEnumerator<'T> with + let filter f (e : IEnumerator<'T>) = + let mutable started = false + let this = + { new IEnumerator<'T> with member _.Current = check started; e.Current - interface IEnumerator with + + interface IEnumerator with member _.Current = check started; box e.Current + member _.MoveNext() = let rec next() = if not started then started <- true e.MoveNext() && (f e.Current || next()) next() + member _.Reset() = noReset() - interface System.IDisposable with + + interface System.IDisposable with member _.Dispose() = e.Dispose() } - this + this - let unfold f x : IEnumerator<_> = - let mutable state = x - upcast - { new MapEnumerator<_>() with + let unfold f x : IEnumerator<_> = + let mutable state = x + upcast + { new MapEnumerator<_>() with member _.DoMoveNext curr = match f state with - | None -> false - | Some (r,s) -> - curr <- r - state <- s - true + | None -> false + | Some (r,s) -> + curr <- r + state <- s + true + member _.Dispose() = () - } - - let upto lastOption f = - match lastOption with - | Some b when b < 0 -> Empty() // a request for -ve length returns empty sequence - | _ -> - let unstarted = -1 // index value means unstarted (and no valid index) - let completed = -2 // index value means completed (and no valid index) - let unreachable = -3 // index is unreachable from 0,1,2,3,... - let finalIndex = match lastOption with - | Some b -> b // here b>=0, a valid end value. - | None -> unreachable // run "forever", well as far as Int32.MaxValue since indexing with a bounded type. - // The Current value for a valid index is "f i". - // Lazy<_> values are used as caches, to store either the result or an exception if thrown. - // These "Lazy<_>" caches are created only on the first call to current and forced immediately. - // The lazy creation of the cache nodes means enumerations that skip many Current values are not delayed by GC. - // For example, the full enumeration of Seq.initInfinite in the tests. - // state - let mutable index = unstarted - // a Lazy node to cache the result/exception - let mutable current = Unchecked.defaultof<_> - let setIndex i = - index <- i - current <- (Unchecked.defaultof<_>) // cache node unprimed, initialised on demand. - let getCurrent() = - if index = unstarted then notStarted() - if index = completed then alreadyFinished() - match box current with - | null -> current <- Lazy<_>.Create(fun () -> f index) - | _ -> () - // forced or re-forced immediately. - current.Force() - { new IEnumerator<'U> with + } + + let upto lastOption f = + match lastOption with + | Some b when b < 0 -> Empty() // a request for -ve length returns empty sequence + | _ -> + let unstarted = -1 // index value means unstarted (and no valid index) + let completed = -2 // index value means completed (and no valid index) + let unreachable = -3 // index is unreachable from 0,1,2,3,... + let finalIndex = + match lastOption with + | Some b -> b // here b>=0, a valid end value. + | None -> unreachable // run "forever", well as far as Int32.MaxValue since indexing with a bounded type. + + // The Current value for a valid index is "f i". + // Lazy<_> values are used as caches, to store either the result or an exception if thrown. + // These "Lazy<_>" caches are created only on the first call to current and forced immediately. + // The lazy creation of the cache nodes means enumerations that skip many Current values are not delayed by GC. + // For example, the full enumeration of Seq.initInfinite in the tests. + // state + let mutable index = unstarted + + // a Lazy node to cache the result/exception + let mutable current = Unchecked.defaultof<_> + let setIndex i = + index <- i + current <- (Unchecked.defaultof<_>) // cache node unprimed, initialised on demand. + + let getCurrent() = + if index = unstarted then notStarted() + if index = completed then alreadyFinished() + match box current with + | null -> + current <- Lazy<_>.Create(fun () -> f index) + | _ -> () + // forced or re-forced immediately. + current.Force() + { new IEnumerator<'U> with member _.Current = getCurrent() - interface IEnumerator with + + interface IEnumerator with member _.Current = box (getCurrent()) member _.MoveNext() = if index = completed then @@ -262,41 +285,46 @@ namespace Microsoft.FSharp.Collections true member _.Reset() = noReset() - interface System.IDisposable with - member _.Dispose() = () } - - [] - type ArrayEnumerator<'T>(arr: 'T array) = - let mutable curr = -1 - let mutable len = arr.Length - member _.Get() = - if curr >= 0 then - if curr >= len then alreadyFinished() - else arr.[curr] - else - notStarted() - interface IEnumerator<'T> with + + interface System.IDisposable with + member _.Dispose() = () + } + + [] + type ArrayEnumerator<'T>(arr: 'T array) = + let mutable curr = -1 + let mutable len = arr.Length + member _.Get() = + if curr >= 0 then + if curr >= len then alreadyFinished() + else arr.[curr] + else + notStarted() + + interface IEnumerator<'T> with member x.Current = x.Get() - interface System.Collections.IEnumerator with + + interface System.Collections.IEnumerator with member _.MoveNext() = - if curr >= len then false - else - curr <- curr + 1 - curr < len + if curr >= len then + false + else + curr <- curr + 1 + curr < len + member x.Current = box(x.Get()) - member x.Reset() = noReset() - interface System.IDisposable with - member x.Dispose() = () - let ofArray arr = (new ArrayEnumerator<'T>(arr) :> IEnumerator<'T>) + member _.Reset() = noReset() + + interface System.IDisposable with + member _.Dispose() = () + + let ofArray arr = (new ArrayEnumerator<'T>(arr) :> IEnumerator<'T>) // Use generators for some implementations of IEnumerables. // module Generator = - open System.Collections - open System.Collections.Generic - [] type Step<'T> = | Stop @@ -335,29 +363,33 @@ namespace Microsoft.FSharp.Collections // yield n } type GenerateThen<'T>(g:Generator<'T>, cont : unit -> Generator<'T>) = + member _.Generator = g + member _.Cont = cont + interface Generator<'T> with + member _.Apply = (fun () -> - match appG g with - | Stop -> - // OK, move onto the generator given by the continuation - Goto(cont()) + match appG g with + | Stop -> + // OK, move onto the generator given by the continuation + Goto(cont()) + + | Yield _ as res -> + res - | Yield _ as res -> - res + | Goto next -> + Goto(GenerateThen<_>.Bind(next, cont))) - | Goto next -> - Goto(GenerateThen<_>.Bind(next, cont))) member _.Disposer = - g.Disposer + g.Disposer static member Bind (g:Generator<'T>, cont) = match g with | :? GenerateThen<'T> as g -> GenerateThen<_>.Bind(g.Generator, (fun () -> GenerateThen<_>.Bind (g.Cont(), cont))) | g -> (new GenerateThen<'T>(g, cont) :> Generator<'T>) - let bindG g cont = GenerateThen<_>.Bind(g,cont) // Internal type. Drive an underlying generator. Crucially when the generator returns @@ -386,7 +418,9 @@ namespace Microsoft.FSharp.Collections let mutable g = g let mutable curr = None let mutable finished = false + member _.Generator = g + interface IEnumerator<'T> with member _.Current = match curr with @@ -395,6 +429,7 @@ namespace Microsoft.FSharp.Collections interface System.Collections.IEnumerator with member x.Current = box (x :> IEnumerator<_>).Current + member x.MoveNext() = not finished && match appG g with @@ -408,7 +443,9 @@ namespace Microsoft.FSharp.Collections | Goto next -> (g <- next) (x :> IEnumerator).MoveNext() + member _.Reset() = IEnumerator.noReset() + interface System.IDisposable with member _.Dispose() = if not finished then disposeG g @@ -435,254 +472,250 @@ namespace Microsoft.FSharp.Collections | _ -> (new LazyGeneratorWrappingEnumerator<'T>(e) :> Generator<'T>) -namespace Microsoft.FSharp.Collections - - open System - open System.Diagnostics - open System.Collections - open System.Collections.Generic - open System.Reflection - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.CompilerServices - open Microsoft.FSharp.Control - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Primitives.Basics - - [] - type CachedSeq<'T>(cleanup,res:seq<'T>) = - interface System.IDisposable with - member x.Dispose() = cleanup() - interface System.Collections.Generic.IEnumerable<'T> with - member x.GetEnumerator() = res.GetEnumerator() - interface System.Collections.IEnumerable with - member x.GetEnumerator() = (res :> System.Collections.IEnumerable).GetEnumerator() - member obj.Clear() = cleanup() - - - [] - [] - module Seq = - - open Microsoft.FSharp.Collections.Internal - open Microsoft.FSharp.Collections.IEnumerator - - let mkDelayedSeq (f: unit -> IEnumerable<'T>) = mkSeq (fun () -> f().GetEnumerator()) - let mkUnfoldSeq f x = mkSeq (fun () -> IEnumerator.unfold f x) - let inline indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt))) - - [] - let delay generator = mkDelayedSeq generator - - [] - let unfold generator state = mkUnfoldSeq generator state - - [] - let empty<'T> = (EmptyEnumerable :> seq<'T>) - - [] - let initInfinite initializer = mkSeq (fun () -> IEnumerator.upto None initializer) - - [] - let init count initializer = - if count < 0 then invalidArgInputMustBeNonNegative "count" count - mkSeq (fun () -> IEnumerator.upto (Some (count - 1)) initializer) - - [] - let iter action (source : seq<'T>) = - checkNonNull "source" source - use e = source.GetEnumerator() - while e.MoveNext() do - action e.Current - - [] - let item index (source : seq<'T>) = - checkNonNull "source" source - if index < 0 then invalidArgInputMustBeNonNegative "index" index - use e = source.GetEnumerator() - IEnumerator.nth index e - - [] - let tryItem index (source : seq<'T>) = - checkNonNull "source" source - if index < 0 then None else - use e = source.GetEnumerator() - IEnumerator.tryItem index e - - [] - let nth index (source : seq<'T>) = item index source - - [] - let iteri action (source : seq<'T>) = - checkNonNull "source" source - use e = source.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(action) - let mutable i = 0 - while e.MoveNext() do - f.Invoke(i, e.Current) - i <- i + 1 - - [] - let exists predicate (source : seq<'T>) = - checkNonNull "source" source - use e = source.GetEnumerator() - let mutable state = false - while (not state && e.MoveNext()) do - state <- predicate e.Current - state - - [] - let inline contains value (source : seq<'T>) = - checkNonNull "source" source - use e = source.GetEnumerator() - let mutable state = false - while (not state && e.MoveNext()) do - state <- value = e.Current - state - - [] - let forall predicate (source : seq<'T>) = - checkNonNull "source" source - use e = source.GetEnumerator() - let mutable state = true - while (state && e.MoveNext()) do - state <- predicate e.Current - state - - [] - let iter2 action (source1 : seq<_>) (source2 : seq<_>) = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - use e1 = source1.GetEnumerator() - use e2 = source2.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt action - while (e1.MoveNext() && e2.MoveNext()) do - f.Invoke(e1.Current, e2.Current) - - [] - let iteri2 action (source1 : seq<_>) (source2 : seq<_>) = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - use e1 = source1.GetEnumerator() - use e2 = source2.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt action - let mutable i = 0 - while (e1.MoveNext() && e2.MoveNext()) do - f.Invoke(i, e1.Current, e2.Current) - i <- i + 1 - - // Build an IEnumerable by wrapping/transforming iterators as they get generated. - let revamp f (ie : seq<_>) = mkSeq (fun () -> f (ie.GetEnumerator())) - let revamp2 f (ie1 : seq<_>) (source2 : seq<_>) = - mkSeq (fun () -> f (ie1.GetEnumerator()) (source2.GetEnumerator())) - let revamp3 f (ie1 : seq<_>) (source2 : seq<_>) (source3 : seq<_>) = - mkSeq (fun () -> f (ie1.GetEnumerator()) (source2.GetEnumerator()) (source3.GetEnumerator())) - - [] - let filter predicate source = - checkNonNull "source" source - revamp (IEnumerator.filter predicate) source - - [] - let where predicate source = filter predicate source - - [] - let map mapping source = - checkNonNull "source" source - revamp (IEnumerator.map mapping) source - - [] - let mapi mapping source = - checkNonNull "source" source - revamp (IEnumerator.mapi mapping) source - - [] - let mapi2 mapping source1 source2 = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - revamp2 (IEnumerator.mapi2 mapping) source1 source2 - - [] - let map2 mapping source1 source2 = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - revamp2 (IEnumerator.map2 mapping) source1 source2 - - [] - let map3 mapping source1 source2 source3 = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - checkNonNull "source3" source3 - revamp3 (IEnumerator.map3 mapping) source1 source2 source3 - - [] - let choose chooser source = - checkNonNull "source" source - revamp (IEnumerator.choose chooser) source - - [] - let indexed source = - checkNonNull "source" source - mapi (fun i x -> i, x) source - - [] - let zip source1 source2 = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - map2 (fun x y -> x, y) source1 source2 - - [] - let zip3 source1 source2 source3 = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - checkNonNull "source3" source3 - map2 (fun x (y,z) -> x, y, z) source1 (zip source2 source3) - - [] - let cast (source: IEnumerable) = - checkNonNull "source" source - mkSeq (fun () -> IEnumerator.cast (source.GetEnumerator())) - - [] - let tryPick chooser (source : seq<'T>) = - checkNonNull "source" source - use e = source.GetEnumerator() - let mutable res = None - while (Option.isNone res && e.MoveNext()) do - res <- chooser e.Current - res - - [] - let pick chooser source = - checkNonNull "source" source - match tryPick chooser source with - | None -> indexNotFound() - | Some x -> x - - [] - let tryFind predicate (source : seq<'T>) = - checkNonNull "source" source - use e = source.GetEnumerator() - let mutable res = None - while (Option.isNone res && e.MoveNext()) do - let c = e.Current - if predicate c then res <- Some c - res - - [] - let find predicate source = - checkNonNull "source" source - match tryFind predicate source with - | None -> indexNotFound() - | Some x -> x - - [] - let take count (source : seq<'T>) = - checkNonNull "source" source - if count < 0 then invalidArgInputMustBeNonNegative "count" count - (* Note: don't create or dispose any IEnumerable if n = 0 *) - if count = 0 then empty else +[] +type CachedSeq<'T>(cleanup,res:seq<'T>) = + interface System.IDisposable with + member x.Dispose() = cleanup() + interface System.Collections.Generic.IEnumerable<'T> with + member x.GetEnumerator() = res.GetEnumerator() + interface System.Collections.IEnumerable with + member x.GetEnumerator() = (res :> System.Collections.IEnumerable).GetEnumerator() + member obj.Clear() = cleanup() + + +[] +[] +module Seq = + + open Internal + open IEnumerator + + let mkDelayedSeq (f: unit -> IEnumerable<'T>) = mkSeq (fun () -> f().GetEnumerator()) + let mkUnfoldSeq f x = mkSeq (fun () -> IEnumerator.unfold f x) + let inline indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt))) + + [] + let delay generator = mkDelayedSeq generator + + [] + let unfold generator state = mkUnfoldSeq generator state + + [] + let empty<'T> = (EmptyEnumerable :> seq<'T>) + + [] + let initInfinite initializer = mkSeq (fun () -> IEnumerator.upto None initializer) + + [] + let init count initializer = + if count < 0 then invalidArgInputMustBeNonNegative "count" count + mkSeq (fun () -> IEnumerator.upto (Some (count - 1)) initializer) + + [] + let iter action (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + while e.MoveNext() do + action e.Current + + [] + let item index (source : seq<'T>) = + checkNonNull "source" source + if index < 0 then invalidArgInputMustBeNonNegative "index" index + use e = source.GetEnumerator() + IEnumerator.nth index e + + [] + let tryItem index (source : seq<'T>) = + checkNonNull "source" source + if index < 0 then None else + use e = source.GetEnumerator() + IEnumerator.tryItem index e + + [] + let nth index (source : seq<'T>) = + item index source + + [] + let iteri action (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(action) + let mutable i = 0 + while e.MoveNext() do + f.Invoke(i, e.Current) + i <- i + 1 + + [] + let exists predicate (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + let mutable state = false + while (not state && e.MoveNext()) do + state <- predicate e.Current + state + + [] + let inline contains value (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + let mutable state = false + while (not state && e.MoveNext()) do + state <- value = e.Current + state + + [] + let forall predicate (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + let mutable state = true + while (state && e.MoveNext()) do + state <- predicate e.Current + state + + [] + let iter2 action (source1 : seq<_>) (source2 : seq<_>) = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + use e1 = source1.GetEnumerator() + use e2 = source2.GetEnumerator() + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt action + while (e1.MoveNext() && e2.MoveNext()) do + f.Invoke(e1.Current, e2.Current) + + [] + let iteri2 action (source1 : seq<_>) (source2 : seq<_>) = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + use e1 = source1.GetEnumerator() + use e2 = source2.GetEnumerator() + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt action + let mutable i = 0 + while (e1.MoveNext() && e2.MoveNext()) do + f.Invoke(i, e1.Current, e2.Current) + i <- i + 1 + + // Build an IEnumerable by wrapping/transforming iterators as they get generated. + let revamp f (ie : seq<_>) = mkSeq (fun () -> f (ie.GetEnumerator())) + + let revamp2 f (ie1 : seq<_>) (source2 : seq<_>) = + mkSeq (fun () -> f (ie1.GetEnumerator()) (source2.GetEnumerator())) + + let revamp3 f (ie1 : seq<_>) (source2 : seq<_>) (source3 : seq<_>) = + mkSeq (fun () -> f (ie1.GetEnumerator()) (source2.GetEnumerator()) (source3.GetEnumerator())) + + [] + let filter predicate source = + checkNonNull "source" source + revamp (IEnumerator.filter predicate) source + + [] + let where predicate source = filter predicate source + + [] + let map mapping source = + checkNonNull "source" source + revamp (IEnumerator.map mapping) source + + [] + let mapi mapping source = + checkNonNull "source" source + revamp (IEnumerator.mapi mapping) source + + [] + let mapi2 mapping source1 source2 = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + revamp2 (IEnumerator.mapi2 mapping) source1 source2 + + [] + let map2 mapping source1 source2 = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + revamp2 (IEnumerator.map2 mapping) source1 source2 + + [] + let map3 mapping source1 source2 source3 = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + checkNonNull "source3" source3 + revamp3 (IEnumerator.map3 mapping) source1 source2 source3 + + [] + let choose chooser source = + checkNonNull "source" source + revamp (IEnumerator.choose chooser) source + + [] + let indexed source = + checkNonNull "source" source + mapi (fun i x -> i, x) source + + [] + let zip source1 source2 = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + map2 (fun x y -> x, y) source1 source2 + + [] + let zip3 source1 source2 source3 = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + checkNonNull "source3" source3 + map2 (fun x (y,z) -> x, y, z) source1 (zip source2 source3) + + [] + let cast (source: IEnumerable) = + checkNonNull "source" source + mkSeq (fun () -> IEnumerator.cast (source.GetEnumerator())) + + [] + let tryPick chooser (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + let mutable res = None + + while (Option.isNone res && e.MoveNext()) do + res <- chooser e.Current + + res + + [] + let pick chooser source = + checkNonNull "source" source + + match tryPick chooser source with + | None -> indexNotFound() + | Some x -> x + + [] + let tryFind predicate (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + let mutable res = None + + while (Option.isNone res && e.MoveNext()) do + let c = e.Current + if predicate c then res <- Some c + + res + + [] + let find predicate source = + checkNonNull "source" source + + match tryFind predicate source with + | None -> indexNotFound() + | Some x -> x + + [] + let take count (source : seq<'T>) = + checkNonNull "source" source + if count < 0 then invalidArgInputMustBeNonNegative "count" count + // Note: don't create or dispose any IEnumerable if n = 0 + if count = 0 then + empty + else seq { use e = source.GetEnumerator() for x in count .. - 1 .. 1 do if not (e.MoveNext()) then @@ -690,876 +723,840 @@ namespace Microsoft.FSharp.Collections [|SR.GetString SR.notEnoughElements; x; (if x = 1 then "element" else "elements"); count|] yield e.Current } - [] - let isEmpty (source : seq<'T>) = - checkNonNull "source" source - match source with - | :? ('T[]) as a -> a.Length = 0 - | :? ('T list) as a -> a.IsEmpty - | :? ICollection<'T> as a -> a.Count = 0 - | _ -> - use ie = source.GetEnumerator() - not (ie.MoveNext()) - - - [] - let concat sources = - checkNonNull "sources" sources - RuntimeHelpers.mkConcatSeq sources - - [] - let length (source : seq<'T>) = - checkNonNull "source" source - match source with - | :? ('T[]) as a -> a.Length - | :? ('T list) as a -> a.Length - | :? ICollection<'T> as a -> a.Count - | _ -> - use e = source.GetEnumerator() - let mutable state = 0 - while e.MoveNext() do - state <- state + 1 - state - - [] - let fold<'T,'State> folder (state:'State) (source : seq<'T>) = - checkNonNull "source" source - use e = source.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt folder - let mutable state = state - while e.MoveNext() do - state <- f.Invoke(state, e.Current) - state - - [] - let fold2<'T1,'T2,'State> folder (state:'State) (source1: seq<'T1>) (source2: seq<'T2>) = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - - use e1 = source1.GetEnumerator() - use e2 = source2.GetEnumerator() - - let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt folder - - let mutable state = state - while e1.MoveNext() && e2.MoveNext() do - state <- f.Invoke(state, e1.Current, e2.Current) - - state - - [] - let reduce reduction (source : seq<'T>) = - checkNonNull "source" source + [] + let isEmpty (source : seq<'T>) = + checkNonNull "source" source + match source with + | :? ('T[]) as a -> a.Length = 0 + | :? ('T list) as a -> a.IsEmpty + | :? ICollection<'T> as a -> a.Count = 0 + | _ -> + use ie = source.GetEnumerator() + not (ie.MoveNext()) + + + [] + let concat sources = + checkNonNull "sources" sources + RuntimeHelpers.mkConcatSeq sources + + [] + let length (source : seq<'T>) = + checkNonNull "source" source + match source with + | :? ('T[]) as a -> a.Length + | :? ('T list) as a -> a.Length + | :? ICollection<'T> as a -> a.Count + | _ -> use e = source.GetEnumerator() - if not (e.MoveNext()) then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt reduction - let mutable state = e.Current + let mutable state = 0 while e.MoveNext() do - state <- f.Invoke(state, e.Current) + state <- state + 1 state - let fromGenerator f = mkSeq(fun () -> Generator.EnumerateFromGenerator (f())) - let toGenerator (ie : seq<_>) = Generator.GenerateFromEnumerator (ie.GetEnumerator()) - - [] - let replicate count initial = - System.Linq.Enumerable.Repeat(initial,count) - - [] - let append (source1: seq<'T>) (source2: seq<'T>) = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - fromGenerator(fun () -> Generator.bindG (toGenerator source1) (fun () -> toGenerator source2)) - - [] - let collect mapping source = map mapping source |> concat - - [] - let compareWith (comparer:'T -> 'T -> int) (source1 : seq<'T>) (source2: seq<'T>) = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - use e1 = source1.GetEnumerator() - use e2 = source2.GetEnumerator() - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt comparer - let rec go () = - let e1ok = e1.MoveNext() - let e2ok = e2.MoveNext() - let c = if e1ok = e2ok then 0 else if e1ok then 1 else -1 + [] + let fold<'T,'State> folder (state:'State) (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt folder + let mutable state = state + while e.MoveNext() do + state <- f.Invoke(state, e.Current) + state + + [] + let fold2<'T1,'T2,'State> folder (state:'State) (source1: seq<'T1>) (source2: seq<'T2>) = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + + use e1 = source1.GetEnumerator() + use e2 = source2.GetEnumerator() + + let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt folder + + let mutable state = state + while e1.MoveNext() && e2.MoveNext() do + state <- f.Invoke(state, e1.Current, e2.Current) + + state + + [] + let reduce reduction (source : seq<'T>) = + checkNonNull "source" source + use e = source.GetEnumerator() + if not (e.MoveNext()) then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt reduction + let mutable state = e.Current + while e.MoveNext() do + state <- f.Invoke(state, e.Current) + state + + let fromGenerator f = mkSeq(fun () -> Generator.EnumerateFromGenerator (f())) + let toGenerator (ie : seq<_>) = Generator.GenerateFromEnumerator (ie.GetEnumerator()) + + [] + let replicate count initial = + System.Linq.Enumerable.Repeat(initial,count) + + [] + let append (source1: seq<'T>) (source2: seq<'T>) = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + fromGenerator(fun () -> Generator.bindG (toGenerator source1) (fun () -> toGenerator source2)) + + [] + let collect mapping source = map mapping source |> concat + + [] + let compareWith (comparer:'T -> 'T -> int) (source1 : seq<'T>) (source2: seq<'T>) = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + use e1 = source1.GetEnumerator() + use e2 = source2.GetEnumerator() + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt comparer + let rec go () = + let e1ok = e1.MoveNext() + let e2ok = e2.MoveNext() + let c = if e1ok = e2ok then 0 else if e1ok then 1 else -1 + if c <> 0 then c else + if not e1ok || not e2ok then 0 + else + let c = f.Invoke(e1.Current, e2.Current) if c <> 0 then c else - if not e1ok || not e2ok then 0 - else - let c = f.Invoke(e1.Current, e2.Current) - if c <> 0 then c else - go () - go() - - [] - let ofList (source : 'T list) = - (source :> seq<'T>) - - [] - let toList (source : seq<'T>) = - checkNonNull "source" source - Microsoft.FSharp.Primitives.Basics.List.ofSeq source - - // Create a new object to ensure underlying array may not be mutated by a backdoor cast - [] - let ofArray (source : 'T array) = - checkNonNull "source" source - mkSeq (fun () -> IEnumerator.ofArray source) - - [] - let toArray (source : seq<'T>) = - checkNonNull "source" source - match source with - | :? ('T[]) as res -> (res.Clone() :?> 'T[]) - | :? ('T list) as res -> List.toArray res - | :? ICollection<'T> as res -> - // Directly create an array and copy ourselves. - // This avoids an extra copy if using ResizeArray in fallback below. - let arr = Array.zeroCreateUnchecked res.Count - res.CopyTo(arr, 0) - arr - | _ -> - let res = ResizeArray<_>(source) - res.ToArray() - - let foldArraySubRight (f:OptimizedClosures.FSharpFunc<'T,_,_>) (arr: 'T[]) start fin acc = - let mutable state = acc - for i = fin downto start do - state <- f.Invoke(arr.[i], state) - state - - [] - let foldBack<'T,'State> folder (source : seq<'T>) (state:'State) = - checkNonNull "source" source - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt folder - let arr = toArray source - let len = arr.Length - foldArraySubRight f arr 0 (len - 1) state - - [] - let foldBack2<'T1,'T2,'State> folder (source1 : seq<'T1>) (source2 : seq<'T2>) (state:'State) = - let zipped = zip source1 source2 - foldBack ((<||) folder) zipped state - - [] - let reduceBack reduction (source : seq<'T>) = - checkNonNull "source" source - let arr = toArray source - match arr.Length with - | 0 -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | len -> - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt reduction - foldArraySubRight f arr 0 (len - 2) arr.[len - 1] - - [] - let singleton value = mkSeq (fun () -> IEnumerator.Singleton value) - - [] - let truncate count (source: seq<'T>) = - checkNonNull "source" source - if count <= 0 then empty else - seq { let mutable i = 0 - use ie = source.GetEnumerator() - while i < count && ie.MoveNext() do - i <- i + 1 - yield ie.Current } - - [] - let pairwise (source: seq<'T>) = - checkNonNull "source" source - seq { use ie = source.GetEnumerator() - if ie.MoveNext() then - let mutable iref = ie.Current - while ie.MoveNext() do - let j = ie.Current - yield (iref, j) - iref <- j } - - [] - let scan<'T,'State> folder (state:'State) (source : seq<'T>) = - checkNonNull "source" source - let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt folder - seq { let mutable zref = state - yield zref - use ie = source.GetEnumerator() + go () + go() + + [] + let ofList (source : 'T list) = + (source :> seq<'T>) + + [] + let toList (source : seq<'T>) = + checkNonNull "source" source + Microsoft.FSharp.Primitives.Basics.List.ofSeq source + + // Create a new object to ensure underlying array may not be mutated by a backdoor cast + [] + let ofArray (source : 'T array) = + checkNonNull "source" source + mkSeq (fun () -> IEnumerator.ofArray source) + + [] + let toArray (source : seq<'T>) = + checkNonNull "source" source + match source with + | :? ('T[]) as res -> (res.Clone() :?> 'T[]) + | :? ('T list) as res -> List.toArray res + | :? ICollection<'T> as res -> + // Directly create an array and copy ourselves. + // This avoids an extra copy if using ResizeArray in fallback below. + let arr = Array.zeroCreateUnchecked res.Count + res.CopyTo(arr, 0) + arr + | _ -> + let res = ResizeArray<_>(source) + res.ToArray() + + let foldArraySubRight (f:OptimizedClosures.FSharpFunc<'T,_,_>) (arr: 'T[]) start fin acc = + let mutable state = acc + for i = fin downto start do + state <- f.Invoke(arr.[i], state) + state + + [] + let foldBack<'T,'State> folder (source : seq<'T>) (state:'State) = + checkNonNull "source" source + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt folder + let arr = toArray source + let len = arr.Length + foldArraySubRight f arr 0 (len - 1) state + + [] + let foldBack2<'T1,'T2,'State> folder (source1 : seq<'T1>) (source2 : seq<'T2>) (state:'State) = + let zipped = zip source1 source2 + foldBack ((<||) folder) zipped state + + [] + let reduceBack reduction (source : seq<'T>) = + checkNonNull "source" source + let arr = toArray source + match arr.Length with + | 0 -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | len -> + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt reduction + foldArraySubRight f arr 0 (len - 2) arr.[len - 1] + + [] + let singleton value = mkSeq (fun () -> IEnumerator.Singleton value) + + [] + let truncate count (source: seq<'T>) = + checkNonNull "source" source + if count <= 0 then empty else + seq { let mutable i = 0 + use ie = source.GetEnumerator() + while i < count && ie.MoveNext() do + i <- i + 1 + yield ie.Current } + + [] + let pairwise (source: seq<'T>) = + checkNonNull "source" source + seq { use ie = source.GetEnumerator() + if ie.MoveNext() then + let mutable iref = ie.Current while ie.MoveNext() do - zref <- f.Invoke(zref, ie.Current) - yield zref } - - [] - let tryFindBack predicate (source : seq<'T>) = - checkNonNull "source" source - source |> toArray |> Array.tryFindBack predicate - - [] - let findBack predicate source = - checkNonNull "source" source - source |> toArray |> Array.findBack predicate - - [] - let scanBack<'T,'State> folder (source : seq<'T>) (state:'State) = - checkNonNull "source" source - mkDelayedSeq(fun () -> - let arr = source |> toArray - let res = Array.scanSubRight folder arr 0 (arr.Length - 1) state - res :> seq<_>) - - [] - let findIndex predicate (source:seq<_>) = - checkNonNull "source" source - use ie = source.GetEnumerator() - let rec loop i = - if ie.MoveNext() then - if predicate ie.Current then - i - else loop (i + 1) - else - indexNotFound() - loop 0 - - [] - let tryFindIndex predicate (source:seq<_>) = - checkNonNull "source" source - use ie = source.GetEnumerator() - let rec loop i = - if ie.MoveNext() then - if predicate ie.Current then - Some i - else loop (i + 1) - else - None - loop 0 - - [] - let tryFindIndexBack predicate (source : seq<'T>) = - checkNonNull "source" source - source |> toArray |> Array.tryFindIndexBack predicate - - [] - let findIndexBack predicate source = - checkNonNull "source" source - source |> toArray |> Array.findIndexBack predicate - - // windowed : int -> seq<'T> -> seq<'T[]> - [] - let windowed windowSize (source: seq<_>) = - checkNonNull "source" source - if windowSize <= 0 then invalidArgFmt "windowSize" "{0}\nwindowSize = {1}" - [|SR.GetString SR.inputMustBePositive; windowSize|] - seq { - let arr = Array.zeroCreateUnchecked windowSize - let mutable r =windowSize - 1 - let mutable i = 0 - use e = source.GetEnumerator() - while e.MoveNext() do - arr.[i] <- e.Current - i <- (i + 1) % windowSize - if r = 0 then - if windowSize < 32 then - yield Array.init windowSize (fun j -> arr.[(i+j) % windowSize]) - else - let result = Array.zeroCreateUnchecked windowSize - Array.Copy(arr, i, result, 0, windowSize - i) - Array.Copy(arr, 0, result, windowSize - i, i) - yield result - else r <- (r - 1) - } - - [] - let cache (source : seq<'T>) = - checkNonNull "source" source - // Wrap a seq to ensure that it is enumerated just once and only as far as is necessary. - // - // This code is required to be thread safe. - // The necessary calls should be called at most once (include .MoveNext() = false). - // The enumerator should be disposed (and dropped) when no longer required. - //------ - // The state is (prefix,enumerator) with invariants: - // * the prefix followed by elts from the enumerator are the initial sequence. - // * the prefix contains only as many elements as the longest enumeration so far. - let prefix = ResizeArray<_>() - - // None = Unstarted. - // Some(Some e) = Started. - // Some None = Finished. - let mutable enumeratorR = None - - let oneStepTo i = - // If possible, step the enumeration to prefix length i (at most one step). - // Be speculative, since this could have already happened via another thread. - if i >= prefix.Count then // is a step still required? - // If not yet started, start it (create enumerator). - let optEnumerator = - match enumeratorR with - | None -> - let optEnumerator = Some (source.GetEnumerator()) - enumeratorR <- Some optEnumerator - optEnumerator - | Some optEnumerator -> - optEnumerator - - match optEnumerator with - | Some enumerator -> - if enumerator.MoveNext() then - prefix.Add(enumerator.Current) - else - enumerator.Dispose() // Move failed, dispose enumerator, - enumeratorR <- Some None // drop it and record finished. - | None -> () - - let result = - unfold (fun i -> - // i being the next position to be returned - // A lock is needed over the reads to prefix.Count since the list may be being resized - // NOTE: we could change to a reader/writer lock here - lock prefix (fun () -> + let j = ie.Current + yield (iref, j) + iref <- j } + + [] + let scan<'T,'State> folder (state:'State) (source : seq<'T>) = + checkNonNull "source" source + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt folder + seq { let mutable zref = state + yield zref + use ie = source.GetEnumerator() + while ie.MoveNext() do + zref <- f.Invoke(zref, ie.Current) + yield zref } + + [] + let tryFindBack predicate (source : seq<'T>) = + checkNonNull "source" source + source |> toArray |> Array.tryFindBack predicate + + [] + let findBack predicate source = + checkNonNull "source" source + source |> toArray |> Array.findBack predicate + + [] + let scanBack<'T,'State> folder (source : seq<'T>) (state:'State) = + checkNonNull "source" source + mkDelayedSeq(fun () -> + let arr = source |> toArray + let res = Array.scanSubRight folder arr 0 (arr.Length - 1) state + res :> seq<_>) + + [] + let findIndex predicate (source:seq<_>) = + checkNonNull "source" source + use ie = source.GetEnumerator() + let rec loop i = + if ie.MoveNext() then + if predicate ie.Current then + i + else loop (i + 1) + else + indexNotFound() + loop 0 + + [] + let tryFindIndex predicate (source:seq<_>) = + checkNonNull "source" source + use ie = source.GetEnumerator() + let rec loop i = + if ie.MoveNext() then + if predicate ie.Current then + Some i + else loop (i + 1) + else + None + loop 0 + + [] + let tryFindIndexBack predicate (source : seq<'T>) = + checkNonNull "source" source + source |> toArray |> Array.tryFindIndexBack predicate + + [] + let findIndexBack predicate source = + checkNonNull "source" source + source |> toArray |> Array.findIndexBack predicate + + // windowed : int -> seq<'T> -> seq<'T[]> + [] + let windowed windowSize (source: seq<_>) = + checkNonNull "source" source + if windowSize <= 0 then invalidArgFmt "windowSize" "{0}\nwindowSize = {1}" + [|SR.GetString SR.inputMustBePositive; windowSize|] + seq { + let arr = Array.zeroCreateUnchecked windowSize + let mutable r =windowSize - 1 + let mutable i = 0 + use e = source.GetEnumerator() + while e.MoveNext() do + arr.[i] <- e.Current + i <- (i + 1) % windowSize + if r = 0 then + if windowSize < 32 then + yield Array.init windowSize (fun j -> arr.[(i+j) % windowSize]) + else + let result = Array.zeroCreateUnchecked windowSize + Array.Copy(arr, i, result, 0, windowSize - i) + Array.Copy(arr, 0, result, windowSize - i, i) + yield result + else r <- (r - 1) + } + + [] + let cache (source : seq<'T>) = + checkNonNull "source" source + // Wrap a seq to ensure that it is enumerated just once and only as far as is necessary. + // + // This code is required to be thread safe. + // The necessary calls should be called at most once (include .MoveNext() = false). + // The enumerator should be disposed (and dropped) when no longer required. + //------ + // The state is (prefix,enumerator) with invariants: + // * the prefix followed by elts from the enumerator are the initial sequence. + // * the prefix contains only as many elements as the longest enumeration so far. + let prefix = ResizeArray<_>() + + // None = Unstarted. + // Some(Some e) = Started. + // Some None = Finished. + let mutable enumeratorR = None + + let oneStepTo i = + // If possible, step the enumeration to prefix length i (at most one step). + // Be speculative, since this could have already happened via another thread. + if i >= prefix.Count then // is a step still required? + // If not yet started, start it (create enumerator). + let optEnumerator = + match enumeratorR with + | None -> + let optEnumerator = Some (source.GetEnumerator()) + enumeratorR <- Some optEnumerator + optEnumerator + | Some optEnumerator -> + optEnumerator + + match optEnumerator with + | Some enumerator -> + if enumerator.MoveNext() then + prefix.Add(enumerator.Current) + else + enumerator.Dispose() // Move failed, dispose enumerator, + enumeratorR <- Some None // drop it and record finished. + | None -> () + + let result = + unfold (fun i -> + // i being the next position to be returned + // A lock is needed over the reads to prefix.Count since the list may be being resized + // NOTE: we could change to a reader/writer lock here + lock prefix (fun () -> + if i < prefix.Count then + Some (prefix.[i],i+1) + else + oneStepTo i if i < prefix.Count then Some (prefix.[i],i+1) else - oneStepTo i - if i < prefix.Count then - Some (prefix.[i],i+1) - else - None)) 0 - let cleanup() = - lock prefix (fun () -> - prefix.Clear() - match enumeratorR with - | Some (Some e) -> IEnumerator.dispose e - | _ -> () - enumeratorR <- None) - - (new CachedSeq<_>(cleanup, result) :> seq<_>) - - [] - let allPairs source1 source2 = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - let cached = cache source2 - source1 |> collect (fun x -> cached |> map (fun y -> x, y)) - - [] - [] - let readonly (source:seq<_>) = - checkNonNull "source" source - mkSeq (fun () -> source.GetEnumerator()) - - let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) ([] keyf:'T->'SafeKey) ([] getKey:'SafeKey->'Key) (seq:seq<'T>) = - checkNonNull "seq" seq - - let dict = Dictionary<_,ResizeArray<_>> comparer - - // Previously this was 1, but I think this is rather stingy, considering that we are already paying - // for at least a key, the ResizeArray reference, which includes an array reference, an Entry in the - // Dictionary, plus any empty space in the Dictionary of unfilled hash buckets. - let minimumBucketSize = 4 - - // Build the groupings - seq |> iter (fun v -> - let safeKey = keyf v - let mutable prev = Unchecked.defaultof<_> - match dict.TryGetValue (safeKey, &prev) with - | true -> prev.Add v - | false -> - let prev = ResizeArray () - dict.[safeKey] <- prev - prev.Add v) - - // Trim the size of each result group, don't trim very small buckets, as excessive work, and garbage for - // minimal gain - dict |> iter (fun group -> if group.Value.Count > minimumBucketSize then group.Value.TrimExcess()) - - // Return the sequence-of-sequences. Don't reveal the - // internal collections: just reveal them as sequences - dict |> map (fun group -> (getKey group.Key, readonly group.Value)) - - // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let groupByValueType (keyf:'T->'Key) (seq:seq<'T>) = seq |> groupByImpl HashIdentity.Structural<'Key> keyf id - - // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let groupByRefType (keyf:'T->'Key) (seq:seq<'T>) = seq |> groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) - - [] - let groupBy (projection:'T->'Key) (source:seq<'T>) = - if typeof<'Key>.IsValueType - then mkDelayedSeq (fun () -> groupByValueType projection source) - else mkDelayedSeq (fun () -> groupByRefType projection source) - - [] - let transpose (source: seq<#seq<'T>>) = - checkNonNull "source" source - source - |> collect indexed - |> groupBy fst - |> map (snd >> (map snd)) - - [] - let distinct source = - checkNonNull "source" source - seq { let hashSet = HashSet<'T>(HashIdentity.Structural<'T>) - for v in source do - if hashSet.Add v then - yield v } - - [] - let distinctBy projection source = - checkNonNull "source" source - seq { let hashSet = HashSet<_>(HashIdentity.Structural<_>) - for v in source do - if hashSet.Add(projection v) then - yield v } - - [] - let sortBy projection source = - checkNonNull "source" source - mkDelayedSeq (fun () -> - let array = source |> toArray - Array.stableSortInPlaceBy projection array - array :> seq<_>) - - [] - let sort source = - checkNonNull "source" source - mkDelayedSeq (fun () -> - let array = source |> toArray - Array.stableSortInPlace array - array :> seq<_>) - - [] - let sortWith comparer source = - checkNonNull "source" source - mkDelayedSeq (fun () -> - let array = source |> toArray - Array.stableSortInPlaceWith comparer array - array :> seq<_>) - - [] - let inline sortByDescending projection source = - checkNonNull "source" source - let inline compareDescending a b = compare (projection b) (projection a) - sortWith compareDescending source - - [] - let inline sortDescending source = - checkNonNull "source" source - let inline compareDescending a b = compare b a - sortWith compareDescending source - - let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] keyf:'T->'SafeKey) ([] getKey:'SafeKey->'Key) (source:seq<'T>) = - checkNonNull "source" source - - let dict = Dictionary comparer - - // Build the groupings - source |> iter (fun v -> - let safeKey = keyf v - let mutable prev = Unchecked.defaultof<_> - if dict.TryGetValue(safeKey, &prev) - then dict.[safeKey] <- prev + 1 - else dict.[safeKey] <- 1) - - dict |> map (fun group -> (getKey group.Key, group.Value)) - - // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let countByValueType (keyf:'T->'Key) (seq:seq<'T>) = seq |> countByImpl HashIdentity.Structural<'Key> keyf id - - // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let countByRefType (keyf:'T->'Key) (seq:seq<'T>) = seq |> countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) - - [] - let countBy (projection:'T->'Key) (source:seq<'T>) = - checkNonNull "source" source - - if typeof<'Key>.IsValueType - then mkDelayedSeq (fun () -> countByValueType projection source) - else mkDelayedSeq (fun () -> countByRefType projection source) - - [] - let inline sum (source: seq< ^a>) : ^a = - use e = source.GetEnumerator() - let mutable acc = LanguagePrimitives.GenericZero< ^a> - while e.MoveNext() do - acc <- Checked.(+) acc e.Current - acc + None)) 0 + let cleanup() = + lock prefix (fun () -> + prefix.Clear() + match enumeratorR with + | Some (Some e) -> IEnumerator.dispose e + | _ -> () + enumeratorR <- None) + + (new CachedSeq<_>(cleanup, result) :> seq<_>) + + [] + let allPairs source1 source2 = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + let cached = cache source2 + source1 |> collect (fun x -> cached |> map (fun y -> x, y)) + + [] + let readonly (source:seq<_>) = + checkNonNull "source" source + mkSeq (fun () -> source.GetEnumerator()) + + let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) ([] keyf:'T->'SafeKey) ([] getKey:'SafeKey->'Key) (seq:seq<'T>) = + checkNonNull "seq" seq + + let dict = Dictionary<_,ResizeArray<_>> comparer + + // Previously this was 1, but I think this is rather stingy, considering that we are already paying + // for at least a key, the ResizeArray reference, which includes an array reference, an Entry in the + // Dictionary, plus any empty space in the Dictionary of unfilled hash buckets. + let minimumBucketSize = 4 + + // Build the groupings + seq |> iter (fun v -> + let safeKey = keyf v + let mutable prev = Unchecked.defaultof<_> + match dict.TryGetValue (safeKey, &prev) with + | true -> prev.Add v + | false -> + let prev = ResizeArray () + dict.[safeKey] <- prev + prev.Add v) + + // Trim the size of each result group, don't trim very small buckets, as excessive work, and garbage for + // minimal gain + dict |> iter (fun group -> if group.Value.Count > minimumBucketSize then group.Value.TrimExcess()) + + // Return the sequence-of-sequences. Don't reveal the + // internal collections: just reveal them as sequences + dict |> map (fun group -> (getKey group.Key, readonly group.Value)) + + // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance + let groupByValueType (keyf:'T->'Key) (seq:seq<'T>) = seq |> groupByImpl HashIdentity.Structural<'Key> keyf id + + // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation + let groupByRefType (keyf:'T->'Key) (seq:seq<'T>) = seq |> groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) + + [] + let groupBy (projection:'T->'Key) (source:seq<'T>) = + if typeof<'Key>.IsValueType + then mkDelayedSeq (fun () -> groupByValueType projection source) + else mkDelayedSeq (fun () -> groupByRefType projection source) + + [] + let transpose (source: seq<#seq<'T>>) = + checkNonNull "source" source + source + |> collect indexed + |> groupBy fst + |> map (snd >> (map snd)) + + [] + let distinct source = + checkNonNull "source" source + seq { let hashSet = HashSet<'T>(HashIdentity.Structural<'T>) + for v in source do + if hashSet.Add v then + yield v } + + [] + let distinctBy projection source = + checkNonNull "source" source + seq { let hashSet = HashSet<_>(HashIdentity.Structural<_>) + for v in source do + if hashSet.Add(projection v) then + yield v } + + [] + let sortBy projection source = + checkNonNull "source" source + mkDelayedSeq (fun () -> + let array = source |> toArray + Array.stableSortInPlaceBy projection array + array :> seq<_>) - [] - let inline sumBy ([] projection : 'T -> ^U) (source: seq<'T>) : ^U = - use e = source.GetEnumerator() - let mutable acc = LanguagePrimitives.GenericZero< ^U> - while e.MoveNext() do - acc <- Checked.(+) acc (projection e.Current) - acc + [] + let sort source = + checkNonNull "source" source + mkDelayedSeq (fun () -> + let array = source |> toArray + Array.stableSortInPlace array + array :> seq<_>) - [] - let inline average (source: seq< ^a>) : ^a = - checkNonNull "source" source - use e = source.GetEnumerator() - let mutable acc = LanguagePrimitives.GenericZero< ^a> - let mutable count = 0 - while e.MoveNext() do - acc <- Checked.(+) acc e.Current - count <- count + 1 - if count = 0 then - invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - LanguagePrimitives.DivideByInt< ^a> acc count - - [] - let inline averageBy ([] projection : 'T -> ^U) (source: seq<'T>) : ^U = - checkNonNull "source" source - use e = source.GetEnumerator() - let mutable acc = LanguagePrimitives.GenericZero< ^U> - let mutable count = 0 - while e.MoveNext() do - acc <- Checked.(+) acc (projection e.Current) - count <- count + 1 - if count = 0 then - invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - LanguagePrimitives.DivideByInt< ^U> acc count - - [] - let inline min (source: seq<_>) = - checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then - invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - let mutable acc = e.Current - while e.MoveNext() do - let curr = e.Current - if curr < acc then - acc <- curr - acc - - [] - let inline minBy (projection : 'T -> 'U) (source: seq<'T>) : 'T = - checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then - invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - let first = e.Current - let mutable acc = projection first - let mutable accv = first - while e.MoveNext() do - let currv = e.Current - let curr = projection currv - if curr < acc then - acc <- curr - accv <- currv - accv - -(* - [] - let inline minValBy (f : 'T -> 'U) (source: seq<'T>) : 'U = - checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then - invalidArg "source" InputSequenceEmptyString - let first = e.Current - let mutable acc = f first - while e.MoveNext() do - let currv = e.Current - let curr = f currv - if curr < acc then - acc <- curr - acc - -*) - [] - let inline max (source: seq<_>) = - checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then - invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - let mutable acc = e.Current - while e.MoveNext() do - let curr = e.Current - if curr > acc then - acc <- curr - acc - - [] - let inline maxBy (projection : 'T -> 'U) (source: seq<'T>) : 'T = - checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then - invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - let first = e.Current - let mutable acc = projection first - let mutable accv = first - while e.MoveNext() do - let currv = e.Current - let curr = projection currv - if curr > acc then - acc <- curr - accv <- currv - accv - - -(* - [] - let inline maxValBy (f : 'T -> 'U) (source: seq<'T>) : 'U = - checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then - invalidArg "source" InputSequenceEmptyString - let first = e.Current - let mutable acc = f first - while e.MoveNext() do - let currv = e.Current - let curr = f currv - if curr > acc then - acc <- curr - acc - -*) - [] - let takeWhile predicate (source: seq<_>) = - checkNonNull "source" source - seq { use e = source.GetEnumerator() - let mutable latest = Unchecked.defaultof<_> - while e.MoveNext() && (latest <- e.Current; predicate latest) do + [] + let sortWith comparer source = + checkNonNull "source" source + mkDelayedSeq (fun () -> + let array = source |> toArray + Array.stableSortInPlaceWith comparer array + array :> seq<_>) + + [] + let inline sortByDescending projection source = + checkNonNull "source" source + let inline compareDescending a b = compare (projection b) (projection a) + sortWith compareDescending source + + [] + let inline sortDescending source = + checkNonNull "source" source + let inline compareDescending a b = compare b a + sortWith compareDescending source + + let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] keyf:'T->'SafeKey) ([] getKey:'SafeKey->'Key) (source:seq<'T>) = + checkNonNull "source" source + + let dict = Dictionary comparer + + // Build the groupings + source |> iter (fun v -> + let safeKey = keyf v + let mutable prev = Unchecked.defaultof<_> + if dict.TryGetValue(safeKey, &prev) + then dict.[safeKey] <- prev + 1 + else dict.[safeKey] <- 1) + + dict |> map (fun group -> (getKey group.Key, group.Value)) + + // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance + let countByValueType (keyf:'T->'Key) (seq:seq<'T>) = seq |> countByImpl HashIdentity.Structural<'Key> keyf id + + // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation + let countByRefType (keyf:'T->'Key) (seq:seq<'T>) = seq |> countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) + + [] + let countBy (projection:'T->'Key) (source:seq<'T>) = + checkNonNull "source" source + + if typeof<'Key>.IsValueType + then mkDelayedSeq (fun () -> countByValueType projection source) + else mkDelayedSeq (fun () -> countByRefType projection source) + + [] + let inline sum (source: seq< ^a>) : ^a = + use e = source.GetEnumerator() + let mutable acc = LanguagePrimitives.GenericZero< ^a> + while e.MoveNext() do + acc <- Checked.(+) acc e.Current + acc + + [] + let inline sumBy ([] projection : 'T -> ^U) (source: seq<'T>) : ^U = + use e = source.GetEnumerator() + let mutable acc = LanguagePrimitives.GenericZero< ^U> + while e.MoveNext() do + acc <- Checked.(+) acc (projection e.Current) + acc + + [] + let inline average (source: seq< ^a>) : ^a = + checkNonNull "source" source + use e = source.GetEnumerator() + let mutable acc = LanguagePrimitives.GenericZero< ^a> + let mutable count = 0 + while e.MoveNext() do + acc <- Checked.(+) acc e.Current + count <- count + 1 + if count = 0 then + invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + LanguagePrimitives.DivideByInt< ^a> acc count + + [] + let inline averageBy ([] projection : 'T -> ^U) (source: seq<'T>) : ^U = + checkNonNull "source" source + use e = source.GetEnumerator() + let mutable acc = LanguagePrimitives.GenericZero< ^U> + let mutable count = 0 + while e.MoveNext() do + acc <- Checked.(+) acc (projection e.Current) + count <- count + 1 + if count = 0 then + invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + LanguagePrimitives.DivideByInt< ^U> acc count + + [] + let inline min (source: seq<_>) = + checkNonNull "source" source + use e = source.GetEnumerator() + if not (e.MoveNext()) then + invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + let mutable acc = e.Current + while e.MoveNext() do + let curr = e.Current + if curr < acc then + acc <- curr + acc + + [] + let inline minBy (projection : 'T -> 'U) (source: seq<'T>) : 'T = + checkNonNull "source" source + use e = source.GetEnumerator() + if not (e.MoveNext()) then + invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + let first = e.Current + let mutable acc = projection first + let mutable accv = first + while e.MoveNext() do + let currv = e.Current + let curr = projection currv + if curr < acc then + acc <- curr + accv <- currv + accv + + [] + let inline max (source: seq<_>) = + checkNonNull "source" source + use e = source.GetEnumerator() + if not (e.MoveNext()) then + invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + let mutable acc = e.Current + while e.MoveNext() do + let curr = e.Current + if curr > acc then + acc <- curr + acc + + [] + let inline maxBy (projection : 'T -> 'U) (source: seq<'T>) : 'T = + checkNonNull "source" source + use e = source.GetEnumerator() + if not (e.MoveNext()) then + invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + let first = e.Current + let mutable acc = projection first + let mutable accv = first + while e.MoveNext() do + let currv = e.Current + let curr = projection currv + if curr > acc then + acc <- curr + accv <- currv + accv + + [] + let takeWhile predicate (source: seq<_>) = + checkNonNull "source" source + seq { use e = source.GetEnumerator() + let mutable latest = Unchecked.defaultof<_> + while e.MoveNext() && (latest <- e.Current; predicate latest) do + yield latest } + + [] + let skip count (source: seq<_>) = + checkNonNull "source" source + seq { use e = source.GetEnumerator() + for x in 1 .. count do + if not (e.MoveNext()) then + invalidOpFmt "tried to skip {0} {1} past the end of the seq" + [|SR.GetString SR.notEnoughElements; x; (if x=1 then "element" else "elements")|] + while e.MoveNext() do + yield e.Current } + + [] + let skipWhile predicate (source: seq<_>) = + checkNonNull "source" source + seq { use e = source.GetEnumerator() + let mutable latest = Unchecked.defaultof<_> + let mutable ok = false + while e.MoveNext() do + if (latest <- e.Current; (ok || not (predicate latest))) then + ok <- true yield latest } - [] - let skip count (source: seq<_>) = - checkNonNull "source" source - seq { use e = source.GetEnumerator() - for x in 1 .. count do - if not (e.MoveNext()) then - invalidOpFmt "tried to skip {0} {1} past the end of the seq" - [|SR.GetString SR.notEnoughElements; x; (if x=1 then "element" else "elements")|] - while e.MoveNext() do - yield e.Current } - - [] - let skipWhile predicate (source: seq<_>) = - checkNonNull "source" source - seq { use e = source.GetEnumerator() - let mutable latest = Unchecked.defaultof<_> - let mutable ok = false - while e.MoveNext() do - if (latest <- e.Current; (ok || not (predicate latest))) then - ok <- true - yield latest } - - [] - let forall2 predicate (source1: seq<_>) (source2: seq<_>) = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - use e1 = source1.GetEnumerator() - use e2 = source2.GetEnumerator() - let p = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate - let mutable ok = true - while (ok && e1.MoveNext() && e2.MoveNext()) do - ok <- p.Invoke(e1.Current, e2.Current) - ok - - [] - let exists2 predicate (source1: seq<_>) (source2: seq<_>) = - checkNonNull "source1" source1 - checkNonNull "source2" source2 - use e1 = source1.GetEnumerator() - use e2 = source2.GetEnumerator() - let p = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate - let mutable ok = false - while (not ok && e1.MoveNext() && e2.MoveNext()) do - ok <- p.Invoke(e1.Current, e2.Current) - ok - - [] - let head (source : seq<_>) = - checkNonNull "source" source - use e = source.GetEnumerator() - if (e.MoveNext()) then e.Current - else invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - - [] - let tryHead (source : seq<_>) = - checkNonNull "source" source - use e = source.GetEnumerator() - if (e.MoveNext()) then Some e.Current - else None - - [] - let tail (source: seq<'T>) = - checkNonNull "source" source - seq { use e = source.GetEnumerator() - if not (e.MoveNext()) then - invalidArg "source" (SR.GetString(SR.notEnoughElements)) - while e.MoveNext() do - yield e.Current } - - [] - let last (source : seq<_>) = - checkNonNull "source" source - match Microsoft.FSharp.Primitives.Basics.Seq.tryLastV source with - | ValueSome x -> x - | ValueNone -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + [] + let forall2 predicate (source1: seq<_>) (source2: seq<_>) = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + use e1 = source1.GetEnumerator() + use e2 = source2.GetEnumerator() + let p = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate + let mutable ok = true + while (ok && e1.MoveNext() && e2.MoveNext()) do + ok <- p.Invoke(e1.Current, e2.Current) + ok + + [] + let exists2 predicate (source1: seq<_>) (source2: seq<_>) = + checkNonNull "source1" source1 + checkNonNull "source2" source2 + use e1 = source1.GetEnumerator() + use e2 = source2.GetEnumerator() + let p = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate + let mutable ok = false + while (not ok && e1.MoveNext() && e2.MoveNext()) do + ok <- p.Invoke(e1.Current, e2.Current) + ok + + [] + let head (source : seq<_>) = + checkNonNull "source" source + use e = source.GetEnumerator() + if (e.MoveNext()) then e.Current + else invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + + [] + let tryHead (source : seq<_>) = + checkNonNull "source" source + use e = source.GetEnumerator() + if (e.MoveNext()) then Some e.Current + else None + + [] + let tail (source: seq<'T>) = + checkNonNull "source" source + seq { use e = source.GetEnumerator() + if not (e.MoveNext()) then + invalidArg "source" (SR.GetString(SR.notEnoughElements)) + while e.MoveNext() do + yield e.Current } + + [] + let last (source : seq<_>) = + checkNonNull "source" source + match Microsoft.FSharp.Primitives.Basics.Seq.tryLastV source with + | ValueSome x -> x + | ValueNone -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + + [] + let tryLast (source : seq<_>) = + checkNonNull "source" source + match Microsoft.FSharp.Primitives.Basics.Seq.tryLastV source with + | ValueSome x -> Some x + | ValueNone -> None - [] - let tryLast (source : seq<_>) = - checkNonNull "source" source - match Microsoft.FSharp.Primitives.Basics.Seq.tryLastV source with - | ValueSome x -> Some x - | ValueNone -> None - - [] - let exactlyOne (source : seq<_>) = - checkNonNull "source" source - use e = source.GetEnumerator() + [] + let exactlyOne (source : seq<_>) = + checkNonNull "source" source + use e = source.GetEnumerator() + if e.MoveNext() then + let v = e.Current if e.MoveNext() then - let v = e.Current - if e.MoveNext() then - invalidArg "source" (SR.GetString(SR.inputSequenceTooLong)) - else - v + invalidArg "source" (SR.GetString(SR.inputSequenceTooLong)) else - invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - - [] - let tryExactlyOne (source : seq<_>) = - checkNonNull "source" source - use e = source.GetEnumerator() + v + else + invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + + [] + let tryExactlyOne (source : seq<_>) = + checkNonNull "source" source + use e = source.GetEnumerator() + if e.MoveNext() then + let v = e.Current if e.MoveNext() then - let v = e.Current - if e.MoveNext() then - None - else - Some v - else None - - [] - let rev source = - checkNonNull "source" source - mkDelayedSeq (fun () -> - let array = source |> toArray - Array.Reverse array - array :> seq<_>) - - [] - let permute indexMap (source : seq<_>) = - checkNonNull "source" source - mkDelayedSeq (fun () -> - source |> toArray |> Array.permute indexMap :> seq<_>) - - [] - let mapFold<'T,'State,'Result> (mapping: 'State -> 'T -> 'Result * 'State) state source = - checkNonNull "source" source - let arr,state = source |> toArray |> Array.mapFold mapping state - readonly arr, state - - [] - let mapFoldBack<'T,'State,'Result> (mapping: 'T -> 'State -> 'Result * 'State) source state = - checkNonNull "source" source + else + Some v + else + None + + [] + let rev source = + checkNonNull "source" source + mkDelayedSeq (fun () -> let array = source |> toArray - let arr,state = Array.mapFoldBack mapping array state - readonly arr, state - - [] - let except (itemsToExclude: seq<'T>) (source: seq<'T>) = - checkNonNull "itemsToExclude" itemsToExclude - checkNonNull "source" source - - seq { - use e = source.GetEnumerator() - if e.MoveNext() then - let cached = HashSet(itemsToExclude, HashIdentity.Structural) + Array.Reverse array + array :> seq<_>) + + [] + let permute indexMap (source : seq<_>) = + checkNonNull "source" source + mkDelayedSeq (fun () -> + source |> toArray |> Array.permute indexMap :> seq<_>) + + [] + let mapFold<'T,'State,'Result> (mapping: 'State -> 'T -> 'Result * 'State) state source = + checkNonNull "source" source + let arr,state = source |> toArray |> Array.mapFold mapping state + readonly arr, state + + [] + let mapFoldBack<'T,'State,'Result> (mapping: 'T -> 'State -> 'Result * 'State) source state = + checkNonNull "source" source + let array = source |> toArray + let arr,state = Array.mapFoldBack mapping array state + readonly arr, state + + [] + let except (itemsToExclude: seq<'T>) (source: seq<'T>) = + checkNonNull "itemsToExclude" itemsToExclude + checkNonNull "source" source + + seq { + use e = source.GetEnumerator() + if e.MoveNext() then + let cached = HashSet(itemsToExclude, HashIdentity.Structural) + let next = e.Current + if cached.Add next then yield next + while e.MoveNext() do let next = e.Current - if cached.Add next then yield next - while e.MoveNext() do - let next = e.Current - if cached.Add next then yield next } - - [] - let chunkBySize chunkSize (source : seq<_>) = - checkNonNull "source" source - if chunkSize <= 0 then invalidArgFmt "chunkSize" "{0}\nchunkSize = {1}" - [|SR.GetString SR.inputMustBePositive; chunkSize|] - seq { use e = source.GetEnumerator() - let nextChunk() = - let res = Array.zeroCreateUnchecked chunkSize - res.[0] <- e.Current - let mutable i = 1 - while i < chunkSize && e.MoveNext() do - res.[i] <- e.Current - i <- i + 1 - if i = chunkSize then - res - else - res |> Array.subUnchecked 0 i - while e.MoveNext() do - yield nextChunk() } - - [] - let splitInto count source = - checkNonNull "source" source - if count <= 0 then invalidArgFmt "count" "{0}\ncount = {1}" - [|SR.GetString SR.inputMustBePositive; count|] - mkDelayedSeq (fun () -> - source |> toArray |> Array.splitInto count :> seq<_>) - - [] - let removeAt (index: int) (source: seq<'T>) : seq<'T> = - if index < 0 then invalidArg "index" "index must be within bounds of the array" - seq { - let mutable i = 0 - for item in source do - if i <> index then - yield item - i <- i + 1 - if i <= index then invalidArg "index" "index must be within bounds of the array" - } - - [] - let removeManyAt (index: int) (count: int) (source: seq<'T>) : seq<'T> = - if index < 0 then invalidArg "index" "index must be within bounds of the array" - seq { - let mutable i = 0 - for item in source do - if i < index || i >= index + count then - yield item - i <- i + 1 - if i <= index then invalidArg "index" "index must be within bounds of the array" - } - - [] - let updateAt (index: int) (value: 'T) (source: seq<'T>) : seq<'T> = - if index < 0 then invalidArg "index" "index must be within bounds of the array" - seq { - let mutable i = 0 - for item in source do - if i <> index then - yield item - else yield value - i <- i + 1 - if i <= index then invalidArg "index" "index must be within bounds of the array" - } - - [] - let insertAt (index: int) (value: 'T) (source: seq<'T>) : seq<'T> = - if index < 0 then invalidArg "index" "index must be within bounds of the array" - seq { - let mutable i = 0 - for item in source do - if i = index then - yield value + if cached.Add next then yield next } + + [] + let chunkBySize chunkSize (source : seq<_>) = + checkNonNull "source" source + if chunkSize <= 0 then invalidArgFmt "chunkSize" "{0}\nchunkSize = {1}" + [|SR.GetString SR.inputMustBePositive; chunkSize|] + seq { use e = source.GetEnumerator() + let nextChunk() = + let res = Array.zeroCreateUnchecked chunkSize + res.[0] <- e.Current + let mutable i = 1 + while i < chunkSize && e.MoveNext() do + res.[i] <- e.Current + i <- i + 1 + if i = chunkSize then + res + else + res |> Array.subUnchecked 0 i + while e.MoveNext() do + yield nextChunk() } + + [] + let splitInto count source = + checkNonNull "source" source + if count <= 0 then invalidArgFmt "count" "{0}\ncount = {1}" + [|SR.GetString SR.inputMustBePositive; count|] + mkDelayedSeq (fun () -> + source |> toArray |> Array.splitInto count :> seq<_>) + + [] + let removeAt (index: int) (source: seq<'T>) : seq<'T> = + if index < 0 then invalidArg "index" "index must be within bounds of the array" + seq { + let mutable i = 0 + for item in source do + if i <> index then yield item - i <- i + 1 - if i = index then yield value - if i < index then invalidArg "index" "index must be within bounds of the array" - } - - [] - let insertManyAt (index: int) (values: seq<'T>) (source: seq<'T>) : seq<'T> = - if index < 0 then invalidArg "index" "index must be within bounds of the array" - seq { - let mutable i = 0 - for item in source do - if i = index then yield! values - yield item - i <- i + 1 - if i = index then yield! values // support inserting at the end - if i < index then invalidArg "index" "index must be within bounds of the array" - } \ No newline at end of file + i <- i + 1 + if i <= index then invalidArg "index" "index must be within bounds of the array" + } + + [] + let removeManyAt (index: int) (count: int) (source: seq<'T>) : seq<'T> = + if index < 0 then invalidArg "index" "index must be within bounds of the array" + seq { + let mutable i = 0 + for item in source do + if i < index || i >= index + count then + yield item + i <- i + 1 + if i <= index then invalidArg "index" "index must be within bounds of the array" + } + + [] + let updateAt (index: int) (value: 'T) (source: seq<'T>) : seq<'T> = + if index < 0 then invalidArg "index" "index must be within bounds of the array" + seq { + let mutable i = 0 + for item in source do + if i <> index then + yield item + else yield value + i <- i + 1 + if i <= index then invalidArg "index" "index must be within bounds of the array" + } + + [] + let insertAt (index: int) (value: 'T) (source: seq<'T>) : seq<'T> = + if index < 0 then invalidArg "index" "index must be within bounds of the array" + seq { + let mutable i = 0 + for item in source do + if i = index then + yield value + yield item + i <- i + 1 + if i = index then yield value + if i < index then invalidArg "index" "index must be within bounds of the array" + } + + [] + let insertManyAt (index: int) (values: seq<'T>) (source: seq<'T>) : seq<'T> = + if index < 0 then invalidArg "index" "index must be within bounds of the array" + seq { + let mutable i = 0 + for item in source do + if i = index then yield! values + yield item + i <- i + 1 + if i = index then yield! values // support inserting at the end + if i < index then invalidArg "index" "index must be within bounds of the array" + } \ No newline at end of file diff --git a/src/FSharp.Core/seqcore.fs b/src/FSharp.Core/seqcore.fs index b7e45a0ec1e..6a2e81061cc 100644 --- a/src/FSharp.Core/seqcore.fs +++ b/src/FSharp.Core/seqcore.fs @@ -1,467 +1,546 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. namespace Microsoft.FSharp.Collections - #nowarn "52" // The value has been copied to ensure the original is not mutated by this operation - - open System - open System.Diagnostics - open System.Collections - open System.Collections.Generic - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Control - open Microsoft.FSharp.Collections - - module internal IEnumerator = - - let noReset() = raise (new System.NotSupportedException(SR.GetString(SR.resetNotSupported))) - let notStarted() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationNotStarted))) - let alreadyFinished() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))) - let check started = if not started then notStarted() - let dispose (r : System.IDisposable) = r.Dispose() - - let cast (e : IEnumerator) : IEnumerator<'T> = - { new IEnumerator<'T> with - member _.Current = unbox<'T> e.Current - - interface IEnumerator with - member _.Current = unbox<'T> e.Current :> obj - member _.MoveNext() = e.MoveNext() - member _.Reset() = noReset() - - interface System.IDisposable with - member _.Dispose() = - match e with - | :? System.IDisposable as e -> e.Dispose() - | _ -> () } - - /// A concrete implementation of an enumerator that returns no values - [] - type EmptyEnumerator<'T>() = - let mutable started = false - interface IEnumerator<'T> with - member _.Current = - check started - (alreadyFinished() : 'T) - - interface System.Collections.IEnumerator with - member _.Current = - check started - (alreadyFinished() : obj) - - member _.MoveNext() = - if not started then started <- true - false - - member _.Reset() = noReset() - - interface System.IDisposable with - member _.Dispose() = () - - let Empty<'T> () = (new EmptyEnumerator<'T>() :> IEnumerator<'T>) - - [] - type EmptyEnumerable<'T> = - - | EmptyEnumerable - - interface IEnumerable<'T> with - member _.GetEnumerator() = Empty<'T>() - - interface IEnumerable with - member _.GetEnumerator() = (Empty<'T>() :> IEnumerator) - - type GeneratedEnumerable<'T, 'State>(openf: unit -> 'State, compute: 'State -> 'T option, closef: 'State -> unit) = - let mutable started = false - let mutable curr = None - let state = ref (Some (openf ())) - let getCurr() : 'T = + +#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation + +open System +open System.Diagnostics +open System.Collections +open System.Collections.Generic +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Control +open Microsoft.FSharp.Collections + +module internal IEnumerator = + + let noReset() = raise (new System.NotSupportedException(SR.GetString(SR.resetNotSupported))) + let notStarted() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationNotStarted))) + let alreadyFinished() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))) + let check started = if not started then notStarted() + let dispose (r : System.IDisposable) = r.Dispose() + + let cast (e : IEnumerator) : IEnumerator<'T> = + { new IEnumerator<'T> with + member _.Current = unbox<'T> e.Current + + interface IEnumerator with + member _.Current = unbox<'T> e.Current :> obj + member _.MoveNext() = e.MoveNext() + member _.Reset() = noReset() + + interface System.IDisposable with + member _.Dispose() = + match e with + | :? System.IDisposable as e -> e.Dispose() + | _ -> () } + + /// A concrete implementation of an enumerator that returns no values + [] + type EmptyEnumerator<'T>() = + let mutable started = false + interface IEnumerator<'T> with + member _.Current = + check started + (alreadyFinished() : 'T) + + interface System.Collections.IEnumerator with + member _.Current = check started - match curr with - | None -> alreadyFinished() - | Some x -> x - - let readAndClear () = - lock state (fun () -> - match state.Value with - | None -> None - | Some _ as res -> - state.Value <- None - res) - - let start() = - if not started then - started <- true - - let dispose() = - readAndClear() |> Option.iter closef - - let finish() = - try dispose() - finally curr <- None - - interface IEnumerator<'T> with - member _.Current = getCurr() - - interface IEnumerator with - member _.Current = box (getCurr()) - member _.MoveNext() = - start() - match state.Value with - | None -> false // we started, then reached the end, then got another MoveNext - | Some s -> - match (try compute s with e -> finish(); reraise()) with - | None -> finish(); false - | Some _ as x -> - curr <- x - true - - member _.Reset() = noReset() - - interface System.IDisposable with - member _.Dispose() = dispose() - - [] - type Singleton<'T>(v:'T) = - let mutable started = false - - interface IEnumerator<'T> with - member _.Current = v - - interface IEnumerator with - member _.Current = box v - member _.MoveNext() = if started then false else (started <- true; true) - member _.Reset() = noReset() - - interface System.IDisposable with - member _.Dispose() = () - - let Singleton x = (new Singleton<'T>(x) :> IEnumerator<'T>) - - let EnumerateThenFinally f (e : IEnumerator<'T>) = - { new IEnumerator<'T> with - member _.Current = e.Current - - interface IEnumerator with - member _.Current = (e :> IEnumerator).Current - member _.MoveNext() = e.MoveNext() - member _.Reset() = noReset() - - interface System.IDisposable with - member _.Dispose() = - try - e.Dispose() - finally - f() - } - - let inline checkNonNull argName arg = - if isNull arg then - nullArg argName - - let mkSeq f = - { new IEnumerable<'U> with - member _.GetEnumerator() = f() - - interface IEnumerable with - member _.GetEnumerator() = (f() :> IEnumerator) } + (alreadyFinished() : obj) + + member _.MoveNext() = + if not started then started <- true + false + + member _.Reset() = noReset() + + interface System.IDisposable with + member _.Dispose() = () + + let Empty<'T> () = (new EmptyEnumerator<'T>() :> IEnumerator<'T>) + + [] + type EmptyEnumerable<'T> = + + | EmptyEnumerable + + interface IEnumerable<'T> with + member _.GetEnumerator() = Empty<'T>() + + interface IEnumerable with + member _.GetEnumerator() = (Empty<'T>() :> IEnumerator) + + type GeneratedEnumerable<'T, 'State>(openf: unit -> 'State, compute: 'State -> 'T option, closef: 'State -> unit) = + let mutable started = false + let mutable curr = None + let state = ref (Some (openf ())) + let getCurr() : 'T = + check started + match curr with + | None -> alreadyFinished() + | Some x -> x + + let readAndClear () = + lock state (fun () -> + match state.Value with + | None -> None + | Some _ as res -> + state.Value <- None + res) + + let start() = + if not started then + started <- true + + let dispose() = + readAndClear() |> Option.iter closef + + let finish() = + try dispose() + finally curr <- None + + interface IEnumerator<'T> with + member _.Current = getCurr() + + interface IEnumerator with + member _.Current = box (getCurr()) + member _.MoveNext() = + start() + match state.Value with + | None -> false // we started, then reached the end, then got another MoveNext + | Some s -> + match (try compute s with e -> finish(); reraise()) with + | None -> finish(); false + | Some _ as x -> + curr <- x + true + + member _.Reset() = noReset() + + interface System.IDisposable with + member _.Dispose() = dispose() + + [] + type Singleton<'T>(v:'T) = + let mutable started = false + + interface IEnumerator<'T> with + member _.Current = v + + interface IEnumerator with + member _.Current = box v + member _.MoveNext() = if started then false else (started <- true; true) + member _.Reset() = noReset() + + interface System.IDisposable with + member _.Dispose() = () + + let Singleton x = (new Singleton<'T>(x) :> IEnumerator<'T>) + + let EnumerateThenFinally f (e : IEnumerator<'T>) = + { new IEnumerator<'T> with + member _.Current = e.Current + + interface IEnumerator with + member _.Current = (e :> IEnumerator).Current + member _.MoveNext() = e.MoveNext() + member _.Reset() = noReset() + + interface System.IDisposable with + member _.Dispose() = + try + e.Dispose() + finally + f() + } + + let inline checkNonNull argName arg = + if isNull arg then + nullArg argName + + let mkSeq f = + { new IEnumerable<'U> with + member _.GetEnumerator() = f() + + interface IEnumerable with + member _.GetEnumerator() = (f() :> IEnumerator) } namespace Microsoft.FSharp.Core.CompilerServices - open System - open System.Diagnostics - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Control - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Collections.IEnumerator - open Microsoft.FSharp.Primitives.Basics - open System.Collections - open System.Collections.Generic - open System.Runtime.CompilerServices - - module RuntimeHelpers = - - [] - type internal StructBox<'T when 'T:equality>(value:'T) = - member x.Value = value - static member Comparer = - let gcomparer = HashIdentity.Structural<'T> - { new IEqualityComparer> with - member _.GetHashCode(v) = gcomparer.GetHashCode(v.Value) - member _.Equals(v1,v2) = gcomparer.Equals(v1.Value,v2.Value) } - - let Generate openf compute closef = - mkSeq (fun () -> new IEnumerator.GeneratedEnumerable<_,_>(openf, compute, closef) :> IEnumerator<'T>) - - let GenerateUsing (openf : unit -> ('U :> System.IDisposable)) compute = - Generate openf compute (fun (s:'U) -> s.Dispose()) - - let EnumerateFromFunctions create moveNext current = - Generate - create - (fun x -> if moveNext x then Some(current x) else None) - (fun x -> match box(x) with :? System.IDisposable as id -> id.Dispose() | _ -> ()) - - // A family of enumerators that can have additional 'finally' actions added to the enumerator through - // the use of mutation. This is used to 'push' the disposal action for a 'use' into the next enumerator. - // For example, - // seq { use x = ... - // while ... } - // results in the 'while' loop giving an adjustable enumerator. This is then adjusted by adding the disposal action - // from the 'use' into the enumerator. This means that we avoid constructing a two-deep enumerator chain in this - // common case. - type IFinallyEnumerator = - abstract AppendFinallyAction : (unit -> unit) -> unit - - /// A concrete implementation of IEnumerable that adds the given compensation to the "Dispose" chain of any - /// enumerators returned by the enumerable. - [] - type FinallyEnumerable<'T>(compensation: unit -> unit, restf: unit -> seq<'T>) = - interface IEnumerable<'T> with - member _.GetEnumerator() = +open System +open System.Diagnostics +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Control +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Collections.IEnumerator +open Microsoft.FSharp.Primitives.Basics +open System.Collections +open System.Collections.Generic +open System.Runtime.CompilerServices + +module RuntimeHelpers = + + [] + type internal StructBox<'T when 'T:equality>(value:'T) = + member x.Value = value + static member Comparer = + let gcomparer = HashIdentity.Structural<'T> + { new IEqualityComparer> with + member _.GetHashCode(v) = gcomparer.GetHashCode(v.Value) + member _.Equals(v1,v2) = gcomparer.Equals(v1.Value,v2.Value) } + + let Generate openf compute closef = + mkSeq (fun () -> new IEnumerator.GeneratedEnumerable<_,_>(openf, compute, closef) :> IEnumerator<'T>) + + let GenerateUsing (openf : unit -> ('U :> System.IDisposable)) compute = + Generate openf compute (fun (s:'U) -> s.Dispose()) + + let EnumerateFromFunctions create moveNext current = + Generate + create + (fun x -> if moveNext x then Some(current x) else None) + (fun x -> match box(x) with :? System.IDisposable as id -> id.Dispose() | _ -> ()) + + // A family of enumerators that can have additional 'finally' actions added to the enumerator through + // the use of mutation. This is used to 'push' the disposal action for a 'use' into the next enumerator. + // For example, + // seq { use x = ... + // while ... } + // results in the 'while' loop giving an adjustable enumerator. This is then adjusted by adding the disposal action + // from the 'use' into the enumerator. This means that we avoid constructing a two-deep enumerator chain in this + // common case. + type IFinallyEnumerator = + abstract AppendFinallyAction : (unit -> unit) -> unit + + /// A concrete implementation of IEnumerable that adds the given compensation to the "Dispose" chain of any + /// enumerators returned by the enumerable. + [] + type FinallyEnumerable<'T>(compensation: unit -> unit, restf: unit -> seq<'T>) = + interface IEnumerable<'T> with + member _.GetEnumerator() = + try + let ie = restf().GetEnumerator() + match ie with + | :? IFinallyEnumerator as a -> + a.AppendFinallyAction(compensation) + ie + | _ -> + IEnumerator.EnumerateThenFinally compensation ie + with e -> + compensation() + reraise() + interface IEnumerable with + member x.GetEnumerator() = ((x :> IEnumerable<'T>).GetEnumerator() :> IEnumerator) + + /// An optimized object for concatenating a sequence of enumerables + [] + type ConcatEnumerator<'T,'U when 'U :> seq<'T>>(sources: seq<'U>) = + let mutable outerEnum = sources.GetEnumerator() + let mutable currInnerEnum = IEnumerator.Empty() + + let mutable started = false + let mutable finished = false + let mutable compensations = [] + + [] // false = unchecked + val mutable private currElement : 'T + + member _.Finish() = + finished <- true + try + match currInnerEnum with + | null -> () + | _ -> try - let ie = restf().GetEnumerator() - match ie with - | :? IFinallyEnumerator as a -> - a.AppendFinallyAction(compensation) - ie - | _ -> - IEnumerator.EnumerateThenFinally compensation ie - with e -> - compensation() - reraise() - interface IEnumerable with - member x.GetEnumerator() = ((x :> IEnumerable<'T>).GetEnumerator() :> IEnumerator) - - /// An optimized object for concatenating a sequence of enumerables - [] - type ConcatEnumerator<'T,'U when 'U :> seq<'T>>(sources: seq<'U>) = - let mutable outerEnum = sources.GetEnumerator() - let mutable currInnerEnum = IEnumerator.Empty() - - let mutable started = false - let mutable finished = false - let mutable compensations = [] - - [] // false = unchecked - val mutable private currElement : 'T - - member _.Finish() = - finished <- true + currInnerEnum.Dispose() + finally + currInnerEnum <- null + finally try - match currInnerEnum with + match outerEnum with | null -> () | _ -> try - currInnerEnum.Dispose() + outerEnum.Dispose() finally - currInnerEnum <- null + outerEnum <- null finally + let rec iter comps = + match comps with + | [] -> () + | h :: t -> + try h() finally iter t try - match outerEnum with - | null -> () - | _ -> - try - outerEnum.Dispose() - finally - outerEnum <- null + compensations |> List.rev |> iter finally - let rec iter comps = - match comps with - | [] -> () - | h :: t -> - try h() finally iter t - try - compensations |> List.rev |> iter - finally - compensations <- [] - - member x.GetCurrent() = - IEnumerator.check started - if finished then IEnumerator.alreadyFinished() else x.currElement - - interface IFinallyEnumerator with - member _.AppendFinallyAction(f) = - compensations <- f :: compensations - - interface IEnumerator<'T> with - member x.Current = x.GetCurrent() - - interface IEnumerator with - member x.Current = box (x.GetCurrent()) - - member x.MoveNext() = - if not started then started <- true - if finished then false - else - let rec takeInner () = - // check the inner list - if currInnerEnum.MoveNext() then - x.currElement <- currInnerEnum.Current - true - else - // check the outer list - let rec takeOuter() = - if outerEnum.MoveNext() then - let ie = outerEnum.Current - // Optimization to detect the statically-allocated empty IEnumerables - match box ie with - | :? EmptyEnumerable<'T> -> - // This one is empty, just skip, don't call GetEnumerator, try again - takeOuter() - | _ -> - // OK, this one may not be empty. - // Don't forget to dispose of the enumerator for the inner list now we're done with it - currInnerEnum.Dispose() - currInnerEnum <- ie.GetEnumerator() - takeInner () - else - // We're done - x.Finish() - false - takeOuter() - takeInner () - - member _.Reset() = IEnumerator.noReset() - - interface System.IDisposable with - member x.Dispose() = - if not finished then - x.Finish() - - let EnumerateUsing (resource : 'T :> System.IDisposable) (source: 'T -> #seq<'U>) = - (FinallyEnumerable((fun () -> match box resource with null -> () | _ -> resource.Dispose()), - (fun () -> source resource :> seq<_>)) :> seq<_>) - - let mkConcatSeq (sources: seq<'U :> seq<'T>>) = - mkSeq (fun () -> new ConcatEnumerator<_,_>(sources) :> IEnumerator<'T>) - - let EnumerateWhile (guard: unit -> bool) (source: seq<'T>) : seq<'T> = - let mutable started = false - let mutable curr = None - let getCurr() = - IEnumerator.check started - match curr with None -> IEnumerator.alreadyFinished() | Some x -> x - let start() = if not started then (started <- true) - - let finish() = (curr <- None) - mkConcatSeq - (mkSeq (fun () -> - { new IEnumerator<_> with - member x.Current = getCurr() - interface IEnumerator with - member x.Current = box (getCurr()) - member x.MoveNext() = - start() - let keepGoing = (try guard() with e -> finish (); reraise ()) in - if keepGoing then - curr <- Some(source); true - else - finish(); false - member x.Reset() = IEnumerator.noReset() - interface System.IDisposable with - member x.Dispose() = () })) - - let EnumerateThenFinally (source: seq<'T>) (compensation: unit -> unit) = - (FinallyEnumerable(compensation, (fun () -> source)) :> seq<_>) - - let CreateEvent (addHandler : 'Delegate -> unit) (removeHandler : 'Delegate -> unit) (createHandler : (obj -> 'Args -> unit) -> 'Delegate ) :IEvent<'Delegate,'Args> = - { new obj() with - member x.ToString() = "" - interface IEvent<'Delegate,'Args> with - member x.AddHandler(h) = addHandler h - member x.RemoveHandler(h) = removeHandler h - interface System.IObservable<'Args> with - member x.Subscribe(r:IObserver<'Args>) = - let h = createHandler (fun _ args -> r.OnNext(args)) - addHandler h - { new System.IDisposable with - member x.Dispose() = removeHandler h } } - - let inline SetFreshConsTail cons tail = cons.( :: ).1 <- tail - - let inline FreshConsNoTail head = head :: (# "ldnull" : 'T list #) - - [] - type GeneratedSequenceBase<'T>() = - let mutable redirectTo : GeneratedSequenceBase<'T> = Unchecked.defaultof<_> - let mutable redirect : bool = false - - abstract GetFreshEnumerator : unit -> IEnumerator<'T> - abstract GenerateNext : result:byref> -> int // 0 = Stop, 1 = Yield, 2 = Goto - abstract Close: unit -> unit - abstract CheckClose: bool - abstract LastGenerated : 'T + compensations <- [] - //[] - member x.MoveNextImpl() = - let active = - if redirect then redirectTo - else x - let mutable target = null - match active.GenerateNext(&target) with - | 1 -> - true - | 2 -> - match target.GetEnumerator() with - | :? GeneratedSequenceBase<'T> as g when not active.CheckClose -> - redirectTo <- g - | e -> - redirectTo <- - { new GeneratedSequenceBase<'T>() with - member x.GetFreshEnumerator() = e - member x.GenerateNext(_) = if e.MoveNext() then 1 else 0 - member x.Close() = try e.Dispose() finally active.Close() - member x.CheckClose = true - member x.LastGenerated = e.Current } - redirect <- true - x.MoveNextImpl() - | _ (* 0 *) -> - false - - interface IEnumerable<'T> with - member x.GetEnumerator() = x.GetFreshEnumerator() + member x.GetCurrent() = + IEnumerator.check started + if finished then IEnumerator.alreadyFinished() else x.currElement - interface IEnumerable with - member x.GetEnumerator() = (x.GetFreshEnumerator() :> IEnumerator) + interface IFinallyEnumerator with + member _.AppendFinallyAction(f) = + compensations <- f :: compensations interface IEnumerator<'T> with - member x.Current = if redirect then redirectTo.LastGenerated else x.LastGenerated - - interface IDisposable with - member x.Dispose() = if redirect then redirectTo.Close() else x.Close() + member x.Current = x.GetCurrent() interface IEnumerator with - member x.Current = box (if redirect then redirectTo.LastGenerated else x.LastGenerated) - - //[] - member x.MoveNext() = x.MoveNextImpl() - - member _.Reset() = raise <| new System.NotSupportedException() + member x.Current = box (x.GetCurrent()) + + member x.MoveNext() = + if not started then started <- true + if finished then false + else + let rec takeInner () = + // check the inner list + if currInnerEnum.MoveNext() then + x.currElement <- currInnerEnum.Current + true + else + // check the outer list + let rec takeOuter() = + if outerEnum.MoveNext() then + let ie = outerEnum.Current + // Optimization to detect the statically-allocated empty IEnumerables + match box ie with + | :? EmptyEnumerable<'T> -> + // This one is empty, just skip, don't call GetEnumerator, try again + takeOuter() + | _ -> + // OK, this one may not be empty. + // Don't forget to dispose of the enumerator for the inner list now we're done with it + currInnerEnum.Dispose() + currInnerEnum <- ie.GetEnumerator() + takeInner () + else + // We're done + x.Finish() + false + takeOuter() + takeInner () + + member _.Reset() = IEnumerator.noReset() + + interface System.IDisposable with + member x.Dispose() = + if not finished then + x.Finish() + + let EnumerateUsing (resource : 'T :> System.IDisposable) (source: 'T -> #seq<'U>) = + (FinallyEnumerable((fun () -> match box resource with null -> () | _ -> resource.Dispose()), + (fun () -> source resource :> seq<_>)) :> seq<_>) + + let mkConcatSeq (sources: seq<'U :> seq<'T>>) = + mkSeq (fun () -> new ConcatEnumerator<_,_>(sources) :> IEnumerator<'T>) + + let EnumerateWhile (guard: unit -> bool) (source: seq<'T>) : seq<'T> = + let mutable started = false + let mutable curr = None + let getCurr() = + IEnumerator.check started + match curr with None -> IEnumerator.alreadyFinished() | Some x -> x + let start() = if not started then (started <- true) + + let finish() = (curr <- None) + mkConcatSeq + (mkSeq (fun () -> + { new IEnumerator<_> with + member x.Current = getCurr() + interface IEnumerator with + member x.Current = box (getCurr()) + member x.MoveNext() = + start() + let keepGoing = (try guard() with e -> finish (); reraise ()) in + if keepGoing then + curr <- Some(source); true + else + finish(); false + member x.Reset() = IEnumerator.noReset() + interface System.IDisposable with + member x.Dispose() = () })) + + let EnumerateThenFinally (source: seq<'T>) (compensation: unit -> unit) = + (FinallyEnumerable(compensation, (fun () -> source)) :> seq<_>) + + let CreateEvent (addHandler : 'Delegate -> unit) (removeHandler : 'Delegate -> unit) (createHandler : (obj -> 'Args -> unit) -> 'Delegate ) :IEvent<'Delegate,'Args> = + { new obj() with + member x.ToString() = "" + interface IEvent<'Delegate,'Args> with + member x.AddHandler(h) = addHandler h + member x.RemoveHandler(h) = removeHandler h + interface System.IObservable<'Args> with + member x.Subscribe(r:IObserver<'Args>) = + let h = createHandler (fun _ args -> r.OnNext(args)) + addHandler h + { new System.IDisposable with + member x.Dispose() = removeHandler h } } + + let inline SetFreshConsTail cons tail = cons.( :: ).1 <- tail + + let inline FreshConsNoTail head = head :: (# "ldnull" : 'T list #) + +[] +type GeneratedSequenceBase<'T>() = + let mutable redirectTo : GeneratedSequenceBase<'T> = Unchecked.defaultof<_> + let mutable redirect : bool = false + + abstract GetFreshEnumerator : unit -> IEnumerator<'T> + abstract GenerateNext : result:byref> -> int // 0 = Stop, 1 = Yield, 2 = Goto + abstract Close: unit -> unit + abstract CheckClose: bool + abstract LastGenerated : 'T + + //[] + member x.MoveNextImpl() = + let active = + if redirect then redirectTo + else x + let mutable target = null + match active.GenerateNext(&target) with + | 1 -> + true + | 2 -> + match target.GetEnumerator() with + | :? GeneratedSequenceBase<'T> as g when not active.CheckClose -> + redirectTo <- g + | e -> + redirectTo <- + { new GeneratedSequenceBase<'T>() with + member x.GetFreshEnumerator() = e + member x.GenerateNext(_) = if e.MoveNext() then 1 else 0 + member x.Close() = try e.Dispose() finally active.Close() + member x.CheckClose = true + member x.LastGenerated = e.Current } + redirect <- true + x.MoveNextImpl() + | _ (* 0 *) -> + false + + interface IEnumerable<'T> with + member x.GetEnumerator() = x.GetFreshEnumerator() + + interface IEnumerable with + member x.GetEnumerator() = (x.GetFreshEnumerator() :> IEnumerator) + + interface IEnumerator<'T> with + member x.Current = if redirect then redirectTo.LastGenerated else x.LastGenerated + + interface IDisposable with + member x.Dispose() = if redirect then redirectTo.Close() else x.Close() + + interface IEnumerator with + member x.Current = box (if redirect then redirectTo.LastGenerated else x.LastGenerated) - [] - type ListCollector<'T> = - [] - val mutable Result : 'T list - - [] - val mutable LastCons : 'T list - - member this.Add (value: 'T) = - match box this.Result with - | null -> - let ra = RuntimeHelpers.FreshConsNoTail value - this.Result <- ra - this.LastCons <- ra - | _ -> - let ra = RuntimeHelpers.FreshConsNoTail value - RuntimeHelpers.SetFreshConsTail this.LastCons ra - this.LastCons <- ra + //[] + member x.MoveNext() = x.MoveNextImpl() + + member _.Reset() = raise <| new System.NotSupportedException() + +[] +type ListCollector<'T> = + [] + val mutable Result : 'T list + + [] + val mutable LastCons : 'T list + + member this.Add (value: 'T) = + match box this.Result with + | null -> + let ra = RuntimeHelpers.FreshConsNoTail value + this.Result <- ra + this.LastCons <- ra + | _ -> + let ra = RuntimeHelpers.FreshConsNoTail value + RuntimeHelpers.SetFreshConsTail this.LastCons ra + this.LastCons <- ra + + member this.AddMany (values: seq<'T>) = + // cook a faster iterator for lists and arrays + match values with + | :? ('T[]) as valuesAsArray -> + for v in valuesAsArray do + this.Add v + | :? ('T list) as valuesAsList -> + for v in valuesAsList do + this.Add v + | _ -> + for v in values do + this.Add v + + // In the particular case of closing with a final add of an F# list + // we can simply stitch the list into the end of the resulting list + member this.AddManyAndClose (values: seq<'T>) = + match values with + | :? ('T list) as valuesAsList -> + let res = + match box this.Result with + | null -> + valuesAsList + | _ -> + RuntimeHelpers.SetFreshConsTail this.LastCons valuesAsList + this.Result + this.Result <- Unchecked.defaultof<_> + this.LastCons <- Unchecked.defaultof<_> + res + | _ -> + this.AddMany values + this.Close() - member this.AddMany (values: seq<'T>) = + member this.Close() = + match box this.Result with + | null -> [] + | _ -> + RuntimeHelpers.SetFreshConsTail this.LastCons [] + let res = this.Result + this.Result <- Unchecked.defaultof<_> + this.LastCons <- Unchecked.defaultof<_> + res + +// Optimized for 0, 1 and 2 sized arrays +[] +type ArrayCollector<'T> = + [] + val mutable ResizeArray: ResizeArray<'T> + + [] + val mutable First: 'T + + [] + val mutable Second: 'T + + [] + val mutable Count: int + + member this.Add (value: 'T) = + match this.Count with + | 0 -> + this.Count <- 1 + this.First <- value + | 1 -> + this.Count <- 2 + this.Second <- value + | 2 -> + let ra = ResizeArray<'T>() + ra.Add(this.First) + ra.Add(this.Second) + ra.Add(value) + this.Count <- 3 + this.ResizeArray <- ra + | _ -> + this.ResizeArray.Add(value) + + member this.AddMany (values: seq<'T>) = + if this.Count > 2 then + this.ResizeArray.AddRange(values) + else // cook a faster iterator for lists and arrays match values with | :? ('T[]) as valuesAsArray -> @@ -474,104 +553,26 @@ namespace Microsoft.FSharp.Core.CompilerServices for v in values do this.Add v - // In the particular case of closing with a final add of an F# list - // we can simply stitch the list into the end of the resulting list - member this.AddManyAndClose (values: seq<'T>) = - match values with - | :? ('T list) as valuesAsList -> - let res = - match box this.Result with - | null -> - valuesAsList - | _ -> - RuntimeHelpers.SetFreshConsTail this.LastCons valuesAsList - this.Result - this.Result <- Unchecked.defaultof<_> - this.LastCons <- Unchecked.defaultof<_> - res - | _ -> - this.AddMany values - this.Close() - - member this.Close() = - match box this.Result with - | null -> [] - | _ -> - RuntimeHelpers.SetFreshConsTail this.LastCons [] - let res = this.Result - this.Result <- Unchecked.defaultof<_> - this.LastCons <- Unchecked.defaultof<_> - res - - // Optimized for 0, 1 and 2 sized arrays - [] - type ArrayCollector<'T> = - [] - val mutable ResizeArray: ResizeArray<'T> - - [] - val mutable First: 'T - - [] - val mutable Second: 'T - - [] - val mutable Count: int - - member this.Add (value: 'T) = - match this.Count with - | 0 -> - this.Count <- 1 - this.First <- value - | 1 -> - this.Count <- 2 - this.Second <- value - | 2 -> - let ra = ResizeArray<'T>() - ra.Add(this.First) - ra.Add(this.Second) - ra.Add(value) - this.Count <- 3 - this.ResizeArray <- ra - | _ -> - this.ResizeArray.Add(value) - - member this.AddMany (values: seq<'T>) = - if this.Count > 2 then - this.ResizeArray.AddRange(values) - else - // cook a faster iterator for lists and arrays - match values with - | :? ('T[]) as valuesAsArray -> - for v in valuesAsArray do - this.Add v - | :? ('T list) as valuesAsList -> - for v in valuesAsList do - this.Add v - | _ -> - for v in values do - this.Add v - - member this.AddManyAndClose (values: seq<'T>) = - this.AddMany(values) - this.Close() - - member this.Close() = - match this.Count with - | 0 -> Array.Empty<'T>() - | 1 -> - let res = [| this.First |] - this.Count <- 0 - this.First <- Unchecked.defaultof<_> - res - | 2 -> - let res = [| this.First; this.Second |] - this.Count <- 0 - this.First <- Unchecked.defaultof<_> - this.Second <- Unchecked.defaultof<_> - res - | _ -> - let res = this.ResizeArray.ToArray() - this <- ArrayCollector<'T>() - res - + member this.AddManyAndClose (values: seq<'T>) = + this.AddMany(values) + this.Close() + + member this.Close() = + match this.Count with + | 0 -> Array.Empty<'T>() + | 1 -> + let res = [| this.First |] + this.Count <- 0 + this.First <- Unchecked.defaultof<_> + res + | 2 -> + let res = [| this.First; this.Second |] + this.Count <- 0 + this.First <- Unchecked.defaultof<_> + this.Second <- Unchecked.defaultof<_> + res + | _ -> + let res = this.ResizeArray.ToArray() + this <- ArrayCollector<'T>() + res + diff --git a/src/FSharp.Core/seqcore.fsi b/src/FSharp.Core/seqcore.fsi index 26e2b2ab855..162458d8c90 100644 --- a/src/FSharp.Core/seqcore.fsi +++ b/src/FSharp.Core/seqcore.fsi @@ -190,7 +190,7 @@ type ArrayCollector<'T> = member AddMany: values: seq<'T> -> unit /// Add multiple elements to the collector and return the resulting array - member AddManyAndClose: values: seq<'T> -> 'T [] + member AddManyAndClose: values: seq<'T> -> 'T[] /// Return the resulting list - member Close: unit -> 'T [] + member Close: unit -> 'T[] diff --git a/src/FSharp.Core/set.fs b/src/FSharp.Core/set.fs index 9978a574c97..e59d3052168 100644 --- a/src/FSharp.Core/set.fs +++ b/src/FSharp.Core/set.fs @@ -558,7 +558,6 @@ module internal SetTree = [] [>)>] [] -[] type Set<[]'T when 'T: comparison >(comparer:IComparer<'T>, tree: SetTree<'T>) = [] @@ -663,14 +662,12 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member s.ForAll f = SetTree.forall f s.Tree - [] static member (-) (set1: Set<'T>, set2: Set<'T>) = if SetTree.isEmpty set1.Tree then set1 (* 0 - B = 0 *) else if SetTree.isEmpty set2.Tree then set1 (* A - 0 = A *) else Set(set1.Comparer, SetTree.diff set1.Comparer set1.Tree set2.Tree) - [] static member (+) (set1: Set<'T>, set2: Set<'T>) = #if TRACE_SETS_AND_MAPS SetTree.report() diff --git a/src/FSharp.Core/set.fsi b/src/FSharp.Core/set.fsi index 12a600abb46..a564360689f 100644 --- a/src/FSharp.Core/set.fsi +++ b/src/FSharp.Core/set.fsi @@ -380,7 +380,6 @@ module Set = [] val isProperSuperset: set1: Set<'T> -> set2: Set<'T> -> bool - /// Returns the number of elements in the set. Same as size. /// /// The input set. @@ -752,7 +751,7 @@ module Set = /// The sample evaluates to the following output: The set is set [(1, 2, 3)] and type is "FSharpSet`1" /// [] - val ofArray: array: 'T [] -> Set<'T> + val ofArray: array: 'T[] -> Set<'T> /// Builds an array that contains the elements of the set in order. /// @@ -769,7 +768,7 @@ module Set = /// The sample evaluates to the following output: The set is [|1; 2; 3|] and type is System.Int32[] /// [] - val toArray: set: Set<'T> -> 'T [] + val toArray: set: Set<'T> -> 'T[] /// Returns an ordered view of the collection as an enumerable object. /// diff --git a/src/FSharp.Core/string.fs b/src/FSharp.Core/string.fs index a653cbf20b7..f36e430e66c 100644 --- a/src/FSharp.Core/string.fs +++ b/src/FSharp.Core/string.fs @@ -2,181 +2,182 @@ namespace Microsoft.FSharp.Core - open System - open System.Text - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.Operators.Checked - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Primitives.Basics - - [] - [] - module String = - /// LOH threshold is calculated from Internal.Utilities.Library.LOH_SIZE_THRESHOLD_BYTES, - /// and is equal to 80_000 / sizeof - [] - let LOH_CHAR_THRESHOLD = 40_000 - - [] - let length (str:string) = if isNull str then 0 else str.Length - - [] - let concat sep (strings : seq) = - - 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) - //| 1 -> String.Join(sep.[0], strings, 0, strings.Length) - | _ -> String.Join(sep, strings, 0, strings.Length) - - match strings with - | :? (string[]) as arr -> - concatArray sep arr - - | :? (string list) as lst -> - lst - |> List.toArray - |> concatArray sep - - | _ -> - String.Join(sep, strings) - - [] - let iter (action : (char -> unit)) (str:string) = - if not (String.IsNullOrEmpty str) then - for i = 0 to str.Length - 1 do - action str.[i] - - [] - let iteri action (str:string) = - if not (String.IsNullOrEmpty str) then - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(action) - for i = 0 to str.Length - 1 do - f.Invoke(i, str.[i]) - - [] - 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 - - new String(result) - - [] - let mapi (mapping: int -> char -> char) (str:string) = - let len = length str - if len = 0 then - String.Empty - else - let result = str.ToCharArray() - let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(mapping) +open System +open System.Text +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Core.Operators.Checked +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Primitives.Basics + +[] +[] +module String = + + /// LOH threshold is calculated from Internal.Utilities.Library.LOH_SIZE_THRESHOLD_BYTES, + /// and is equal to 80_000 / sizeof + [] + let LOH_CHAR_THRESHOLD = 40_000 + + [] + let length (str:string) = + if isNull str then 0 else str.Length + + [] + let concat sep (strings : seq) = + + 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) + //| 1 -> String.Join(sep.[0], strings, 0, strings.Length) + | _ -> String.Join(sep, strings, 0, strings.Length) + + match strings with + | :? (string[]) as arr -> + concatArray sep arr + + | :? (string list) as lst -> + lst + |> List.toArray + |> concatArray sep + + | _ -> + String.Join(sep, strings) + + [] + let iter (action : (char -> unit)) (str:string) = + if not (String.IsNullOrEmpty str) then + for i = 0 to str.Length - 1 do + action str.[i] + + [] + let iteri action (str:string) = + if not (String.IsNullOrEmpty str) then + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(action) + for i = 0 to str.Length - 1 do + f.Invoke(i, str.[i]) + + [] + 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 + + new String(result) + + [] + let mapi (mapping: int -> char -> char) (str:string) = + let len = length str + if len = 0 then + String.Empty + else + let result = str.ToCharArray() + let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(mapping) + + let mutable i = 0 + while i < len do + result.[i] <- f.Invoke(i, result.[i]) + i <- i + 1 + + new String(result) + + [] + let filter (predicate: char -> bool) (str:string) = + let len = length str + + 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 + // 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) + res.ToString() - let mutable i = 0 - while i < len do - result.[i] <- f.Invoke(i, result.[i]) + 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 + target.[i] <- c i <- i + 1 - new String(result) - - [] - let filter (predicate: char -> bool) (str:string) = - let len = length str - - 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 - // 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) - 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 - target.[i] <- c - i <- i + 1 - - String(target, 0, i) - - [] - let collect (mapping: char -> string) (str:string) = - if String.IsNullOrEmpty str then - String.Empty - else - let res = StringBuilder str.Length - str |> iter (fun c -> res.Append(mapping c) |> ignore) - res.ToString() - - [] - 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 + String(target, 0, i) + + [] + let collect (mapping: char -> string) (str:string) = + if String.IsNullOrEmpty str then + String.Empty + else + let res = StringBuilder str.Length + str |> iter (fun c -> res.Append(mapping c) |> ignore) res.ToString() - [] - let replicate (count:int) (str:string) = - if count < 0 then invalidArgInputMustBeNonNegative "count" count - - let len = length str - if len = 0 || count = 0 then - String.Empty - - elif len = 1 then - new String(str.[0], count) - - elif count <= 4 then - match count with - | 1 -> str - | 2 -> String.Concat(str, str) - | 3 -> String.Concat(str, str, str) - | _ -> String.Concat(str, str, str, str) - - 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 source = str.ToCharArray() - - // O(log(n)) performance loop: - // 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 - - // finally, copy the remain half, or less-then half - Array.Copy(target, 0, target, i, target.Length - i) - new String(target) - - - [] - 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)) - check 0 - - [] - 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 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 + res.ToString() + + [] + let replicate (count:int) (str:string) = + if count < 0 then invalidArgInputMustBeNonNegative "count" count + + let len = length str + if len = 0 || count = 0 then + String.Empty + + elif len = 1 then + new String(str.[0], count) + + elif count <= 4 then + match count with + | 1 -> str + | 2 -> String.Concat(str, str) + | 3 -> String.Concat(str, str, str) + | _ -> String.Concat(str, str, str, str) + + 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 source = str.ToCharArray() + + // O(log(n)) performance loop: + // 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 + + // finally, copy the remain half, or less-then half + Array.Copy(target, 0, target, i, target.Length - i) + new String(target) + + [] + 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)) + check 0 + + [] + 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 diff --git a/src/FSharp.Core/tasks.fs b/src/FSharp.Core/tasks.fs index 83acba93a5e..4ec83a25be9 100644 --- a/src/FSharp.Core/tasks.fs +++ b/src/FSharp.Core/tasks.fs @@ -13,372 +13,372 @@ namespace Microsoft.FSharp.Control - #if !BUILDING_WITH_LKG && !BUILD_FROM_SOURCE - open System - open System.Runtime.CompilerServices - open System.Threading - open System.Threading.Tasks - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.CompilerServices - open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Control - open Microsoft.FSharp.Collections - - /// The extra data stored in ResumableStateMachine for tasks - [] - type TaskStateMachineData<'T> = - - [] - val mutable Result : 'T - - [] - val mutable MethodBuilder : AsyncTaskMethodBuilder<'T> - - and TaskStateMachine<'TOverall> = ResumableStateMachine> - and TaskResumptionFunc<'TOverall> = ResumptionFunc> - and TaskResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> - and TaskCode<'TOverall, 'T> = ResumableCode, 'T> - - type TaskBuilderBase() = - - 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. - [] - member inline _.Zero() : TaskCode<'TOverall, unit> = ResumableCode.Zero() - - 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> = - ResumableCode.Combine(task1, task2) - - /// Builds a step that executes the body while the condition predicate is true. - member inline _.While ([] 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> = - 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>, [] 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> = - 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 +#if !BUILDING_WITH_LKG && !BUILD_FROM_SOURCE +open System +open System.Runtime.CompilerServices +open System.Threading +open System.Threading.Tasks +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.CompilerServices +open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Control +open Microsoft.FSharp.Collections + +/// The extra data stored in ResumableStateMachine for tasks +[] +type TaskStateMachineData<'T> = + + [] + val mutable Result : 'T + + [] + val mutable MethodBuilder : AsyncTaskMethodBuilder<'T> + +and TaskStateMachine<'TOverall> = ResumableStateMachine> +and TaskResumptionFunc<'TOverall> = ResumptionFunc> +and TaskResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo> +and TaskCode<'TOverall, 'T> = ResumableCode, 'T> + +type TaskBuilderBase() = + + 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. + [] + member inline _.Zero() : TaskCode<'TOverall, unit> = ResumableCode.Zero() + + 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> = + ResumableCode.Combine(task1, task2) + + /// Builds a step that executes the body while the condition predicate is true. + member inline _.While ([] 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> = + 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>, [] 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> = + 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 + + if not __stack_condition_fin then + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + + __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) - __stack_condition_fin + // shortcut to continue immediately + if awaiter.IsCompleted then + true else - let vtask = compensation() - let mutable awaiter = vtask.GetAwaiter() + 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 + resource.DisposeAsync() + else + ValueTask())) +#endif - 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 - resource.DisposeAsync() - else - ValueTask())) - #endif - - - type TaskBuilder() = - - inherit TaskBuilderBase() - - // This is the dynamic implementation - this is not used - // 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> = - 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 mutable savedExn = null - try - sm.ResumptionDynamicInfo.ResumptionData <- null - let step = info.ResumptionFunc.Invoke(&sm) - if step then - sm.Data.MethodBuilder.SetResult(sm.Data.Result) - else - 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 - | 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.Start(&sm) - sm.Data.MethodBuilder.Task - - member inline _.Run(code : TaskCode<'T, 'T>) : Task<'T> = - if __useResumableCode then - __stateMachine, Task<'T>> - (MoveNextMethodImpl<_>(fun sm -> - //-- RESUMABLE CODE START - __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 -> - __stack_exn <- exn - // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 - match __stack_exn with - | null -> () - | exn -> sm.Data.MethodBuilder.SetException exn - //-- RESUMABLE CODE END - )) - (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine(state))) - (AfterCode<_,_>(fun sm -> +type TaskBuilder() = + + inherit TaskBuilderBase() + + // This is the dynamic implementation - this is not used + // 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> = + 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 mutable savedExn = null + try + sm.ResumptionDynamicInfo.ResumptionData <- null + let step = info.ResumptionFunc.Invoke(&sm) + if step then + sm.Data.MethodBuilder.SetResult(sm.Data.Result) + else + 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 + | 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.Start(&sm) + sm.Data.MethodBuilder.Task + + member inline _.Run(code : TaskCode<'T, 'T>) : Task<'T> = + if __useResumableCode then + __stateMachine, Task<'T>> + (MoveNextMethodImpl<_>(fun sm -> + //-- RESUMABLE CODE START + __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 -> + __stack_exn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match __stack_exn with + | null -> () + | exn -> sm.Data.MethodBuilder.SetException exn + //-- RESUMABLE CODE END + )) + (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine(state))) + (AfterCode<_,_>(fun sm -> + sm.Data.MethodBuilder <- AsyncTaskMethodBuilder<'T>.Create() + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task)) + else + TaskBuilder.RunDynamic(code) + +type BackgroundTaskBuilder() = + + inherit TaskBuilderBase() + + 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 + 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 + __stateMachine, Task<'T>> + (MoveNextMethodImpl<_>(fun sm -> + //-- RESUMABLE CODE START + __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 + )) + (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine(state))) + (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() sm.Data.MethodBuilder.Start(&sm) - sm.Data.MethodBuilder.Task)) - else - TaskBuilder.RunDynamic(code) - - type BackgroundTaskBuilder() = - - inherit TaskBuilderBase() - - 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 - 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 - __stateMachine, Task<'T>> - (MoveNextMethodImpl<_>(fun sm -> - //-- RESUMABLE CODE START - __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 - )) - (SetStateMachineMethodImpl<_>(fun sm state -> sm.Data.MethodBuilder.SetStateMachine(state))) - (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.Task + else + let sm = sm // copy contents of state machine so we can capture it + 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.Start(&sm) - sm.Data.MethodBuilder.Task - else - let sm = sm // copy contents of state machine so we can capture it - 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.Start(&sm) - sm.Data.MethodBuilder.Task))) - else - BackgroundTaskBuilder.RunDynamic(code) - - module TaskBuilder = - - let task = TaskBuilder() - let backgroundTask = BackgroundTaskBuilder() + sm.Data.MethodBuilder.Task))) + else + BackgroundTaskBuilder.RunDynamic(code) -namespace Microsoft.FSharp.Control.TaskBuilderExtensions - - open Microsoft.FSharp.Control - open System - open System.Runtime.CompilerServices - open System.Threading.Tasks - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.CompilerServices - open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - - module LowPriority = - // Low priority extensions - type TaskBuilderBase with - - [] - 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 = +module TaskBuilder = - let mutable awaiter = (^TaskLike: (member GetAwaiter : unit -> ^Awaiter)(task)) + let task = TaskBuilder() + let backgroundTask = BackgroundTaskBuilder() - 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 - - [] - 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 - ) - - [] - 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) +namespace Microsoft.FSharp.Control.TaskBuilderExtensions - 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() +open Microsoft.FSharp.Control +open System +open System.Runtime.CompilerServices +open System.Threading.Tasks +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.CompilerServices +open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators + +module LowPriority = + // Low priority extensions + type TaskBuilderBase with + + [] + 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 cont = - (TaskResumptionFunc<'TOverall>(fun sm -> - let result = awaiter.GetResult() + (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> = - - 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 - let result = awaiter.GetResult() - (continuation result).Invoke(&sm) - else - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) - false + [] + 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 - TaskBuilderBase.BindDynamic(&sm, task, continuation) - //-- RESUMABLE CODE END - ) + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + false + else + TaskBuilderBase.BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter , 'TOverall>(&sm, task, continuation) + //-- RESUMABLE CODE END + ) + + [] + 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 + let result = awaiter.GetResult() + (continuation result).Invoke(&sm) + else + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + false + else + TaskBuilderBase.BindDynamic(&sm, task, continuation) + //-- RESUMABLE CODE END + ) - member inline this.ReturnFrom (task: Task<'T>) : TaskCode<'T, 'T> = - this.Bind(task, (fun v -> this.Return v)) + member inline this.ReturnFrom (task: Task<'T>) : TaskCode<'T, 'T> = + this.Bind(task, (fun v -> this.Return v)) - module MediumPriority = - open HighPriority +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) + // 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.ReturnFrom (computation: Async<'T>) : TaskCode<'T, 'T> = + this.ReturnFrom (Async.StartAsTask computation) #endif diff --git a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Nuget.fsproj b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Nuget.fsproj index ee39bf3742e..8bf96070658 100644 --- a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Nuget.fsproj +++ b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Nuget.fsproj @@ -21,8 +21,8 @@ - - + + diff --git a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.ProjectFile.fs b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.ProjectFile.fs index b94a4833df1..53b4c3723cb 100644 --- a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.ProjectFile.fs +++ b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.ProjectFile.fs @@ -6,109 +6,119 @@ open System.IO // Package reference information type PackageReference = - { Include:string - Version:string - RestoreSources:string - Script:string + { + Include: string + Version: string + RestoreSources: string + Script: string } // Resolved assembly information type internal Resolution = - { NugetPackageId : string - NugetPackageVersion : string - PackageRoot : string - FullPath : string - AssetType: string - IsNotImplementationReference: string - InitializeSourcePath : string - NativePath : string + { + NugetPackageId: string + NugetPackageVersion: string + PackageRoot: string + FullPath: string + AssetType: string + IsNotImplementationReference: string + InitializeSourcePath: string + NativePath: string } - module internal ProjectFile = let fsxExt = ".fsx" let csxExt = ".csx" - let findLoadsFromResolutions (resolutions:Resolution[]) = + let findLoadsFromResolutions (resolutions: Resolution[]) = resolutions - |> Array.filter(fun r -> - not(String.IsNullOrEmpty(r.NugetPackageId) || - String.IsNullOrEmpty(r.InitializeSourcePath)) && - File.Exists(r.InitializeSourcePath)) - |> Array.map(fun r -> r.InitializeSourcePath) + |> Array.filter (fun r -> + not ( + String.IsNullOrEmpty(r.NugetPackageId) + || String.IsNullOrEmpty(r.InitializeSourcePath) + ) + && File.Exists(r.InitializeSourcePath)) + |> Array.map (fun r -> r.InitializeSourcePath) |> Array.distinct - let findReferencesFromResolutions (resolutions:Resolution array) = + let findReferencesFromResolutions (resolutions: Resolution array) = - let equals (s1:string) (s2:string) = + let equals (s1: string) (s2: string) = String.Compare(s1, s2, StringComparison.InvariantCultureIgnoreCase) = 0 resolutions - |> Array.filter(fun r -> not(String.IsNullOrEmpty(r.NugetPackageId) || - String.IsNullOrEmpty(r.FullPath)) && - not (equals r.IsNotImplementationReference "true") && - File.Exists(r.FullPath) && - equals r.AssetType "runtime") - |> Array.map(fun r -> r.FullPath) + |> Array.filter (fun r -> + not (String.IsNullOrEmpty(r.NugetPackageId) || String.IsNullOrEmpty(r.FullPath)) + && not (equals r.IsNotImplementationReference "true") + && File.Exists(r.FullPath) + && equals r.AssetType "runtime") + |> Array.map (fun r -> r.FullPath) |> Array.distinct - - let findIncludesFromResolutions (resolutions:Resolution[]) = + let findIncludesFromResolutions (resolutions: Resolution[]) = let managedRoots = resolutions - |> Array.filter(fun r -> - not(String.IsNullOrEmpty(r.NugetPackageId) || - String.IsNullOrEmpty(r.PackageRoot)) && - Directory.Exists(r.PackageRoot)) - |> Array.map(fun r -> r.PackageRoot) + |> Array.filter (fun r -> + not (String.IsNullOrEmpty(r.NugetPackageId) || String.IsNullOrEmpty(r.PackageRoot)) + && Directory.Exists(r.PackageRoot)) + |> Array.map (fun r -> r.PackageRoot) let nativeRoots = resolutions - |> Array.filter(fun r -> - not(String.IsNullOrEmpty(r.NugetPackageId) || - String.IsNullOrEmpty(r.NativePath))) - |> Array.map(fun r -> - if Directory.Exists(r.NativePath) then Some r.NativePath - elif File.Exists(r.NativePath) then Some (Path.GetDirectoryName(r.NativePath).Replace('\\', '/')) - else None) - |> Array.filter(fun r -> r.IsSome) - |> Array.map(fun r -> r.Value) - - Array.concat [|managedRoots; nativeRoots|] |> Array.distinct - + |> Array.filter (fun r -> not (String.IsNullOrEmpty(r.NugetPackageId) || String.IsNullOrEmpty(r.NativePath))) + |> Array.map (fun r -> + if Directory.Exists(r.NativePath) then + Some r.NativePath + elif File.Exists(r.NativePath) then + Some(Path.GetDirectoryName(r.NativePath).Replace('\\', '/')) + else + None) + |> Array.filter (fun r -> r.IsSome) + |> Array.map (fun r -> r.Value) + + Array.concat [| managedRoots; nativeRoots |] |> Array.distinct let getResolutionsFromFile resolutionsFile = let lines = try - File.ReadAllText(resolutionsFile).Split([| '\r'; '\n'|], StringSplitOptions.None) - |> Array.filter(fun line -> not(String.IsNullOrEmpty(line))) + File + .ReadAllText(resolutionsFile) + .Split([| '\r'; '\n' |], StringSplitOptions.None) + |> Array.filter (fun line -> not (String.IsNullOrEmpty(line))) with | _ -> [||] - [| for line in lines do - let fields = line.Split(',') - if fields.Length < 8 then raise (InvalidOperationException(sprintf "Internal error - Invalid resolutions file format '%s'" line)) - else - { NugetPackageId = fields[0] - NugetPackageVersion = fields[1] - PackageRoot = fields[2] - FullPath = fields[3] - AssetType = fields[4] - IsNotImplementationReference = fields[5] - InitializeSourcePath = fields[6] - NativePath = fields[7] - } + [| + for line in lines do + let fields = line.Split(',') + + if fields.Length < 8 then + raise ( + InvalidOperationException(sprintf "Internal error - Invalid resolutions file format '%s'" line) + ) + else + { + NugetPackageId = fields[0] + NugetPackageVersion = fields[1] + PackageRoot = fields[2] + FullPath = fields[3] + AssetType = fields[4] + IsNotImplementationReference = fields[5] + InitializeSourcePath = fields[6] + NativePath = fields[7] + } |] - let makeScriptFromReferences (references:string seq) poundRprefix = + let makeScriptFromReferences (references: string seq) poundRprefix = let expandReferences = references - |> Seq.fold(fun acc r -> acc + poundRprefix + r + "\"" + Environment.NewLine) "" + |> Seq.fold (fun acc r -> acc + poundRprefix + r + "\"" + Environment.NewLine) "" - let projectTemplate =""" + let projectTemplate = + """ // Generated from #r "nuget:Package References" // ============================================ // @@ -121,9 +131,11 @@ module internal ProjectFile = $(POUND_R) """ + projectTemplate.Replace("$(POUND_R)", expandReferences) - let generateProjectBody = """ + let generateProjectBody = + """ diff --git a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs index ee12859e228..22e81c56a13 100644 --- a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs +++ b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.Utilities.fs @@ -8,16 +8,19 @@ open System.Reflection open FSDependencyManager open Internal.Utilities.FSharpEnvironment -[] -type DependencyManagerAttribute() = inherit Attribute() +[] +type DependencyManagerAttribute() = + inherit Attribute() /// The result of building the package resolution files. type PackageBuildResolutionResult = - { success: bool - projectPath: string - stdOut: string array - stdErr: string array - resolutionsFile: string option } + { + success: bool + projectPath: string + stdOut: string array + stdErr: string array + resolutionsFile: string option + } module internal Utilities = @@ -25,48 +28,57 @@ module internal Utilities = /// Note that a quoted string is not going to be mangled into pieces. let trimChars = [| ' '; '\t'; '\''; '\"' |] - let inline private isNotQuotedQuotation (text: string) n = n > 0 && text[n-1] <> '\\' + let inline private isNotQuotedQuotation (text: string) n = n > 0 && text[n - 1] <> '\\' let getOptions text = - let split (option:string) = + let split (option: string) = 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 None - else stringAsOpt (option.Substring(0, pos).Trim(trimChars).ToLowerInvariant()) + if pos <= 0 then + None + else + stringAsOpt (option.Substring(0, pos).Trim(trimChars).ToLowerInvariant()) + let valueOpt = let valueText = - if pos < 0 then option + if pos < 0 then + option else if pos < option.Length then option.Substring(pos + 1) - else "" + else + "" + stringAsOpt (valueText.Trim(trimChars)) - nameOpt,valueOpt + + nameOpt, valueOpt let last = String.length text - 1 let result = ResizeArray() let mutable insideSQ = false let mutable start = 0 let isSeperator c = c = ',' + for i = 0 to last do match text[i], insideSQ with - | c, false when isSeperator c -> // split when seeing a separator + | c, false when isSeperator c -> // split when seeing a separator result.Add(text.Substring(start, i - start)) insideSQ <- false start <- i + 1 - | _, _ when i = last -> - result.Add(text.Substring(start, i - start + 1)) - | c, true when isSeperator c -> // keep reading if a separator is inside quotation + | _, _ when i = last -> result.Add(text.Substring(start, i - start + 1)) + | c, true when isSeperator c -> // keep reading if a separator is inside quotation insideSQ <- true - | '\'', _ when isNotQuotedQuotation text i -> // open or close quotation - insideSQ <- not insideSQ // keep reading + | '\'', _ when isNotQuotedQuotation text i -> // open or close quotation + insideSQ <- not insideSQ // keep reading | _ -> () - result - |> List.ofSeq - |> List.map (fun option -> split option) + result |> List.ofSeq |> List.map (fun option -> split option) let executeTool pathToExe arguments workingDir timeout = match pathToExe with @@ -75,6 +87,7 @@ module internal Utilities = let outputList = ResizeArray() let mutable errorslock = obj let mutable outputlock = obj + let outputDataReceived (message: string) = if not (isNull message) then lock outputlock (fun () -> outputList.Add(message)) @@ -90,23 +103,25 @@ module internal Utilities = psi.RedirectStandardError <- true psi.Arguments <- arguments psi.CreateNoWindow <- true - psi.EnvironmentVariables.Remove("MSBuildSDKsPath") // Host can sometimes add this, and it can break things + psi.EnvironmentVariables.Remove("MSBuildSDKsPath") // Host can sometimes add this, and it can break things psi.UseShellExecute <- false use p = new Process() p.StartInfo <- psi p.OutputDataReceived.Add(fun a -> outputDataReceived a.Data) - p.ErrorDataReceived.Add(fun a -> errorDataReceived a.Data) + p.ErrorDataReceived.Add(fun a -> errorDataReceived a.Data) if p.Start() then p.BeginOutputReadLine() p.BeginErrorReadLine() - if not(p.WaitForExit(timeout)) then + + if not (p.WaitForExit(timeout)) then // Timed out resolving throw a diagnostic. - raise (TimeoutException(SR.timedoutResolvingPackages(psi.FileName, psi.Arguments))) + raise (TimeoutException(SR.timedoutResolvingPackages (psi.FileName, psi.Arguments))) else p.WaitForExit() + p.ExitCode = 0, outputList.ToArray(), errorsList.ToArray() | None -> false, Array.empty, Array.empty @@ -114,26 +129,33 @@ module internal Utilities = let buildProject projectPath binLogPath timeout = let binLoggingArguments = match binLogPath with - | Some(path) -> - let path = match path with - | Some path -> path // specific file - | None -> Path.Combine(Path.GetDirectoryName(projectPath), "msbuild.binlog") // auto-generated file + | Some (path) -> + let path = + match path with + | Some path -> path // specific file + | None -> Path.Combine(Path.GetDirectoryName(projectPath), "msbuild.binlog") // auto-generated file + sprintf "/bl:\"%s\"" path | None -> "" let timeout = match timeout with - | Some(timeout) -> timeout + | Some (timeout) -> timeout | None -> -1 let arguments prefix = - sprintf "%s -restore %s %c%s%c /nologo /t:InteractivePackageManagement" prefix binLoggingArguments '\"' projectPath '\"' + sprintf + "%s -restore %s %c%s%c /nologo /t:InteractivePackageManagement" + prefix + binLoggingArguments + '\"' + projectPath + '\"' let workingDir = Path.GetDirectoryName projectPath - let dotnetHostPath = getDotnetHostPath() + let dotnetHostPath = getDotnetHostPath () let args = arguments "msbuild -v:quiet" - let success, stdOut, stdErr = - executeTool dotnetHostPath args workingDir timeout + let success, stdOut, stdErr = executeTool dotnetHostPath args workingDir timeout #if DEBUG let diagnostics = @@ -142,13 +164,20 @@ module internal Utilities = $"dotnetHostPath: {dotnetHostPath}" $"arguments: {args}" |] + File.WriteAllLines(Path.Combine(workingDir, "build_CommandLine.txt"), diagnostics) File.WriteAllLines(Path.Combine(workingDir, "build_StandardOutput.txt"), stdOut) File.WriteAllLines(Path.Combine(workingDir, "build_StandardError.txt"), stdErr) #endif let outputFile = projectPath + ".resolvedReferences.paths" - let resolutionsFile = if success && File.Exists(outputFile) then Some outputFile else None + + let resolutionsFile = + if success && File.Exists(outputFile) then + Some outputFile + else + None + { success = success projectPath = projectPath @@ -158,8 +187,9 @@ module internal Utilities = } let generateSourcesFromNugetConfigs scriptDirectory workingDir timeout = - let dotnetHostPath = getDotnetHostPath() + let dotnetHostPath = getDotnetHostPath () let args = "nuget list source --format short" + let success, stdOut, stdErr = executeTool dotnetHostPath args scriptDirectory timeout #if DEBUG @@ -169,6 +199,7 @@ module internal Utilities = $"dotnetHostPath: {dotnetHostPath}" $"arguments: {args}" |] + File.WriteAllLines(Path.Combine(workingDir, "nuget_CommandLine.txt"), diagnostics) File.WriteAllLines(Path.Combine(workingDir, "nuget_StandardOutput.txt"), stdOut) File.WriteAllLines(Path.Combine(workingDir, "nuget_StandardError.txt"), stdErr) @@ -184,5 +215,7 @@ module internal Utilities = // E https://dotnetfeed.blob.core.windows.net/dotnet-core/index.json // 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()) } diff --git a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs index 38cff9c84b2..908f9cc5aa3 100644 --- a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs +++ b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs @@ -12,93 +12,155 @@ open FSharp.DependencyManager.Nuget.ProjectFile open FSDependencyManager module FSharpDependencyManager = - + [] do () - let private concat (s:string) (v:string) : string = + let private concat (s: string) (v: string) : string = match String.IsNullOrEmpty(s), String.IsNullOrEmpty(v) with | false, false -> s + ";" + v | false, true -> s | true, false -> v - | _ -> "" + | _ -> "" - let validateAndFormatRestoreSources (sources:string) = [| + let validateAndFormatRestoreSources (sources: string) = + [| let items = sources.Split(';') + for item in items do let uri = Uri(item) + if uri.IsFile then let directoryName = uri.LocalPath + if Directory.Exists(directoryName) then - yield sprintf """ $(RestoreAdditionalProjectSources);%s""" directoryName directoryName + yield + sprintf + """ $(RestoreAdditionalProjectSources);%s""" + directoryName + directoryName else - raise (Exception(SR.sourceDirectoryDoesntExist(directoryName))) + raise (Exception(SR.sourceDirectoryDoesntExist (directoryName))) else - yield sprintf """ $(RestoreAdditionalProjectSources);%s""" uri.OriginalString + yield + sprintf + """ $(RestoreAdditionalProjectSources);%s""" + uri.OriginalString |] let formatPackageReference p = - let { Include=inc; Version=ver; RestoreSources=src; Script=script } = p + let { + Include = inc + Version = ver + RestoreSources = src + Script = script + } = + p + seq { - match not (String.IsNullOrEmpty(inc)), not (String.IsNullOrEmpty(ver)), not (String.IsNullOrEmpty(script)) with - | true, true, false -> yield sprintf @" " inc ver - | true, true, true -> yield sprintf @" " inc ver script + match not (String.IsNullOrEmpty(inc)), not (String.IsNullOrEmpty(ver)), not (String.IsNullOrEmpty(script)) + with + | true, true, false -> + yield sprintf @" " inc ver + | true, true, true -> + yield + sprintf + @" " + inc + ver + script | true, false, false -> yield sprintf @" " inc - | true, false, true -> yield sprintf @" " inc script + | true, false, true -> + yield sprintf @" " inc script | _ -> () + match not (String.IsNullOrEmpty(src)) with | true -> yield! validateAndFormatRestoreSources src | _ -> () } - let parsePackageReferenceOption scriptExt (setBinLogPath: string option option -> unit) (setTimeout: int option -> unit) (line: string) = + let parsePackageReferenceOption + scriptExt + (setBinLogPath: string option option -> unit) + (setTimeout: int option -> unit) + (line: string) + = let validatePackageName package packageName = if String.Compare(packageName, package, StringComparison.OrdinalIgnoreCase) = 0 then - raise (ArgumentException(SR.cantReferenceSystemPackage(packageName))) - let rec parsePackageReferenceOption' (options: (string option * string option) list) (implicitArgumentCount: int) (packageReference: PackageReference option) = + raise (ArgumentException(SR.cantReferenceSystemPackage (packageName))) + + let rec parsePackageReferenceOption' + (options: (string option * string option) list) + (implicitArgumentCount: int) + (packageReference: PackageReference option) + = let current = match packageReference with | Some p -> p - | None -> { Include = ""; Version = "*"; RestoreSources = ""; Script = "" } + | None -> + { + Include = "" + Version = "*" + RestoreSources = "" + Script = "" + } + match options with | [] -> packageReference | opt :: rest -> let addInclude v = validatePackageName v "mscorlib" + if scriptExt = fsxExt then validatePackageName v "FSharp.Core" + validatePackageName v "System.ValueTuple" validatePackageName v "NETStandard.Library" validatePackageName v "Microsoft.NETFramework.ReferenceAssemblies" Some { current with Include = v } + let setVersion v = Some { current with Version = v } + match opt with | Some "include", Some v -> addInclude v |> parsePackageReferenceOption' rest implicitArgumentCount - | Some "include", None -> raise (ArgumentException(SR.requiresAValue("Include"))) + | Some "include", None -> raise (ArgumentException(SR.requiresAValue ("Include"))) | Some "version", Some v -> setVersion v |> parsePackageReferenceOption' rest implicitArgumentCount | Some "version", None -> setVersion "*" |> parsePackageReferenceOption' rest implicitArgumentCount - | Some "restoresources", Some v -> Some { current with RestoreSources = concat current.RestoreSources v } |> parsePackageReferenceOption' rest implicitArgumentCount - | Some "restoresources", None -> raise (ArgumentException(SR.requiresAValue("RestoreSources"))) - | Some "script", Some v -> Some { current with Script = v } |> parsePackageReferenceOption' rest implicitArgumentCount - | Some "timeout", None -> raise (ArgumentException(SR.missingTimeoutValue())) + | Some "restoresources", Some v -> + Some + { current with + RestoreSources = concat current.RestoreSources v + } + |> parsePackageReferenceOption' rest implicitArgumentCount + | Some "restoresources", None -> raise (ArgumentException(SR.requiresAValue ("RestoreSources"))) + | Some "script", Some v -> + Some { current with Script = v } + |> parsePackageReferenceOption' rest implicitArgumentCount + | Some "timeout", None -> raise (ArgumentException(SR.missingTimeoutValue ())) | Some "timeout", value -> match value with | Some v when v.GetType() = typeof -> let parsed, value = Int32.TryParse(v) - if parsed && value >= 0 then setTimeout (Some (Int32.Parse v)) - elif v = "none" then setTimeout (Some -1) - else raise (ArgumentException(SR.invalidTimeoutValue(v))) + + if parsed && value >= 0 then + setTimeout (Some(Int32.Parse v)) + elif v = "none" then + setTimeout (Some -1) + else + raise (ArgumentException(SR.invalidTimeoutValue (v))) | _ -> setTimeout None // auto-generated logging location + parsePackageReferenceOption' rest implicitArgumentCount packageReference | Some "bl", value -> match value with - | Some v when v.ToLowerInvariant() = "true" -> setBinLogPath (Some None) // auto-generated logging location - | Some v when v.ToLowerInvariant() = "false" -> setBinLogPath None // no logging - | Some path -> setBinLogPath (Some (Some path)) // explicit logging location + | Some v when v.ToLowerInvariant() = "true" -> setBinLogPath (Some None) // auto-generated logging location + | Some v when v.ToLowerInvariant() = "false" -> setBinLogPath None // no logging + | Some path -> setBinLogPath (Some(Some path)) // explicit logging location | None -> // parser shouldn't get here because unkeyed values follow a different path, but for the sake of completeness and keeping the compiler happy, // this is fine setBinLogPath (Some None) // auto-generated logging location + parsePackageReferenceOption' rest implicitArgumentCount packageReference | None, Some v -> match v.ToLowerInvariant() with @@ -109,39 +171,52 @@ module FSharpDependencyManager = parsePackageReferenceOption' rest implicitArgumentCount packageReference | "timeout" -> // bare timeout is invalid - raise (ArgumentException(SR.missingTimeoutValue())) + raise (ArgumentException(SR.missingTimeoutValue ())) | _ -> match implicitArgumentCount with | 0 -> addInclude v | 1 -> setVersion v - | _ -> raise (ArgumentException(SR.unableToApplyImplicitArgument(implicitArgumentCount + 1))) + | _ -> raise (ArgumentException(SR.unableToApplyImplicitArgument (implicitArgumentCount + 1))) |> parsePackageReferenceOption' rest (implicitArgumentCount + 1) | _ -> parsePackageReferenceOption' rest implicitArgumentCount packageReference + let options = getOptions line parsePackageReferenceOption' options 0 None let parsePackageReference scriptExt (lines: string list) = let mutable binLogPath = None let mutable timeout = None + lines - |> List.choose (fun line -> parsePackageReferenceOption scriptExt (fun p -> binLogPath <- p) (fun t -> timeout <- t) line) + |> List.choose (fun line -> + parsePackageReferenceOption scriptExt (fun p -> binLogPath <- p) (fun t -> timeout <- t) line) |> List.distinct |> (fun l -> l, binLogPath, timeout) let parsePackageDirective scriptExt (lines: (string * string) list) = let mutable binLogPath = None let mutable timeout = None + lines - |> List.map(fun (directive, line) -> + |> List.map (fun (directive, line) -> match directive with | "i" -> sprintf "RestoreSources=%s" line | _ -> line) - |> List.choose (fun line -> parsePackageReferenceOption scriptExt (fun p -> binLogPath <- p) (fun t -> timeout <- t) line) + |> List.choose (fun line -> + parsePackageReferenceOption scriptExt (fun p -> binLogPath <- p) (fun t -> timeout <- t) line) |> List.distinct |> (fun l -> l, binLogPath, timeout) /// The results of ResolveDependencies -type ResolveDependenciesResult (success: bool, stdOut: string array, stdError: string array, resolutions: string seq, sourceFiles: string seq, roots: string seq) = +type ResolveDependenciesResult + ( + success: bool, + stdOut: string array, + stdError: string array, + resolutions: string seq, + sourceFiles: string seq, + roots: string seq + ) = /// Succeded? member _.Success = success @@ -171,13 +246,13 @@ type ResolveDependenciesResult (success: bool, stdOut: string array, stdError: s /// #I @"c:\somepath\to\packages\ResolvedPackage\1.1.1\" member _.Roots = roots -[] -type FSharpDependencyManager (outputDirectory:string option) = +[] +type FSharpDependencyManager(outputDirectory: string option) = let key = "nuget" let name = "MsBuild Nuget DependencyManager" - let generatedScripts = ConcurrentDictionary() + let generatedScripts = ConcurrentDictionary() let workingDirectory = // Calculate the working directory for dependency management @@ -185,19 +260,25 @@ type FSharpDependencyManager (outputDirectory:string option) = // if a path was supplied if it was rooted then use the rooted path as the root // if the path wasn't supplied or not rooted use the temp directory as the root. let directory = - let path = Path.Combine(Process.GetCurrentProcess().Id.ToString() + "--"+ Guid.NewGuid().ToString()) + let path = + Path.Combine(Process.GetCurrentProcess().Id.ToString() + "--" + Guid.NewGuid().ToString()) + match outputDirectory with | None -> Path.Combine(Path.GetTempPath(), path) | Some v -> - if Path.IsPathRooted(v) then Path.Combine(v, path) - else Path.Combine(Path.GetTempPath(), path) + if Path.IsPathRooted(v) then + Path.Combine(v, path) + else + Path.Combine(Path.GetTempPath(), path) lazy try if not (Directory.Exists(directory)) then Directory.CreateDirectory(directory) |> ignore + directory - with | _ -> directory + with + | _ -> directory let deleteScripts () = try @@ -208,16 +289,25 @@ 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 | _ -> () - - let prepareDependencyResolutionFiles (scriptExt: string, directiveLines: (string * string) seq, targetFrameworkMoniker: string, runtimeIdentifier: string, timeout: int): PackageBuildResolutionResult = + with + | _ -> () + + let prepareDependencyResolutionFiles + ( + scriptExt: string, + directiveLines: (string * string) seq, + targetFrameworkMoniker: string, + runtimeIdentifier: string, + timeout: int + ) : PackageBuildResolutionResult = let scriptExt = match scriptExt with | ".csx" -> csxExt @@ -240,62 +330,108 @@ type FSharpDependencyManager (outputDirectory:string option) = let generateAndBuildProjectArtifacts = let writeFile path body = if not (generatedScripts.ContainsKey(body.GetHashCode().ToString())) then - emitFile path body + emitFile path body let generateProjBody = - generateProjectBody.Replace("$(TARGETFRAMEWORK)", targetFrameworkMoniker) - .Replace("$(RUNTIMEIDENTIFIER)", runtimeIdentifier) - .Replace("$(PACKAGEREFERENCES)", packageReferenceText) - .Replace("$(SCRIPTEXTENSION)", scriptExt) + generateProjectBody + .Replace("$(TARGETFRAMEWORK)", targetFrameworkMoniker) + .Replace("$(RUNTIMEIDENTIFIER)", runtimeIdentifier) + .Replace("$(PACKAGEREFERENCES)", packageReferenceText) + .Replace("$(SCRIPTEXTENSION)", scriptExt) let timeout = match package_timeout with | Some _ -> package_timeout | None -> Some timeout + writeFile projectPath generateProjBody buildProject projectPath binLogPath timeout generateAndBuildProjectArtifacts - - do AppDomain.CurrentDomain.ProcessExit |> Event.add(fun _ -> deleteScripts () ) + do AppDomain.CurrentDomain.ProcessExit |> Event.add (fun _ -> deleteScripts ()) member _.Name = name member _.Key = key - member _.HelpMessages = [| - sprintf """ #r "nuget:FSharp.Data, 3.1.2";; // %s 'FSharp.Data' %s '3.1.2'""" (SR.loadNugetPackage()) (SR.version()) - sprintf """ #r "nuget:FSharp.Data";; // %s 'FSharp.Data' %s""" (SR.loadNugetPackage()) (SR.highestVersion()) + member _.HelpMessages = + [| + sprintf + """ #r "nuget:FSharp.Data, 3.1.2";; // %s 'FSharp.Data' %s '3.1.2'""" + (SR.loadNugetPackage ()) + (SR.version ()) + sprintf + """ #r "nuget:FSharp.Data";; // %s 'FSharp.Data' %s""" + (SR.loadNugetPackage ()) + (SR.highestVersion ()) |] - member _.ResolveDependencies(scriptDirectory: string, scriptName: string, scriptExt: string, packageManagerTextLines: (string * string) seq, targetFrameworkMoniker: string, runtimeIdentifier: string, timeout: int) : obj = + member _.ResolveDependencies + ( + scriptDirectory: string, + scriptName: string, + scriptExt: string, + packageManagerTextLines: (string * string) seq, + targetFrameworkMoniker: string, + runtimeIdentifier: string, + timeout: int + ) : obj = ignore scriptName - let poundRprefix = + + let poundRprefix = match scriptExt with | ".csx" -> "#r \"" | _ -> "#r @\"" let generateAndBuildProjectArtifacts = - let configIncludes = generateSourcesFromNugetConfigs scriptDirectory workingDirectory.Value timeout + let configIncludes = + generateSourcesFromNugetConfigs scriptDirectory workingDirectory.Value timeout + let directiveLines = Seq.append packageManagerTextLines configIncludes - let resolutionResult = prepareDependencyResolutionFiles (scriptExt, directiveLines, targetFrameworkMoniker, runtimeIdentifier, timeout) + + let resolutionResult = + prepareDependencyResolutionFiles ( + scriptExt, + directiveLines, + targetFrameworkMoniker, + runtimeIdentifier, + timeout + ) + match resolutionResult.resolutionsFile with | Some file -> let resolutions = getResolutionsFromFile file let references = (findReferencesFromResolutions resolutions) |> Array.toSeq + let scripts = let generatedScriptPath = resolutionResult.projectPath + scriptExt - let generatedScriptBody = makeScriptFromReferences references poundRprefix + let generatedScriptBody = makeScriptFromReferences references poundRprefix emitFile generatedScriptPath generatedScriptBody let loads = (findLoadsFromResolutions resolutions) |> Array.toList - List.concat [ [generatedScriptPath]; loads] |> List.toSeq + List.concat [ [ generatedScriptPath ]; loads ] |> List.toSeq + let includes = (findIncludesFromResolutions resolutions) |> Array.toSeq - ResolveDependenciesResult(resolutionResult.success, resolutionResult.stdOut, resolutionResult.stdErr, references, scripts, includes) + ResolveDependenciesResult( + resolutionResult.success, + resolutionResult.stdOut, + resolutionResult.stdErr, + references, + scripts, + includes + ) | None -> let empty = Seq.empty - ResolveDependenciesResult(resolutionResult.success, resolutionResult.stdOut, resolutionResult.stdErr, empty, empty, empty) + + ResolveDependenciesResult( + resolutionResult.success, + resolutionResult.stdOut, + resolutionResult.stdErr, + empty, + empty, + empty + ) generateAndBuildProjectArtifacts :> obj diff --git a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fsi b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fsi index 27af57209cf..5344b5fe6aa 100644 --- a/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fsi +++ b/src/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fsi @@ -19,10 +19,10 @@ type ResolveDependenciesResult = member Success: bool /// The resolution output log - member StdOut: string [] + member StdOut: string[] /// The resolution error log (process stderr) - member StdError: string [] + member StdError: string[] /// The resolution paths - the full paths to selected resolved dll's. /// In scripts this is equivalent to #r @"c:\somepath\to\packages\ResolvedPackage\1.1.1\lib\netstandard2.0\ResolvedAssembly.dll" @@ -51,7 +51,7 @@ type FSharpDependencyManager = member Key: string - member HelpMessages: string [] + member HelpMessages: string[] member ResolveDependencies: scriptDirectory: string * diff --git a/src/fsc/fscmain.fs b/src/fsc/fscmain.fs index b75934ac783..334f22c36e9 100644 --- a/src/fsc/fscmain.fs +++ b/src/fsc/fscmain.fs @@ -8,25 +8,26 @@ open System.Runtime open System.Runtime.CompilerServices open System.Threading -open Internal.Utilities.Library +open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL -open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Driver open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Text -[] +[] do () [] -let main(argv) = +let main (argv) = let compilerName = // the 64 bit desktop version of the compiler is name fscAnyCpu.exe, all others are fsc.exe - if Environment.Is64BitProcess && typeof.Assembly.GetName().Name <> "System.Private.CoreLib" then + if Environment.Is64BitProcess + && typeof.Assembly.GetName().Name <> "System.Private.CoreLib" then "fscAnyCpu.exe" else "fsc.exe" @@ -44,49 +45,54 @@ let main(argv) = try // We are on a compilation thread - let ctok = AssumeCompilationThreadWithoutEvidence () + let ctok = AssumeCompilationThreadWithoutEvidence() // The F# compiler expects 'argv' to include the executable name, though it makes no use of it. let argv = Array.append [| compilerName |] argv - + // Check for --pause as the very first step so that a debugger can be attached here. - let pauseFlag = argv |> Array.exists (fun x -> x = "/pause" || x = "--pause") - if pauseFlag then + let pauseFlag = argv |> Array.exists (fun x -> x = "/pause" || x = "--pause") + + if pauseFlag then System.Console.WriteLine("Press return to continue...") System.Console.ReadLine() |> ignore // Set up things for the --times testing flag #if !FX_NO_APP_DOMAINS - let timesFlag = argv |> Array.exists (fun x -> x = "/times" || x = "--times") + let timesFlag = argv |> Array.exists (fun x -> x = "/times" || x = "--times") + if timesFlag then let stats = ILBinaryReader.GetStatistics() + AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> - printfn "STATS: #ByteArrayFile = %d, #MemoryMappedFileOpen = %d, #MemoryMappedFileClosed = %d, #RawMemoryFile = %d, #WeakByteArrayFile = %d" - stats.byteFileCount - stats.memoryMapFileOpenedCount - stats.memoryMapFileClosedCount - stats.rawMemoryFileCount + printfn + "STATS: #ByteArrayFile = %d, #MemoryMappedFileOpen = %d, #MemoryMappedFileClosed = %d, #RawMemoryFile = %d, #WeakByteArrayFile = %d" + stats.byteFileCount + stats.memoryMapFileOpenedCount + stats.memoryMapFileClosedCount + stats.rawMemoryFileCount stats.weakByteFileCount) #endif // This object gets invoked when two many errors have been accumulated, or an abort-on-error condition // has been reached (e.g. type checking failed, so don't proceed to optimization). - let quitProcessExiter = - { new Exiter with - member _.Exit(n) = - try - exit n - with _ -> - () - failwithf "%s" (FSComp.SR.elSysEnvExitDidntExit()) + let quitProcessExiter = + { new Exiter with + member _.Exit(n) = + try + exit n + with + | _ -> () + + failwithf "%s" (FSComp.SR.elSysEnvExitDidntExit ()) } // Get the handler for legacy resolution of references via MSBuild. - let legacyReferenceResolver = + let legacyReferenceResolver = #if CROSS_PLATFORM_COMPILER SimulatedMSBuildReferenceResolver.SimulatedMSBuildResolver #else - LegacyMSBuildReferenceResolver.getResolver() + LegacyMSBuildReferenceResolver.getResolver () #endif // Perform the main compilation. @@ -95,10 +101,23 @@ let main(argv) = // thus we can use file-locking memory mapped files. // // This is also one of only two places where CopyFSharpCoreFlag.Yes is set. The other is in LegacyHostedCompilerForTesting. - CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) - 0 - - with e -> + CompileFromCommandLineArguments( + ctok, + argv, + legacyReferenceResolver (*bannerAlreadyPrinted*) , + false, + ReduceMemoryFlag.No, + CopyFSharpCoreFlag.Yes, + quitProcessExiter, + ConsoleLoggerProvider(), + None, + None + ) + + 0 + + with + | e -> // Last-chance error recovery (note, with a poor error range) errorRecovery e Range.range0 1 diff --git a/src/fsi/console.fs b/src/fsi/console.fs index d49807d944e..88c45399567 100644 --- a/src/fsi/console.fs +++ b/src/fsi/console.fs @@ -5,43 +5,58 @@ namespace FSharp.Compiler.Interactive open System open System.Text open System.Collections.Generic +open FSharp.Compiler.DiagnosticsLogger -type internal Style = Prompt | Out | Error +type internal Style = + | Prompt + | Out + | Error /// Class managing the command History. type internal History() = - let list = new List() - let mutable current = 0 + let list = new List() + let mutable current = 0 member _.Count = list.Count member _.Current = - if current >= 0 && current < list.Count then list.[current] else String.Empty + if current >= 0 && current < list.Count then + list.[current] + else + String.Empty - member _.Clear() = list.Clear(); current <- -1 + member _.Clear() = + list.Clear() + current <- -1 member _.Add line = match line with - | null | "" -> () + | null + | "" -> () | _ -> list.Add(line) member _.AddLast line = match line with - | null | "" -> () - | _ -> list.Add(line); current <- list.Count + | null + | "" -> () + | _ -> + list.Add(line) + current <- list.Count // Dead code // member x.First() = current <- 0; x.Current // member x.Last() = current <- list.Count - 1; x.Current member x.Previous() = - if (list.Count > 0) then + if (list.Count > 0) then current <- ((current - 1) + list.Count) % list.Count + x.Current member x.Next() = if (list.Count > 0) then current <- (current + 1) % list.Count + x.Current /// List of available optionsCache @@ -50,60 +65,88 @@ type internal Options() = let mutable root = "" - member _.Root with get() = root and set(v) = (root <- v) + member _.Root + with get () = root + and set (v) = (root <- v) /// Cursor position management module internal Utils = - let guard(f) = - try f() - with e -> - FSharp.Compiler.DiagnosticsLogger.warning(Failure(sprintf "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" e.Message e.StackTrace)) + let guard (f) = + try + f () + with + | e -> + warning ( + Failure( + sprintf + "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" + e.Message + e.StackTrace + ) + ) let rec previousWordFromIdx (line: string) (idx, isInWord) = - if idx < 0 then 0 else - match line.Chars(idx), isInWord with - | ' ', true -> idx + 1 - | ' ', false -> previousWordFromIdx line (idx - 1, false) - | _, _ -> previousWordFromIdx line (idx - 1, true) - + if idx < 0 then + 0 + else + match line.Chars(idx), isInWord with + | ' ', true -> idx + 1 + | ' ', false -> previousWordFromIdx line (idx - 1, false) + | _, _ -> previousWordFromIdx line (idx - 1, true) + let rec nextWordFromIdx (line: string) (idx, isInWord) = - if idx >= line.Length then line.Length - 1 else - match line.Chars(idx), isInWord with - | ' ', true -> idx - | ' ', false -> nextWordFromIdx line (idx + 1, false) - | _, _ -> nextWordFromIdx line (idx + 1, true) - + if idx >= line.Length then + line.Length - 1 + else + match line.Chars(idx), isInWord with + | ' ', true -> idx + | ' ', false -> nextWordFromIdx line (idx + 1, false) + | _, _ -> nextWordFromIdx line (idx + 1, true) + [] type internal Cursor = - static member ResetTo(top,left) = - Utils.guard(fun () -> - Console.CursorTop <- min top (Console.BufferHeight - 1) - Console.CursorLeft <- left) + static member ResetTo(top, left) = + Utils.guard (fun () -> + Console.CursorTop <- min top (Console.BufferHeight - 1) + Console.CursorLeft <- left) static member Move(inset, delta) = - let position = Console.CursorTop * (Console.BufferWidth - inset) + (Console.CursorLeft - inset) + delta - let top = position / (Console.BufferWidth - inset) + let position = + Console.CursorTop * (Console.BufferWidth - inset) + + (Console.CursorLeft - inset) + + delta + + let top = position / (Console.BufferWidth - inset) let left = inset + position % (Console.BufferWidth - inset) - Cursor.ResetTo(top,left) + Cursor.ResetTo(top, left) type internal Anchor = - {top:int; left:int} + { + top: int + left: int + } - static member Current(inset) = {top=Console.CursorTop;left= max inset Console.CursorLeft} + static member Current(inset) = + { + top = Console.CursorTop + left = max inset Console.CursorLeft + } - static member Top(inset) = {top = 0; left = inset} + static member Top(inset) = { top = 0; left = inset } member p.PlaceAt(inset, index) = //printf "p.top = %d, p.left = %d, inset = %d, index = %d\n" p.top p.left inset index - let left = inset + (( (p.left - inset) + index) % (Console.BufferWidth - inset)) - let top = p.top + ( (p.left - inset) + index) / (Console.BufferWidth - inset) - Cursor.ResetTo(top,left) + let left = inset + (((p.left - inset) + index) % (Console.BufferWidth - inset)) + let top = p.top + ((p.left - inset) + index) / (Console.BufferWidth - inset) + Cursor.ResetTo(top, left) type internal ReadLineConsole() = let history = new History() - let mutable complete : (string option * string -> seq) = fun (_s1,_s2) -> Seq.empty + + let mutable complete: (string option * string -> seq) = + fun (_s1, _s2) -> Seq.empty member _.SetCompletionFunction f = complete <- f @@ -114,24 +157,34 @@ type internal ReadLineConsole() = member x.Inset = x.Prompt.Length - member _.GetOptions(input:string) = + member _.GetOptions(input: string) = /// Tab optionsCache available in current context let optionsCache = new Options() let rec look parenCount i = - if i <= 0 then i else - match input.Chars(i - 1) with - | c when Char.IsLetterOrDigit(c) (* or Char.IsWhiteSpace(c) *) -> look parenCount (i-1) - | '.' | '_' -> look parenCount (i-1) - | '}' | ')' | ']' -> look (parenCount+1) (i-1) - | '(' | '{' | '[' -> look (parenCount-1) (i-1) - | _ when parenCount > 0 -> look parenCount (i-1) - | _ -> i + if i <= 0 then + i + else + match input.Chars(i - 1) with + | c when Char.IsLetterOrDigit(c) (* or Char.IsWhiteSpace(c) *) -> look parenCount (i - 1) + | '.' + | '_' -> look parenCount (i - 1) + | '}' + | ')' + | ']' -> look (parenCount + 1) (i - 1) + | '(' + | '{' + | '[' -> look (parenCount - 1) (i - 1) + | _ when parenCount > 0 -> look parenCount (i - 1) + | _ -> i + let start = look 0 input.Length let name = input.Substring(start, input.Length - start) + if name.Trim().Length > 0 then let lastDot = name.LastIndexOf('.') + let attr, pref, root = if (lastDot < 0) then None, name, input.Substring(0, start) @@ -141,20 +194,21 @@ type internal ReadLineConsole() = input.Substring(0, start + lastDot + 1) try - complete(attr,pref) - |> Seq.filter(fun option -> option.StartsWith(pref,StringComparison.Ordinal)) + complete (attr, pref) + |> Seq.filter (fun option -> option.StartsWith(pref, StringComparison.Ordinal)) |> Seq.iter (fun option -> optionsCache.Add(option)) - optionsCache.Root <-root - with _ -> - optionsCache.Clear() - optionsCache,true + optionsCache.Root <- root + with + | _ -> optionsCache.Clear() + + optionsCache, true else - optionsCache,false + optionsCache, false member _.MapCharacter(c) : string = match c with - | '\x1A'-> "^Z" + | '\x1A' -> "^Z" | _ -> "^?" member x.GetCharacterSize(c) = @@ -169,9 +223,17 @@ type internal ReadLineConsole() = let checkLeftEdge prompt = let currLeft = Console.CursorLeft + if currLeft < x.Inset then - if currLeft = 0 then Console.Write (if prompt then x.Prompt2 else String(' ',x.Inset)) - Utils.guard(fun () -> + if currLeft = 0 then + Console.Write( + if prompt then + x.Prompt2 + else + String(' ', x.Inset) + ) + + Utils.guard (fun () -> Console.CursorTop <- min Console.CursorTop (Console.BufferHeight - 1) Console.CursorLeft <- x.Inset) @@ -191,15 +253,18 @@ type internal ReadLineConsole() = /// Cache of optionsCache let mutable optionsCache = Options() - let writeBlank() = + let writeBlank () = Console.Write(' ') checkLeftEdge false - let writeChar(c) = - if Console.CursorTop = Console.BufferHeight - 1 && Console.CursorLeft = Console.BufferWidth - 1 then + let writeChar (c) = + if Console.CursorTop = Console.BufferHeight - 1 + && Console.CursorLeft = Console.BufferWidth - 1 then //printf "bottom right!\n" anchor <- { anchor with top = (anchor).top - 1 } + checkLeftEdge true + if Char.IsControl(c) then let s = x.MapCharacter c Console.Write(s) @@ -207,6 +272,7 @@ type internal ReadLineConsole() = else Console.Write(c) rendered <- rendered + 1 + checkLeftEdge true /// The console input buffer. @@ -215,16 +281,19 @@ type internal ReadLineConsole() = /// Current position - index into the input buffer let mutable current = 0 - let render() = + let render () = //printf "render\n" let curr = current - anchor.PlaceAt(x.Inset,0) + anchor.PlaceAt(x.Inset, 0) let output = new StringBuilder() let mutable position = -1 + for i = 0 to input.Length - 1 do if (i = curr) then position <- output.Length + let c = input.Chars(i) + if (Char.IsControl c) then output.Append(x.MapCharacter c) |> ignore else @@ -236,249 +305,265 @@ type internal ReadLineConsole() = // render the current text, computing a new value for "rendered" let old_rendered = rendered rendered <- 0 + for i = 0 to input.Length - 1 do - writeChar(input.Chars(i)) + writeChar (input.Chars(i)) // blank out any dangling old text for i = rendered to old_rendered - 1 do - writeBlank() + writeBlank () - anchor.PlaceAt(x.Inset,position) + anchor.PlaceAt(x.Inset, position) - render() + render () - let insertChar(c:char) = - if current = input.Length then + let insertChar (c: char) = + if current = input.Length then current <- current + 1 input.Append(c) |> ignore - writeChar(c) + writeChar (c) else input.Insert(current, c) |> ignore current <- current + 1 - render() + render () - let insertTab() = + let insertTab () = for i = ReadLineConsole.TabSize - (current % ReadLineConsole.TabSize) downto 1 do - insertChar(' ') + insertChar (' ') - let moveLeft() = + let moveLeft () = if current > 0 && (current - 1 < input.Length) then current <- current - 1 let c = input.Chars(current) - Cursor.Move(x.Inset, - x.GetCharacterSize c) + Cursor.Move(x.Inset, -x.GetCharacterSize c) - let moveRight() = + let moveRight () = if current < input.Length then let c = input.Chars(current) current <- current + 1 Cursor.Move(x.Inset, x.GetCharacterSize c) - - let moveWordLeft() = + + let moveWordLeft () = if current > 0 && (current - 1 < input.Length) then let line = input.ToString() current <- Utils.previousWordFromIdx line (current - 1, false) anchor.PlaceAt(x.Inset, current) - - let moveWordRight() = + + let moveWordRight () = if current < input.Length then let line = input.ToString() let idxToMoveTo = Utils.nextWordFromIdx line (current + 1, false) - + // if has reached end of the last word - if idxToMoveTo = current && current < line.Length - then current <- line.Length - else current <- idxToMoveTo - + if idxToMoveTo = current && current < line.Length then + current <- line.Length + else + current <- idxToMoveTo + anchor.PlaceAt(x.Inset, current) - let setInput(line:string) = + let setInput (line: string) = input.Length <- 0 input.Append(line) |> ignore current <- input.Length - render() + render () - let tabPress(shift) = - let opts,prefix = + let tabPress (shift) = + let opts, prefix = if changed then changed <- false x.GetOptions(input.ToString()) else - optionsCache,false + optionsCache, false + optionsCache <- opts if (opts.Count > 0) then let part = - if shift - then opts.Previous() - else opts.Next() - setInput(opts.Root + part) + if shift then + opts.Previous() + else + opts.Next() + + setInput (opts.Root + part) + else if (prefix) then + Console.Beep() else - if (prefix) then - Console.Beep() - else - insertTab() + insertTab () - let delete() = + let delete () = if (input.Length > 0 && current < input.Length) then input.Remove(current, 1) |> ignore - render() - - let deleteFromStartOfLineToCursor() = + render () + + let deleteFromStartOfLineToCursor () = if (input.Length > 0 && current > 0) then - input.Remove (0, current) |> ignore + input.Remove(0, current) |> ignore current <- 0 - render() - - let deleteWordLeadingToCursor() = + render () + + let deleteWordLeadingToCursor () = if (input.Length > 0 && current > 0) then let line = input.ToString() let idx = Utils.previousWordFromIdx line (current - 1, false) input.Remove(idx, current - idx) |> ignore current <- idx - render() + render () - let deleteToEndOfLine() = + let deleteToEndOfLine () = if (current < input.Length) then - input.Remove (current, input.Length - current) |> ignore - render() + input.Remove(current, input.Length - current) |> ignore + render () - let insert(key: ConsoleKeyInfo) = + let insert (key: ConsoleKeyInfo) = // 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 - insertChar(c) - - let backspace() = + let c = + if (key.Key = ConsoleKey.F6) then + '\x1A' + else + key.KeyChar + + insertChar (c) + + let backspace () = if (input.Length > 0 && current > 0) then input.Remove(current - 1, 1) |> ignore current <- current - 1 - render() + render () - let enter() = + let enter () = Console.Write("\n") let line = input.ToString() - if (line = "\x1A") then null - else - if (line.Length > 0) then + + if (line = "\x1A") then + null + else + if (line.Length > 0) then history.AddLast(line) + line - let clear() = + let clear () = current <- input.Length - let setPrompt prompt = + + let setPrompt prompt = if prompt then // We only allow clearing if prompt is ">" Console.Clear() - Console.Write (x.Prompt) + Console.Write(x.Prompt) Console.Write(input.ToString()) - anchor <- Anchor.Top(x.Inset) + anchor <- Anchor.Top(x.Inset) + let previous = history.Previous() history.Next() |> ignore + if previous = "" then setPrompt true else setPrompt (previous.EndsWith(";;")) - - let home() = + + let home () = current <- 0 - anchor.PlaceAt(x.Inset,0) - let rec read() = + anchor.PlaceAt(x.Inset, 0) + + let rec read () = let key = Console.ReadKey true match key.Key with | ConsoleKey.Backspace -> - backspace() - change() + backspace () + change () | ConsoleKey.Delete -> - delete() - change() - | ConsoleKey.Enter -> - enter() + delete () + change () + | ConsoleKey.Enter -> enter () | ConsoleKey.Tab -> - tabPress(key.Modifiers &&& ConsoleModifiers.Shift <> enum 0) - read() + tabPress (key.Modifiers &&& ConsoleModifiers.Shift <> enum 0) + read () | ConsoleKey.UpArrow -> - setInput(history.Previous()) - change() + setInput (history.Previous()) + change () | ConsoleKey.DownArrow -> - setInput(history.Next()) - change() + setInput (history.Next()) + change () | ConsoleKey.RightArrow when key.Modifiers &&& ConsoleModifiers.Control = enum 0 -> - moveRight() - change() + moveRight () + change () | ConsoleKey.LeftArrow when key.Modifiers &&& ConsoleModifiers.Control = enum 0 -> - moveLeft() - change() + moveLeft () + change () | ConsoleKey.Escape -> setInput String.Empty - change() + change () | ConsoleKey.Home -> - home() - change() - | ConsoleKey.End -> - current <- input.Length - anchor.PlaceAt(x.Inset,rendered) - change() - | _ -> - - match key.Modifiers, key.Key with - | ConsoleModifiers.Control, ConsoleKey.A -> - home() + home () change () - | ConsoleModifiers.Control, ConsoleKey.E -> + | ConsoleKey.End -> current <- input.Length anchor.PlaceAt(x.Inset, rendered) change () - | ConsoleModifiers.Control, ConsoleKey.B -> - moveLeft() - change () - | ConsoleModifiers.Control, ConsoleKey.F -> - moveRight() - change () - | ConsoleModifiers.Control, ConsoleKey.LeftArrow - | ConsoleModifiers.Alt, ConsoleKey.B -> - moveWordLeft() - change () - | ConsoleModifiers.Control, ConsoleKey.RightArrow - | ConsoleModifiers.Alt, ConsoleKey.F -> - moveWordRight() - change () - | ConsoleModifiers.Control, ConsoleKey.K -> - deleteToEndOfLine() - change() - | ConsoleModifiers.Control,ConsoleKey.P -> - setInput(history.Previous()) - change() - | ConsoleModifiers.Control, ConsoleKey.N -> - setInput(history.Next()) - change() - | ConsoleModifiers.Control, ConsoleKey.D -> - if (input.Length = 0) then - exit 0 //quit - else - delete() - change() - | ConsoleModifiers.Control, ConsoleKey.L -> - clear() - change() - | ConsoleModifiers.Control, ConsoleKey.U -> - deleteFromStartOfLineToCursor() - change() - | ConsoleModifiers.Control, ConsoleKey.W -> - deleteWordLeadingToCursor() - change() | _ -> - // Note: If KeyChar=0, the not a proper char, e.g. it could be part of a multi key-press character, - // e.g. e-acute is ' and e with the French (Belgium) IME and US Intl KB. - // Here: skip KeyChar=0 (except for F6 which maps to 0x1A (ctrl-Z?)). - if key.KeyChar <> '\000' || key.Key = ConsoleKey.F6 then - insert(key) - change() - else - // Skip and read again. - read() - and change() = - changed <- true - read() - read() + match key.Modifiers, key.Key with + | ConsoleModifiers.Control, ConsoleKey.A -> + home () + change () + | ConsoleModifiers.Control, ConsoleKey.E -> + current <- input.Length + anchor.PlaceAt(x.Inset, rendered) + change () + | ConsoleModifiers.Control, ConsoleKey.B -> + moveLeft () + change () + | ConsoleModifiers.Control, ConsoleKey.F -> + moveRight () + change () + | ConsoleModifiers.Control, ConsoleKey.LeftArrow + | ConsoleModifiers.Alt, ConsoleKey.B -> + moveWordLeft () + change () + | ConsoleModifiers.Control, ConsoleKey.RightArrow + | ConsoleModifiers.Alt, ConsoleKey.F -> + moveWordRight () + change () + | ConsoleModifiers.Control, ConsoleKey.K -> + deleteToEndOfLine () + change () + | ConsoleModifiers.Control, ConsoleKey.P -> + setInput (history.Previous()) + change () + | ConsoleModifiers.Control, ConsoleKey.N -> + setInput (history.Next()) + change () + | ConsoleModifiers.Control, ConsoleKey.D -> + if (input.Length = 0) then + exit 0 //quit + else + delete () + change () + | ConsoleModifiers.Control, ConsoleKey.L -> + clear () + change () + | ConsoleModifiers.Control, ConsoleKey.U -> + deleteFromStartOfLineToCursor () + change () + | ConsoleModifiers.Control, ConsoleKey.W -> + deleteWordLeadingToCursor () + change () + | _ -> + // Note: If KeyChar=0, the not a proper char, e.g. it could be part of a multi key-press character, + // e.g. e-acute is ' and e with the French (Belgium) IME and US Intl KB. + // Here: skip KeyChar=0 (except for F6 which maps to 0x1A (ctrl-Z?)). + if key.KeyChar <> '\000' || key.Key = ConsoleKey.F6 then + insert (key) + change () + else + // Skip and read again. + read () + + and change () = + changed <- true + read () + + read () diff --git a/src/fsi/fsimain.fs b/src/fsi/fsimain.fs index f5975dc0282..3cad37941ac 100644 --- a/src/fsi/fsimain.fs +++ b/src/fsi/fsimain.fs @@ -1,12 +1,11 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - // This file provides the actual entry point for fsi.exe. // -// Configure the F# Interactive Session to +// Configure the F# Interactive Session to // 1. use a WinForms event loop (introduces a System.Windows.Forms.dll dependency) // 2. provide a remoting connection for the use of editor-hosted sessions (introduces a System.Remoting dependency) -// 3. connect the configuration to the global state programmer-settable settings in FSharp.Compiler.Interactive.Settings.dll +// 3. connect the configuration to the global state programmer-settable settings in FSharp.Compiler.Interactive.Settings.dll // 4. implement shadow copy of references module internal Sample.FSharp.Compiler.Interactive.Main @@ -30,110 +29,140 @@ open FSharp.Compiler.CodeAnalysis #nowarn "55" #nowarn "40" // let rec on value 'fsiConfig' - // Hardbinding dependencies should we NGEN fsi.exe -[] do () -[] do () +[] +do () + +[] +do () // Standard attributes [] -[] -do() - +[] +do () /// Set the current ui culture for the current thread. -let internal SetCurrentUICultureForThread (lcid : int option) = +let internal SetCurrentUICultureForThread (lcid: int option) = let culture = Thread.CurrentThread.CurrentUICulture + match lcid with | Some n -> Thread.CurrentThread.CurrentUICulture <- new CultureInfo(n) | None -> () - { new IDisposable with member x.Dispose() = Thread.CurrentThread.CurrentUICulture <- culture } -let callStaticMethod (ty:Type) name args = - ty.InvokeMember(name, (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic), null, null, Array.ofList args,Globalization.CultureInfo.InvariantCulture) + { new IDisposable with + member x.Dispose() = + Thread.CurrentThread.CurrentUICulture <- culture + } + +let callStaticMethod (ty: Type) name args = + ty.InvokeMember( + name, + (BindingFlags.InvokeMethod + ||| BindingFlags.Static + ||| BindingFlags.Public + ||| BindingFlags.NonPublic), + null, + null, + Array.ofList args, + Globalization.CultureInfo.InvariantCulture + ) #if !FX_NO_WINFORMS ///Use a dummy to access protected member -type internal DummyForm() = - inherit Form() - member x.DoCreateHandle() = x.CreateHandle() +type internal DummyForm() = + inherit Form() + member x.DoCreateHandle() = x.CreateHandle() + /// Creating the dummy form object can crash on Mono Mac, and then prints a nasty background /// error during finalization of the half-initialized object... override x.Finalize() = () - + /// This is the event loop implementation for winforms -type WinFormsEventLoop() = - let mainForm = new DummyForm() +type WinFormsEventLoop() = + let mainForm = new DummyForm() do mainForm.DoCreateHandle() let mutable lcid = None // Set the default thread exception handler let mutable restart = false - member _.LCID with get () = lcid and set v = lcid <- v + + member _.LCID + with get () = lcid + and set v = lcid <- v + interface IEventLoop with - member x.Run() = - restart <- false - Application.Run() - restart - member x.Invoke (f: unit -> 'T) : 'T = - if not mainForm.InvokeRequired then - f() + member x.Run() = + restart <- false + Application.Run() + restart + + member x.Invoke(f: unit -> 'T) : 'T = + if not mainForm.InvokeRequired then + f () else - // Workaround: Mono's Control.Invoke returns a null result. Hence avoid the problem by + // Workaround: Mono's Control.Invoke returns a null result. Hence avoid the problem by // transferring the resulting state using a mutable location. let mutable mainFormInvokeResultHolder = None // Actually, Mono's Control.Invoke isn't even blocking (or wasn't on 1.1.15)! So use a signal to indicate completion. - // Indeed, we should probably do this anyway with a timeout so we can report progress from + // Indeed, we should probably do this anyway with a timeout so we can report progress from // the GUI thread. use doneSignal = new AutoResetEvent(false) - // BLOCKING: This blocks the stdin-reader thread until the // form invocation has completed. NOTE: does not block on Mono, or did not on 1.1.15 - mainForm.Invoke(new MethodInvoker(fun () -> - try - // When we get called back, someone may jack our culture - // So we must reset our UI culture every time - use _scope = SetCurrentUICultureForThread lcid - mainFormInvokeResultHolder <- Some(f ()) - finally - doneSignal.Set() |> ignore)) |> ignore + mainForm.Invoke( + new MethodInvoker(fun () -> + try + // When we get called back, someone may jack our culture + // So we must reset our UI culture every time + use _scope = SetCurrentUICultureForThread lcid + mainFormInvokeResultHolder <- Some(f ()) + finally + doneSignal.Set() |> ignore) + ) + |> ignore //if !progress then fprintfn outWriter "RunCodeOnWinFormsMainThread: Waiting for completion signal...." - while not (doneSignal.WaitOne(new TimeSpan(0,0,1),true)) do + while not (doneSignal.WaitOne(new TimeSpan(0, 0, 1), true)) do () // if !progress then fprintf outWriter "." outWriter.Flush() //if !progress then fprintfn outWriter "RunCodeOnWinFormsMainThread: Got completion signal, res = %b" (Option.isSome !mainFormInvokeResultHolder) mainFormInvokeResultHolder |> Option.get - member x.ScheduleRestart() = restart <- true; Application.Exit() + member x.ScheduleRestart() = + restart <- true + Application.Exit() /// Try to set the unhandled exception mode of System.Windows.Forms -let internal TrySetUnhandledExceptionMode() = - let i = ref 0 // stop inlining - try - Application.SetUnhandledExceptionMode(UnhandledExceptionMode.CatchException) - with _ -> - decr i;() +let internal TrySetUnhandledExceptionMode () = + let i = ref 0 // stop inlining + + try + Application.SetUnhandledExceptionMode(UnhandledExceptionMode.CatchException) + with + | _ -> + decr i + () #endif /// Starts the remoting server to handle interrupt reuests from a host tool. -let StartServer (fsiSession : FsiEvaluationSession) (fsiServerName) = +let StartServer (fsiSession: FsiEvaluationSession) (fsiServerName) = #if FSI_SERVER let server = - {new Server.Shared.FSharpInteractiveServer() with - member _.Interrupt() = - //printf "FSI-SERVER: received CTRL-C request...\n" - try - fsiSession.Interrupt() - with _ -> - // Final sanity check! - catch all exns - but not expected - assert false - () + { new Server.Shared.FSharpInteractiveServer() with + member _.Interrupt() = + //printf "FSI-SERVER: received CTRL-C request...\n" + try + fsiSession.Interrupt() + with + | _ -> + // Final sanity check! - catch all exns - but not expected + assert false + () } - Server.Shared.FSharpInteractiveServer.StartServer(fsiServerName,server) + Server.Shared.FSharpInteractiveServer.StartServer(fsiServerName, server) #else ignore (fsiSession, fsiServerName) #endif @@ -142,9 +171,9 @@ let StartServer (fsiSession : FsiEvaluationSession) (fsiServerName) = // GUI runCodeOnMainThread //---------------------------------------------------------------------------- -let evaluateSession(argv: string[]) = -#if DEBUG - if argv |> Array.exists (fun x -> x = "/pause" || x = "--pause") then +let evaluateSession (argv: string[]) = +#if DEBUG + if argv |> Array.exists (fun x -> x = "/pause" || x = "--pause") then Console.WriteLine("Press any key to continue...") Console.ReadKey() |> ignore #endif @@ -153,7 +182,7 @@ let evaluateSession(argv: string[]) = // Otherwise, unicode gets lost during redirection. // It is required only under Net4.5 or above (with unicode console feature). if argv |> Array.exists (fun x -> x.Contains "fsi-server") then - Console.InputEncoding <- System.Text.Encoding.UTF8 + Console.InputEncoding <- System.Text.Encoding.UTF8 Console.OutputEncoding <- System.Text.Encoding.UTF8 try @@ -161,27 +190,30 @@ let evaluateSession(argv: string[]) = let console = new FSharp.Compiler.Interactive.ReadLineConsole() // Define the function we pass to the FsiEvaluationSession - let getConsoleReadLine (probeToSeeIfConsoleWorks) = + let getConsoleReadLine (probeToSeeIfConsoleWorks) = let consoleIsOperational = - if probeToSeeIfConsoleWorks then - //if progress then fprintfn outWriter "probing to see if console works..." - try - // Probe to see if the console looks functional on this version of .NET - let _ = Console.KeyAvailable - let _ = Console.ForegroundColor - let _ = Console.CursorLeft <- Console.CursorLeft + if probeToSeeIfConsoleWorks then + //if progress then fprintfn outWriter "probing to see if console works..." + try + // Probe to see if the console looks functional on this version of .NET + let _ = Console.KeyAvailable + let _ = Console.ForegroundColor + let _ = Console.CursorLeft <- Console.CursorLeft + true + with + | _ -> + //if progress then fprintfn outWriter "probe failed, we have no console..." + false + else true - with _ -> - //if progress then fprintfn outWriter "probe failed, we have no console..." - false - else true - if consoleIsOperational then - Some (fun () -> console.ReadLine()) + + if consoleIsOperational then + Some(fun () -> console.ReadLine()) else None - -//#if USE_FSharp_Compiler_Interactive_Settings - let fsiObjOpt = + + //#if USE_FSharp_Compiler_Interactive_Settings + let fsiObjOpt = let defaultFSharpBinariesDir = #if FX_NO_APP_DOMAINS System.AppContext.BaseDirectory @@ -189,155 +221,221 @@ let evaluateSession(argv: string[]) = System.AppDomain.CurrentDomain.BaseDirectory #endif // We use LoadFrom to make sure we get the copy of this assembly from the right load context - let fsiAssemblyPath = Path.Combine(defaultFSharpBinariesDir,"FSharp.Compiler.Interactive.Settings.dll") + let fsiAssemblyPath = + Path.Combine(defaultFSharpBinariesDir, "FSharp.Compiler.Interactive.Settings.dll") + let fsiAssembly = Assembly.LoadFrom(fsiAssemblyPath) - if isNull fsiAssembly then + + if isNull fsiAssembly then None else let fsiTy = fsiAssembly.GetType("FSharp.Compiler.Interactive.Settings") - if isNull fsiAssembly then failwith "failed to find type FSharp.Compiler.Interactive.Settings in FSharp.Compiler.Interactive.Settings.dll" - Some (callStaticMethod fsiTy "get_fsi" [ ]) - - let fsiConfig0 = - match fsiObjOpt with + + if isNull fsiAssembly then + failwith + "failed to find type FSharp.Compiler.Interactive.Settings in FSharp.Compiler.Interactive.Settings.dll" + + Some(callStaticMethod fsiTy "get_fsi" []) + + let fsiConfig0 = + match fsiObjOpt with | None -> FsiEvaluationSession.GetDefaultConfiguration() | Some fsiObj -> FsiEvaluationSession.GetDefaultConfiguration(fsiObj, true) -//fsiSession.LCID + //fsiSession.LCID #if !FX_NO_WINFORMS // Create the WinForms event loop - let fsiWinFormsLoop = - lazy - try Some (WinFormsEventLoop()) - 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" - printfn "UI toolkits. Drop the --gui argument if no event loop is required." - None + let fsiWinFormsLoop = + lazy + try + Some(WinFormsEventLoop()) + 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" + printfn "UI toolkits. Drop the --gui argument if no event loop is required." + None #endif - let legacyReferenceResolver = + let legacyReferenceResolver = #if CROSS_PLATFORM_COMPILER SimulatedMSBuildReferenceResolver.SimulatedMSBuildResolver #else - LegacyMSBuildReferenceResolver.getResolver() + LegacyMSBuildReferenceResolver.getResolver () #endif // Update the configuration to include 'StartServer', WinFormsEventLoop and 'GetOptionalConsoleReadLine()' - let rec fsiConfig = - { new FsiEvaluationSessionHostConfig () with + let rec fsiConfig = + { new FsiEvaluationSessionHostConfig() with member _.FormatProvider = fsiConfig0.FormatProvider member _.FloatingPointFormat = fsiConfig0.FloatingPointFormat member _.AddedPrinters = fsiConfig0.AddedPrinters member _.ShowDeclarationValues = fsiConfig0.ShowDeclarationValues member _.ShowIEnumerable = fsiConfig0.ShowIEnumerable member _.ShowProperties = fsiConfig0.ShowProperties - member _.PrintSize = fsiConfig0.PrintSize + member _.PrintSize = fsiConfig0.PrintSize member _.PrintDepth = fsiConfig0.PrintDepth member _.PrintWidth = fsiConfig0.PrintWidth member _.PrintLength = fsiConfig0.PrintLength - member _.ReportUserCommandLineArgs args = fsiConfig0.ReportUserCommandLineArgs args - member _.EventLoopRun() = + + member _.ReportUserCommandLineArgs args = + fsiConfig0.ReportUserCommandLineArgs args + + 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 fsiConfig0.EventLoopRun() - member _.EventLoopInvoke(f) = + + 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 fsiConfig0.EventLoopInvoke(f) - member _.EventLoopScheduleRestart() = + + 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 fsiConfig0.EventLoopScheduleRestart() member _.UseFsiAuxLib = fsiConfig0.UseFsiAuxLib member _.StartServer(fsiServerName) = StartServer fsiSession fsiServerName - + // Connect the configuration through to the 'fsi' Event loop - member _.GetOptionalConsoleReadLine(probe) = getConsoleReadLine(probe) } + member _.GetOptionalConsoleReadLine(probe) = getConsoleReadLine (probe) + } // Create the console - and fsiSession : FsiEvaluationSession = FsiEvaluationSession.Create (fsiConfig, argv, Console.In, Console.Out, Console.Error, collectible=false, legacyReferenceResolver=legacyReferenceResolver) - + and fsiSession: FsiEvaluationSession = + FsiEvaluationSession.Create( + fsiConfig, + argv, + Console.In, + Console.Out, + Console.Error, + collectible = false, + legacyReferenceResolver = legacyReferenceResolver + ) #if !FX_NO_WINFORMS // Configure some remaining parameters of the GUI support - if fsiSession.IsGui then - try - Application.EnableVisualStyles() - with _ -> - () + if fsiSession.IsGui then + try + Application.EnableVisualStyles() + with + | _ -> () // Route GUI application exceptions to the exception handlers - Application.add_ThreadException(new ThreadExceptionEventHandler(fun _ args -> fsiSession.ReportUnhandledException args.Exception)); + Application.add_ThreadException ( + new ThreadExceptionEventHandler(fun _ args -> fsiSession.ReportUnhandledException args.Exception) + ) - let runningOnMono = try System.Type.GetType("Mono.Runtime") <> null with e-> false - if not runningOnMono then - try - TrySetUnhandledExceptionMode() - with _ -> - () + let runningOnMono = + try + System.Type.GetType("Mono.Runtime") <> null + with + | e -> false + + if not runningOnMono then + try + TrySetUnhandledExceptionMode() + with + | _ -> () fsiWinFormsLoop.Value |> Option.iter (fun l -> l.LCID <- fsiSession.LCID) #endif // Setup the completion function for intellisense in the console - console.SetCompletionFunction(fun (s1,s2) -> fsiSession.GetCompletions (match s1 with | Some s -> s + "." + s2 | None -> s2)) - + console.SetCompletionFunction(fun (s1, s2) -> + fsiSession.GetCompletions( + match s1 with + | Some s -> s + "." + s2 + | None -> s2 + )) + // Start the session - fsiSession.Run() + fsiSession.Run() 0 - with + with | FSharp.Compiler.DiagnosticsLogger.StopProcessingExn _ -> 1 | FSharp.Compiler.DiagnosticsLogger.ReportedError _ -> 1 - | e -> eprintf "Exception by fsi.exe:\n%+A\n" e; 1 + | e -> + eprintf "Exception by fsi.exe:\n%+A\n" e + 1 // Mark the main thread as STAThread since it is a GUI thread // We only set this for the desktop build of fsi.exe. When we run on the coreclr we choose not to rely // On apartment threads. A windows NanoServer docker container does not support apartment thread #if !FX_NO_WINFORMS -[] +[] #endif [] [] -let MainMain argv = +let MainMain argv = ignore argv let argv = System.Environment.GetCommandLineArgs() let savedOut = Console.Out + use __ = { new IDisposable with member _.Dispose() = - try + try Console.SetOut(savedOut) - with _ -> ()} + with + | _ -> () + } #if !FX_NO_APP_DOMAINS - let timesFlag = argv |> Array.exists (fun x -> x = "/times" || x = "--times") - if timesFlag then - AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> + let timesFlag = argv |> Array.exists (fun x -> x = "/times" || x = "--times") + + if timesFlag then + AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> let stats = ILBinaryReader.GetStatistics() - printfn "STATS: #ByteArrayFile = %d, #MemoryMappedFileOpen = %d, #MemoryMappedFileClosed = %d, #RawMemoryFile = %d, #WeakByteArrayFile = %d" stats.byteFileCount stats.memoryMapFileOpenedCount stats.memoryMapFileClosedCount stats.rawMemoryFileCount stats.weakByteFileCount) + + printfn + "STATS: #ByteArrayFile = %d, #MemoryMappedFileOpen = %d, #MemoryMappedFileClosed = %d, #RawMemoryFile = %d, #WeakByteArrayFile = %d" + stats.byteFileCount + stats.memoryMapFileOpenedCount + stats.memoryMapFileClosedCount + stats.rawMemoryFileCount + stats.weakByteFileCount) #endif #if FSI_SHADOW_COPY_REFERENCES - let isShadowCopy x = (x = "/shadowcopyreferences" || x = "--shadowcopyreferences" || x = "/shadowcopyreferences+" || x = "--shadowcopyreferences+") - if AppDomain.CurrentDomain.IsDefaultAppDomain() && argv |> Array.exists isShadowCopy then + let isShadowCopy x = + (x = "/shadowcopyreferences" + || x = "--shadowcopyreferences" + || x = "/shadowcopyreferences+" + || x = "--shadowcopyreferences+") + + if AppDomain.CurrentDomain.IsDefaultAppDomain() + && argv |> Array.exists isShadowCopy then let setupInformation = AppDomain.CurrentDomain.SetupInformation setupInformation.ShadowCopyFiles <- "true" let helper = AppDomain.CreateDomain("FSI_Domain", null, setupInformation) - helper.ExecuteAssemblyByName(Assembly.GetExecutingAssembly().GetName()) - else - evaluateSession(argv) + helper.ExecuteAssemblyByName(Assembly.GetExecutingAssembly().GetName()) + else + evaluateSession (argv) #else - evaluateSession(argv) + evaluateSession (argv) #endif diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index f219910cb53..6870a3fbf89 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -120,8 +120,6 @@ - - diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index a5ac8e2f2be..6135b7a3266 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -6340,6 +6340,14 @@ FSharp.Compiler.Syntax.SynExpr+Downcast: FSharp.Compiler.Syntax.SynType get_targ FSharp.Compiler.Syntax.SynExpr+Downcast: FSharp.Compiler.Syntax.SynType targetType FSharp.Compiler.Syntax.SynExpr+Downcast: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+Downcast: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynExpr+Dynamic: FSharp.Compiler.Syntax.SynExpr argExpr +FSharp.Compiler.Syntax.SynExpr+Dynamic: FSharp.Compiler.Syntax.SynExpr funcExpr +FSharp.Compiler.Syntax.SynExpr+Dynamic: FSharp.Compiler.Syntax.SynExpr get_argExpr() +FSharp.Compiler.Syntax.SynExpr+Dynamic: FSharp.Compiler.Syntax.SynExpr get_funcExpr() +FSharp.Compiler.Syntax.SynExpr+Dynamic: FSharp.Compiler.Text.Range get_qmark() +FSharp.Compiler.Syntax.SynExpr+Dynamic: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynExpr+Dynamic: FSharp.Compiler.Text.Range qmark +FSharp.Compiler.Syntax.SynExpr+Dynamic: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynExpr+Fixed: FSharp.Compiler.Syntax.SynExpr expr FSharp.Compiler.Syntax.SynExpr+Fixed: FSharp.Compiler.Syntax.SynExpr get_expr() FSharp.Compiler.Syntax.SynExpr+Fixed: FSharp.Compiler.Text.Range get_range() @@ -6671,6 +6679,7 @@ FSharp.Compiler.Syntax.SynExpr+Tags: Int32 DotIndexedSet FSharp.Compiler.Syntax.SynExpr+Tags: Int32 DotNamedIndexedPropertySet FSharp.Compiler.Syntax.SynExpr+Tags: Int32 DotSet FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Downcast +FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Dynamic FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Fixed FSharp.Compiler.Syntax.SynExpr+Tags: Int32 For FSharp.Compiler.Syntax.SynExpr+Tags: Int32 ForEach @@ -6830,6 +6839,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean IsDotIndexedSet FSharp.Compiler.Syntax.SynExpr: Boolean IsDotNamedIndexedPropertySet FSharp.Compiler.Syntax.SynExpr: Boolean IsDotSet FSharp.Compiler.Syntax.SynExpr: Boolean IsDowncast +FSharp.Compiler.Syntax.SynExpr: Boolean IsDynamic FSharp.Compiler.Syntax.SynExpr: Boolean IsFixed FSharp.Compiler.Syntax.SynExpr: Boolean IsFor FSharp.Compiler.Syntax.SynExpr: Boolean IsForEach @@ -6897,6 +6907,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsDotIndexedSet() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsDotNamedIndexedPropertySet() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsDotSet() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsDowncast() +FSharp.Compiler.Syntax.SynExpr: Boolean get_IsDynamic() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsFixed() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsFor() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsForEach() @@ -6963,6 +6974,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewDotIndexedSet( FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewDotNamedIndexedPropertySet(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynLongIdent, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewDotSet(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynLongIdent, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewDowncast(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewDynamic(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewFixed(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewFor(FSharp.Compiler.Syntax.DebugPointAtFor, FSharp.Compiler.Syntax.DebugPointAtInOrTo, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Syntax.SynExpr, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewForEach(FSharp.Compiler.Syntax.DebugPointAtFor, FSharp.Compiler.Syntax.DebugPointAtInOrTo, FSharp.Compiler.Syntax.SeqExprOnly, Boolean, FSharp.Compiler.Syntax.SynPat, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) @@ -7029,6 +7041,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+DotIndexedSet FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+DotNamedIndexedPropertySet FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+DotSet FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Downcast +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Dynamic FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Fixed FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+For FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+ForEach diff --git a/tests/benchmarks/FCSSourceFiles/FCSSourceFiles.fsproj b/tests/benchmarks/FCSSourceFiles/FCSSourceFiles.fsproj new file mode 100644 index 00000000000..267013c6b41 --- /dev/null +++ b/tests/benchmarks/FCSSourceFiles/FCSSourceFiles.fsproj @@ -0,0 +1,20 @@ + + + + Exe + net6.0 + + + + + + + + + + + + + + + diff --git a/tests/benchmarks/FCSSourceFiles/Program.fs b/tests/benchmarks/FCSSourceFiles/Program.fs new file mode 100644 index 00000000000..a4d90bc2df7 --- /dev/null +++ b/tests/benchmarks/FCSSourceFiles/Program.fs @@ -0,0 +1,934 @@ +open System +open System.Diagnostics +open System.IO +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.Text +open BenchmarkDotNet.Attributes +open BenchmarkDotNet.Running + +module Project = + let nugetCache = + let ps = ProcessStartInfo("dotnet", "nuget locals global-packages -l") + ps.RedirectStandardOutput <- true + ps.RedirectStandardError <- true + let p = Process.Start ps + let stdout = p.StandardOutput.ReadToEnd().Trim() + p.WaitForExit() + stdout.Replace("global-packages:", "").Trim() + + let FSharpCore = + let projectOptions = + { ProjectFileName = __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\FSharp.Core.fsproj" + ProjectId = None + SourceFiles = + [| __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\prim-types-prelude.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\prim-types-prelude.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Core\Debug\netstandard2.1\FSCore.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Core\Debug\netstandard2.1\FSharp.Core.AssemblyInfo.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\prim-types.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\prim-types.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\local.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\local.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\array2.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\array2.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\option.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\option.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\result.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\result.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\collections.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\collections.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\seqcore.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\seqcore.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\seq.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\seq.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\string.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\string.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\list.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\list.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\array.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\array.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\array3.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\array3.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\map.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\map.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\set.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\set.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\reflect.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\reflect.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\math\z.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\math\z.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\sformat.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\sformat.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\printf.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\printf.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\quotations.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\quotations.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\nativeptr.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\nativeptr.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\event.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\event.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\resumable.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\resumable.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\async.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\async.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\tasks.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\tasks.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\eventmodule.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\eventmodule.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\observable.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\observable.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\mailbox.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\mailbox.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\Nullable.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\Nullable.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\Linq.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\Linq.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\MutableTuple.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\QueryExtensions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\Query.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\Query.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\SI.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\fslib-extra-pervasives.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.Core\fslib-extra-pervasives.fs" |] + OtherOptions = + [| sprintf "-o:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\artifacts\obj\FSharp.Core\Debug\netstandard2.1\FSharp.Core.dll" + @"-g" + @"--debug:embedded" + @"--langversion:preview" + @"--noframework" + @"--define:TRACE" + @"--define:FSHARP_CORE" + @"--define:DEBUG" + @"--define:NETSTANDARD" + @"--define:FX_NO_APP_DOMAINS" + @"--define:FX_NO_CORHOST_SIGNER" + @"--define:FX_NO_PDB_READER" + @"--define:FX_NO_PDB_WRITER" + @"--define:FX_NO_SYMBOLSTORE" + @"--define:FX_NO_SYSTEM_CONFIGURATION" + @"--define:FX_NO_WIN_REGISTRY" + @"--define:FX_NO_WINFORMS" + @"--define:FX_RESHAPED_REFEMIT" + @"--define:NETSTANDARD" + @"--define:NETSTANDARD2_1" + @"--define:NETSTANDARD1_0_OR_GREATER" + @"--define:NETSTANDARD1_1_OR_GREATER" + @"--define:NETSTANDARD1_2_OR_GREATER" + @"--define:NETSTANDARD1_3_OR_GREATER" + @"--define:NETSTANDARD1_4_OR_GREATER" + @"--define:NETSTANDARD1_5_OR_GREATER" + @"--define:NETSTANDARD1_6_OR_GREATER" + @"--define:NETSTANDARD2_0_OR_GREATER" + @"--define:NETSTANDARD2_1_OR_GREATER" + sprintf "-doc:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\artifacts\obj\FSharp.Core\Debug\netstandard2.1\FSharp.Core.xml" + @"--publicsign+" + @"--optimize-" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\Microsoft.Win32.Primitives.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\mscorlib.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\netstandard.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.AppContext.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Buffers.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Collections.Concurrent.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Collections.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Collections.NonGeneric.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Collections.Specialized.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.ComponentModel.Composition.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.ComponentModel.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.ComponentModel.EventBasedAsync.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.ComponentModel.Primitives.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.ComponentModel.TypeConverter.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Console.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Core.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Data.Common.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Data.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.Contracts.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.Debug.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.FileVersionInfo.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.Process.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.StackTrace.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.TextWriterTraceListener.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.Tools.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.TraceSource.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Diagnostics.Tracing.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Drawing.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Drawing.Primitives.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Dynamic.Runtime.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Globalization.Calendars.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Globalization.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Globalization.Extensions.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.Compression.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.Compression.FileSystem.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.Compression.ZipFile.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.FileSystem.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.FileSystem.DriveInfo.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.FileSystem.Primitives.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.FileSystem.Watcher.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.IsolatedStorage.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.MemoryMappedFiles.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.Pipes.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.IO.UnmanagedMemoryStream.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Linq.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Linq.Expressions.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Linq.Parallel.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Linq.Queryable.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Memory.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.Http.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.NameResolution.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.NetworkInformation.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.Ping.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.Primitives.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.Requests.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.Security.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.Sockets.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.WebHeaderCollection.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.WebSockets.Client.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Net.WebSockets.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Numerics.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Numerics.Vectors.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.ObjectModel.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Reflection.DispatchProxy.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Reflection.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Reflection.Emit.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Reflection.Emit.ILGeneration.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Reflection.Emit.Lightweight.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Reflection.Extensions.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Reflection.Primitives.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Resources.Reader.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Resources.ResourceManager.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Resources.Writer.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.CompilerServices.VisualC.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.Extensions.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.Handles.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.InteropServices.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.InteropServices.RuntimeInformation.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.Numerics.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.Serialization.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.Serialization.Formatters.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.Serialization.Json.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.Serialization.Primitives.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Runtime.Serialization.Xml.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Security.Claims.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Security.Cryptography.Algorithms.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Security.Cryptography.Csp.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Security.Cryptography.Encoding.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Security.Cryptography.Primitives.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Security.Cryptography.X509Certificates.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Security.Principal.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Security.SecureString.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.ServiceModel.Web.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Text.Encoding.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Text.Encoding.Extensions.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Text.RegularExpressions.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Threading.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Threading.Overlapped.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Threading.Tasks.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Threading.Tasks.Extensions.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Threading.Tasks.Parallel.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Threading.Thread.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Threading.ThreadPool.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Threading.Timer.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Transactions.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.ValueTuple.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Web.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Windows.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.Linq.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.ReaderWriter.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.Serialization.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.XDocument.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.XmlDocument.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.XmlSerializer.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.XPath.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\.dotnet\packs\NETStandard.Library.Ref\2.1.0\ref\netstandard2.1\System.Xml.XPath.XDocument.dll" + @"--target:library" + @"--nowarn:FS2003,62,75,1204,NU5105" + @"--warn:3" + @"--warnaserror:3239,1182,0025" + @"--fullpaths" + @"--flaterrors" + @"--highentropyva+" + @"--targetprofile:netstandard" + @"--nocopyfsharpcore" + @"--deterministic+" + @"--simpleresolution" + @"--nowarn:3384" + @"--warnon:3218" + @"--warnon:1182" + @"--warnon:3390" + @"--warnon:3520" + @"--warnon:1182" + @"--warnon:3390" + @"--nowarn:57" + @"--nowarn:3511" + @"--nowarn:3513" + @"--compiling-fslib" + @"--compiling-fslib-40" + @"--maxerrors:100" + @"--extraoptimizationloops:1" + @"--simpleresolution" |] + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = DateTime.Now + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } + + FSharpReferencedProject.CreateFSharp( + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\bin\FSharp.Core\Debug\netstandard2.1\FSharp.Core.dll", + projectOptions + ) + + let FSharpDependencyManagerNuget = + let projectOptions = + { ProjectFileName = __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.DependencyManager.Nuget\FSharp.DependencyManager.Nuget.fsproj" + ProjectId = None + SourceFiles = + [| __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.DependencyManager.Nuget\Debug\netstandard2.0\FSDependencyManager.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.DependencyManager.Nuget\Debug\netstandard2.0\UtilsStrings.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.DependencyManager.Nuget\Debug\netstandard2.0\FSharp.DependencyManager.Nuget.InternalsVisibleTo.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.DependencyManager.Nuget\Debug\netstandard2.0\FSharp.DependencyManager.Nuget.AssemblyInfo.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\CompilerLocation.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\CompilerLocation.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.DependencyManager.Nuget\FSharp.DependencyManager.ProjectFile.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.DependencyManager.Nuget\FSharp.DependencyManager.Utilities.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.DependencyManager.Nuget\FSharp.DependencyManager.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\FSharp.DependencyManager.Nuget\FSharp.DependencyManager.fs" |] + OtherOptions = + [| sprintf "-o:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\artifacts\obj\FSharp.DependencyManager.Nuget\Debug\netstandard2.0\FSharp.DependencyManager.Nuget.dll" + @"-g" + @"--debug:embedded" + @"--noframework" + @"--define:TRACE" + @"--define:COMPILER" + @"--define:DEBUG" + @"--define:NETSTANDARD" + @"--define:FX_NO_APP_DOMAINS" + @"--define:FX_NO_CORHOST_SIGNER" + @"--define:FX_NO_PDB_READER" + @"--define:FX_NO_PDB_WRITER" + @"--define:FX_NO_SYMBOLSTORE" + @"--define:FX_NO_SYSTEM_CONFIGURATION" + @"--define:FX_NO_WIN_REGISTRY" + @"--define:FX_NO_WINFORMS" + @"--define:FX_RESHAPED_REFEMIT" + @"--define:NETSTANDARD" + @"--define:NETSTANDARD2_0" + @"--define:NETSTANDARD1_0_OR_GREATER" + @"--define:NETSTANDARD1_1_OR_GREATER" + @"--define:NETSTANDARD1_2_OR_GREATER" + @"--define:NETSTANDARD1_3_OR_GREATER" + @"--define:NETSTANDARD1_4_OR_GREATER" + @"--define:NETSTANDARD1_5_OR_GREATER" + @"--define:NETSTANDARD1_6_OR_GREATER" + @"--define:NETSTANDARD2_0_OR_GREATER" + sprintf "-doc:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\artifacts\obj\FSharp.DependencyManager.Nuget\Debug\netstandard2.0\FSharp.DependencyManager.Nuget.xml" + @"--publicsign+" + @"--optimize-" + sprintf "-r:%s%s" nugetCache @"fsharp.core\6.0.1\lib\netstandard2.0\FSharp.Core.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\Microsoft.Win32.Primitives.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\mscorlib.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\netstandard.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.AppContext.dll" + sprintf "-r:%s%s" nugetCache @"system.buffers\4.5.1\ref\netstandard2.0\System.Buffers.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Collections.Concurrent.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Collections.dll" + sprintf "-r:%s%s" nugetCache @"system.collections.immutable\5.0.0\lib\netstandard2.0\System.Collections.Immutable.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Collections.NonGeneric.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Collections.Specialized.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.ComponentModel.Composition.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.ComponentModel.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.ComponentModel.EventBasedAsync.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.ComponentModel.Primitives.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.ComponentModel.TypeConverter.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Console.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Core.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Data.Common.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Data.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.Contracts.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.Debug.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.FileVersionInfo.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.Process.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.StackTrace.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.TextWriterTraceListener.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.Tools.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.TraceSource.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Diagnostics.Tracing.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Drawing.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Drawing.Primitives.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Dynamic.Runtime.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Globalization.Calendars.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Globalization.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Globalization.Extensions.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.Compression.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.Compression.FileSystem.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.Compression.ZipFile.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.FileSystem.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.FileSystem.DriveInfo.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.FileSystem.Primitives.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.FileSystem.Watcher.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.IsolatedStorage.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.MemoryMappedFiles.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.Pipes.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.IO.UnmanagedMemoryStream.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Linq.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Linq.Expressions.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Linq.Parallel.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Linq.Queryable.dll" + sprintf "-r:%s%s" nugetCache @"system.memory\4.5.4\lib\netstandard2.0\System.Memory.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.Http.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.NameResolution.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.NetworkInformation.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.Ping.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.Primitives.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.Requests.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.Security.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.Sockets.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.WebHeaderCollection.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.WebSockets.Client.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Net.WebSockets.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Numerics.dll" + sprintf "-r:%s%s" nugetCache @"system.numerics.vectors\4.4.0\ref\netstandard2.0\System.Numerics.Vectors.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.ObjectModel.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Reflection.dll" + sprintf "-r:%s%s" nugetCache @"system.reflection.emit\4.3.0\ref\netstandard1.1\System.Reflection.Emit.dll" + sprintf "-r:%s%s" nugetCache @"system.reflection.emit.ilgeneration\4.3.0\ref\netstandard1.0\System.Reflection.Emit.ILGeneration.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Reflection.Extensions.dll" + sprintf "-r:%s%s" nugetCache @"system.reflection.metadata\5.0.0\lib\netstandard2.0\System.Reflection.Metadata.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Reflection.Primitives.dll" + sprintf "-r:%s%s" nugetCache @"system.reflection.typeextensions\4.3.0\ref\netstandard1.5\System.Reflection.TypeExtensions.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Resources.Reader.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Resources.ResourceManager.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Resources.Writer.dll" + sprintf "-r:%s%s" nugetCache @"system.runtime.compilerservices.unsafe\6.0.0\lib\netstandard2.0\System.Runtime.CompilerServices.Unsafe.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.CompilerServices.VisualC.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.Extensions.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.Handles.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.InteropServices.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.InteropServices.RuntimeInformation.dll" + sprintf "-r:%s%s" nugetCache @"system.runtime.loader\4.3.0\ref\netstandard1.5\System.Runtime.Loader.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.Numerics.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.Serialization.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.Serialization.Formatters.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.Serialization.Json.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.Serialization.Primitives.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Runtime.Serialization.Xml.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Security.Claims.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Security.Cryptography.Algorithms.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Security.Cryptography.Csp.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Security.Cryptography.Encoding.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Security.Cryptography.Primitives.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Security.Cryptography.X509Certificates.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Security.Principal.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Security.SecureString.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.ServiceModel.Web.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Text.Encoding.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Text.Encoding.Extensions.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Text.RegularExpressions.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Threading.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Threading.Overlapped.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Threading.Tasks.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Threading.Tasks.Parallel.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Threading.Thread.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Threading.ThreadPool.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Threading.Timer.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Transactions.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.ValueTuple.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Web.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Windows.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.Linq.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.ReaderWriter.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.Serialization.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.XDocument.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.XmlDocument.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.XmlSerializer.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.XPath.dll" + sprintf "-r:%s%s" nugetCache @"netstandard.library\2.0.3\build\netstandard2.0\ref\System.Xml.XPath.XDocument.dll" + @"--target:library" + @"--nowarn:FS2003,NU5105" + @"--warn:3" + @"--warnaserror:3239,1182,0025" + @"--fullpaths" + @"--flaterrors" + @"--highentropyva+" + @"--targetprofile:netstandard" + @"--nocopyfsharpcore" + @"--deterministic+" + @"--simpleresolution" + @"--nowarn:3384" + @"--warnon:1182" + @"--simpleresolution" |] + ReferencedProjects = [| FSharpCore |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = DateTime.Now + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } + + FSharpReferencedProject.CreateFSharp( + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\bin\FSharp.DependencyManager.Nuget\Debug\netstandard2.0\FSharp.DependencyManager.Nuget.dll", + projectOptions + ) + + let FSharpCompilerService = + { ProjectFileName = __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\FSharp.Compiler.Service.fsproj" + ProjectId = None + SourceFiles = + [| __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\FSComp.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\FSIstrings.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\UtilsStrings.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\FSharp.Compiler.Service.InternalsVisibleTo.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\FSharp.Compiler.Service.AssemblyInfo.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\sformat.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\sformat.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\sr.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\sr.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\ResizeArray.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\ResizeArray.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\HashMultiMap.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\HashMultiMap.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\EditDistance.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\EditDistance.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\TaggedCollections.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\TaggedCollections.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\illib.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\illib.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\FileSystem.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\FileSystem.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\ildiag.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\ildiag.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\zmap.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\zmap.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\zset.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\zset.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\XmlAdapters.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\XmlAdapters.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\InternalCollections.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\InternalCollections.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\QueueList.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\QueueList.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\lib.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\lib.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\ImmutableArray.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\ImmutableArray.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\rational.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\rational.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\PathMap.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\PathMap.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\RidHelpers.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\range.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Utilities\range.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\Logger.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\Logger.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\LanguageFeatures.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\LanguageFeatures.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\Diagnostics.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\Diagnostics.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\TextLayoutRender.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\TextLayoutRender.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\DiagnosticsLogger.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\DiagnosticsLogger.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\ErrorResolutionHints.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\ErrorResolutionHints.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\prim-lexing.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\prim-lexing.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\prim-parsing.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\prim-parsing.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\ReferenceResolver.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\ReferenceResolver.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\SimulatedMSBuildReferenceResolver.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\SimulatedMSBuildReferenceResolver.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\CompilerLocation.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Facilities\CompilerLocation.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\il.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\il.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilx.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilx.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilascii.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilascii.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\ilpars.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\illex.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilprint.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilprint.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilmorph.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilmorph.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilsign.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilsign.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilnativeres.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilnativeres.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilsupp.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilsupp.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilbinary.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilbinary.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilread.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilread.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilwritepdb.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilwritepdb.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilwrite.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilwrite.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilreflect.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\AbstractIL\ilreflect.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\PrettyNaming.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\PrettyNaming.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\CodeGen\EraseClosures.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\CodeGen\EraseClosures.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\UnicodeLexing.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\UnicodeLexing.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\XmlDoc.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\XmlDoc.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\SyntaxTrivia.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\SyntaxTrivia.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\SyntaxTree.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\SyntaxTree.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\SyntaxTreeOps.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\SyntaxTreeOps.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\ParseHelpers.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\ParseHelpers.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\pppars.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\pars.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\LexHelpers.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\LexHelpers.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\pplex.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\lex.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\LexFilter.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\SyntaxTree\LexFilter.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\tainted.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\tainted.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypeProviders.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypeProviders.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\QuotationPickler.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\QuotationPickler.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\CompilerGlobalState.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\CompilerGlobalState.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypedTree.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypedTreeBasics.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypedTreeBasics.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TcGlobals.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypedTreeOps.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypedTreeOps.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypedTreePickle.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\TypedTree\TypedTreePickle.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\import.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\import.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\TypeHierarchy.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\TypeHierarchy.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\infos.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\infos.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\AccessibilityLogic.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\AccessibilityLogic.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\AttributeChecking.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\AttributeChecking.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\TypeRelations.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\TypeRelations.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\InfoReader.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\InfoReader.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\NicePrint.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\NicePrint.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\AugmentWithHashCompare.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\AugmentWithHashCompare.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\NameResolution.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\NameResolution.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\SignatureConformance.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\SignatureConformance.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\MethodOverrides.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\MethodOverrides.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\MethodCalls.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\MethodCalls.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\PatternMatchCompilation.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\PatternMatchCompilation.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\ConstraintSolver.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\ConstraintSolver.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\CheckFormatStrings.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\CheckFormatStrings.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\FindUnsolved.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\FindUnsolved.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\QuotationTranslator.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\QuotationTranslator.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\PostInferenceChecks.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\PostInferenceChecks.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\CheckExpressions.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\CheckExpressions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\CheckComputationExpressions.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\CheckComputationExpressions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\CheckDeclarations.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Checking\CheckDeclarations.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\Optimizer.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\Optimizer.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\DetupleArgs.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\DetupleArgs.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\InnerLambdasToTopLevelFuncs.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\InnerLambdasToTopLevelFuncs.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerCalls.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerCalls.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerSequences.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerSequences.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerComputedCollections.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerComputedCollections.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerStateMachines.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerStateMachines.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerLocalMutables.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Optimize\LowerLocalMutables.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\CodeGen\EraseUnions.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\CodeGen\EraseUnions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\CodeGen\IlxGen.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\CodeGen\IlxGen.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\FxResolver.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\DependencyManager\AssemblyResolveHandler.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\DependencyManager\AssemblyResolveHandler.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\DependencyManager\NativeDllResolveHandler.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\DependencyManager\NativeDllResolveHandler.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\DependencyManager\DependencyProvider.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\DependencyManager\DependencyProvider.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\BuildGraph.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\BuildGraph.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CompilerConfig.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CompilerConfig.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CompilerImports.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CompilerImports.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CompilerDiagnostics.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CompilerDiagnostics.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\ParseAndCheckInputs.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\ParseAndCheckInputs.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\ScriptClosure.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\ScriptClosure.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CompilerOptions.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CompilerOptions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\OptimizeInputs.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\OptimizeInputs.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\XmlDocFileWriter.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\XmlDocFileWriter.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\BinaryResourceFormats.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\BinaryResourceFormats.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\StaticLinking.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\StaticLinking.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CreateILModule.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\CreateILModule.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\fsc.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Driver\fsc.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\FSharpDiagnostic.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\FSharpDiagnostic.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\SymbolHelpers.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\SymbolHelpers.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\Symbols.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\Symbols.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\Exprs.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\Exprs.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\SymbolPatterns.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Symbols\SymbolPatterns.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\SemanticClassification.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\SemanticClassification.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ItemKey.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ItemKey.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\SemanticClassificationKey.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\SemanticClassificationKey.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\FSharpSource.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\FSharpSource.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\IncrementalBuild.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\IncrementalBuild.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceCompilerDiagnostics.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceCompilerDiagnostics.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceConstants.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceDeclarationLists.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceDeclarationLists.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceLexing.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceLexing.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceParseTreeWalk.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceParseTreeWalk.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceNavigation.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceNavigation.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceParamInfoLocations.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceParamInfoLocations.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\FSharpParseFileResults.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\FSharpParseFileResults.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceParsedInputOps.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceParsedInputOps.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceAssemblyContent.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceAssemblyContent.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceXmlDocParser.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceXmlDocParser.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ExternalSymbol.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ExternalSymbol.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\QuickParse.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\QuickParse.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\FSharpCheckerResults.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\FSharpCheckerResults.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\service.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\service.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceInterfaceStubGenerator.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceInterfaceStubGenerator.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceStructure.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceStructure.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceAnalysis.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Service\ServiceAnalysis.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Interactive\fsi.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Interactive\fsi.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Legacy\LegacyMSBuildReferenceResolver.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Legacy\LegacyMSBuildReferenceResolver.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\src\Compiler\Legacy\LegacyHostedCompilerForTesting.fs" |] + OtherOptions = + [| sprintf "-o:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\FSharp.Compiler.Service.dll" + @"-g" + @"--debug:embedded" + @"--noframework" + @"--define:TRACE" + @"--define:COMPILER" + @"--define:ENABLE_MONO_SUPPORT" + @"--define:DEBUG" + @"--define:ENABLE_MONO_SUPPORT" + @"--define:NETFRAMEWORK" + @"--define:NET472" + @"--define:NET20_OR_GREATER" + @"--define:NET30_OR_GREATER" + @"--define:NET35_OR_GREATER" + @"--define:NET40_OR_GREATER" + @"--define:NET45_OR_GREATER" + @"--define:NET451_OR_GREATER" + @"--define:NET452_OR_GREATER" + @"--define:NET46_OR_GREATER" + @"--define:NET461_OR_GREATER" + @"--define:NET462_OR_GREATER" + @"--define:NET47_OR_GREATER" + @"--define:NET471_OR_GREATER" + @"--define:NET472_OR_GREATER" + sprintf "-doc:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\artifacts\obj\FSharp.Compiler.Service\Debug\net472\FSharp.Compiler.Service.xml" + @"--publicsign+" + @"--optimize-" + sprintf "-r:%s%s" nugetCache @"fsharp.core\6.0.1\lib\netstandard2.0\FSharp.Core.dll" + sprintf "-r:%s%s" __SOURCE_DIRECTORY__ @"\..\..\..\artifacts\bin\FSharp.DependencyManager.Nuget\Debug\netstandard2.0\FSharp.DependencyManager.Nuget.dll" + sprintf "-r:%s%s" nugetCache @"microsoft.build.framework\17.0.0\lib\net472\Microsoft.Build.Framework.dll" + sprintf "-r:%s%s" nugetCache @"microsoft.build.tasks.core\17.0.0\lib\net472\Microsoft.Build.Tasks.Core.dll" + sprintf "-r:%s%s" nugetCache @"microsoft.build.utilities.core\17.0.0\lib\net472\Microsoft.Build.Utilities.Core.dll" + sprintf "-r:%s%s" nugetCache @"microsoft.net.stringtools\1.0.0\lib\net472\Microsoft.NET.StringTools.dll" + sprintf "-r:%s%s" nugetCache @"microsoft.visualstudio.setup.configuration.interop\1.16.30\lib\net35\Microsoft.VisualStudio.Setup.Configuration.Interop.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\mscorlib.dll" + sprintf "-r:%s%s" nugetCache @"system.buffers\4.5.1\ref\net45\System.Buffers.dll" + sprintf "-r:%s%s" nugetCache @"system.collections.immutable\5.0.0\lib\net461\System.Collections.Immutable.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.ComponentModel.Composition.dll" + sprintf "-r:%s%s" nugetCache @"system.configuration.configurationmanager\4.7.0\ref\net461\System.Configuration.ConfigurationManager.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Configuration.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Core.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Data.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Data.OracleClient.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Diagnostics.Process.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Diagnostics.TraceSource.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Drawing.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.IO.Compression.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.IO.Compression.FileSystem.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.IO.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Linq.Expressions.dll" + sprintf "-r:%s%s" nugetCache @"system.memory\4.5.4\lib\net461\System.Memory.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Net.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Net.Http.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Net.Security.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Numerics.dll" + sprintf "-r:%s%s" nugetCache @"system.numerics.vectors\4.5.0\ref\net46\System.Numerics.Vectors.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Reflection.dll" + sprintf "-r:%s%s" nugetCache @"system.reflection.metadata\5.0.0\lib\net461\System.Reflection.Metadata.dll" + sprintf "-r:%s%s" nugetCache @"system.reflection.typeextensions\4.3.0\ref\net462\System.Reflection.TypeExtensions.dll" + sprintf "-r:%s%s" nugetCache @"system.resources.extensions\4.6.0\ref\netstandard2.0\System.Resources.Extensions.dll" + sprintf "-r:%s%s" nugetCache @"system.runtime.compilerservices.unsafe\6.0.0\lib\net461\System.Runtime.CompilerServices.Unsafe.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Runtime.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Runtime.InteropServices.dll" + sprintf "-r:%s%s" nugetCache @"system.runtime.loader\4.3.0\ref\netstandard1.5\System.Runtime.Loader.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Runtime.Serialization.dll" + sprintf "-r:%s%s" nugetCache @"system.security.accesscontrol\4.7.0\ref\net461\System.Security.AccessControl.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Security.Claims.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Security.Cryptography.Algorithms.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Security.Cryptography.Encoding.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Security.Cryptography.Primitives.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Security.Cryptography.X509Certificates.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Security.dll" + sprintf "-r:%s%s" nugetCache @"system.security.permissions\4.7.0\ref\net461\System.Security.Permissions.dll" + sprintf "-r:%s%s" nugetCache @"system.security.principal.windows\4.7.0\ref\net461\System.Security.Principal.Windows.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.ServiceProcess.dll" + sprintf "-r:%s%s" nugetCache @"system.threading.tasks.dataflow\4.9.0\lib\netstandard2.0\System.Threading.Tasks.Dataflow.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Threading.Thread.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\Facades\System.Threading.ThreadPool.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Transactions.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Windows.Forms.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Xaml.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Xml.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\System.Xml.Linq.dll" + @"-r:C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\WindowsBase.dll" + @"--target:library" + @"--nowarn:FS2003,44,57,75,1204,NU5125,NU5105" + @"--warn:3" + @"--warnaserror:3239,1182,0025" + @"--fullpaths" + @"--flaterrors" + @"--subsystemversion:6.00" + @"--highentropyva+" + @"--targetprofile:mscorlib" + @"--nocopyfsharpcore" + @"--deterministic+" + @"--simpleresolution" + @"--nowarn:3384" + @"--extraoptimizationloops:1" + @"--times" + @"--warnon:1182" + @"--warnon:3218" + @"--warnon:3390" |] + ReferencedProjects = + [| FSharpDependencyManagerNuget + FSharpCore |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = DateTime.Now + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } + +[] +type CompilerService() = + let mutable checkerOpt = None + let mutable sourceOpt : (string * ISourceText) array option = None + + let projectOptions = Project.FSharpCompilerService + + [] + member _.Setup() = + match checkerOpt with + | None -> checkerOpt <- Some(FSharpChecker.Create(projectCacheSize = 200)) + | _ -> () + + match sourceOpt with + | None -> + sourceOpt <- + projectOptions.SourceFiles + |> Array.filter (fun filePath -> filePath.EndsWith("CheckDeclarations.fs")) // || filePath.EndsWith("CheckExpressions.fs")) + // || filePath.EndsWith("lex.fs") || filePath.EndsWith("pars.fs")) + |> Array.map (fun filePath -> filePath, SourceText.ofString (File.ReadAllText(filePath))) + |> Some + | _ -> () + + [] + member _.ParseAndCheckFileInProject() = + match checkerOpt, sourceOpt with + | None, _ -> failwith "no checker" + | _, None -> failwith "no source" + | Some checker, Some sourceFiles -> + checker.InvalidateAll() + sourceFiles + |> Array.iter (fun (filePath, sourceText) -> + let _fileResult, _checkResult = + checker.ParseAndCheckFileInProject(filePath, 0, sourceText, projectOptions) + |> Async.RunSynchronously + + () + ) + +[] +let main _ = + BenchmarkRunner.Run() |> ignore + 0 diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 8b1e1bdedce..968f25f572e 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -1164,6 +1164,60 @@ global | idents -> Assert.Fail $"Expected a single SynIdent, got {idents}" | _ -> Assert.Fail $"Could not get valid AST, got {ast}" + [] + let ``SynExpr.Dynamic does contain ident`` () = + let ast = + getParseResults "x?k" + + match ast with + | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Expr(expr = SynExpr.Dynamic (_, _, SynExpr.Ident(idK) ,mDynamicExpr)) + ]) + ])) -> + Assert.AreEqual("k", idK.idText) + assertRange (1,0) (1, 3) mDynamicExpr + | _ -> Assert.Fail $"Could not get valid AST, got {ast}" + + [] + let ``SynExpr.Dynamic does contain parentheses`` () = + let ast = + getParseResults "x?(g)" + + match ast with + | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Expr(expr = + SynExpr.Dynamic (_, _, SynExpr.Paren(SynExpr.Ident(idG), lpr, Some rpr, mParen) ,mDynamicExpr)) + ]) + ])) -> + Assert.AreEqual("g", idG.idText) + assertRange (1, 2) (1,3) lpr + assertRange (1, 4) (1,5) rpr + assertRange (1, 2) (1,5) mParen + assertRange (1,0) (1, 5) mDynamicExpr + | _ -> Assert.Fail $"Could not get valid AST, got {ast}" + + [] + let ``SynExpr.Set with SynExpr.Dynamic`` () = + let ast = + getParseResults "x?v <- 2" + + match ast with + | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.Expr(expr = SynExpr.Set( + SynExpr.Dynamic (_, _, SynExpr.Ident(idV) ,mDynamicExpr), + SynExpr.Const _, + mSetExpr + )) + ]) + ])) -> + Assert.AreEqual("v", idV.idText) + assertRange (1,0) (1, 3) mDynamicExpr + assertRange (1,0) (1, 8) mSetExpr + | _ -> Assert.Fail $"Could not get valid AST, got {ast}" + module Strings = let getBindingExpressionValue (parseResults: ParsedInput) = match parseResults with diff --git a/vsintegration/src/FSharp.LanguageService/Colorize.fs b/vsintegration/src/FSharp.LanguageService/Colorize.fs index 7edbdfaf245..7badc11b7d6 100644 --- a/vsintegration/src/FSharp.LanguageService/Colorize.fs +++ b/vsintegration/src/FSharp.LanguageService/Colorize.fs @@ -265,7 +265,6 @@ type internal FSharpColorizer_DEPRECATED | None -> () } tokens() |> Array.ofSeq - [] // exceeds EndIndex member private c.GetColorInfo(line,lineText,length,lastColorState) = let refState = ref (ColorStateLookup_DEPRECATED.LexStateOfColorState lastColorState) scanner.SetLineText lineText diff --git a/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj b/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj index ceee74dfca1..513e0e7207d 100644 --- a/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj +++ b/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.fsproj @@ -22,8 +22,8 @@ - - CompilerLocationUtils.fs + + CompilerLocation.fs diff --git a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj index a28f52ae592..4b7ef972b0d 100644 --- a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj +++ b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj @@ -16,8 +16,8 @@ - - CompilerLocationUtils.fs + + CompilerLocation.fs UnitTests.TestLib.Utils.fs diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj index 96a268e607e..48639eef66e 100644 --- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj +++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj @@ -24,8 +24,8 @@ Internal.Utilities.Collections.fs - - Internal.Utilities.CompilerLocationUtils.fs + + Internal.Utilities.CompilerLocation.fs