diff --git a/FSharp.Compiler.Service.sln b/FSharp.Compiler.Service.sln index 0f0d871b018..3348e46ca41 100644 --- a/FSharp.Compiler.Service.sln +++ b/FSharp.Compiler.Service.sln @@ -5,9 +5,15 @@ VisualStudioVersion = 16.0.30503.244 MinimumVisualStudioVersion = 10.0.40219.1 Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service", "src\fsharp\FSharp.Compiler.Service\FSharp.Compiler.Service.fsproj", "{A59DB8AE-8044-41A5-848A-800A7FF31C93}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.Tests", "tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj", "{8D9C9683-5041-48AB-8FA9-0939D2D27D33}" +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service.Tests", "tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj", "{8D9C9683-5041-48AB-8FA9-0939D2D27D33}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.DependencyManager.Nuget", "src\fsharp\FSharp.DependencyManager.Nuget\FSharp.DependencyManager.Nuget.fsproj", "{98E7659D-8E0C-489F-B4F5-E12AFC0D1BFA}" +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.DependencyManager.Nuget", "src\fsharp\FSharp.DependencyManager.Nuget\FSharp.DependencyManager.Nuget.fsproj", "{98E7659D-8E0C-489F-B4F5-E12AFC0D1BFA}" +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "FSharp.Compiler.Service.Tests support", "FSharp.Compiler.Service.Tests support", "{875D91AC-BA4C-4191-AB11-AE461DB9B8DB}" +EndProject +Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "CSharp_Analysis", "tests\service\data\CSharp_Analysis\CSharp_Analysis.csproj", "{BFE6E6F1-1B73-404F-A3A5-30B57E5E0731}" +EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "TestTP", "tests\service\data\TestTP\TestTP.fsproj", "{2EF674B9-8B56-4796-9933-42B2629E52C3}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -27,10 +33,22 @@ Global {98E7659D-8E0C-489F-B4F5-E12AFC0D1BFA}.Debug|Any CPU.Build.0 = Debug|Any CPU {98E7659D-8E0C-489F-B4F5-E12AFC0D1BFA}.Release|Any CPU.ActiveCfg = Release|Any CPU {98E7659D-8E0C-489F-B4F5-E12AFC0D1BFA}.Release|Any CPU.Build.0 = Release|Any CPU + {BFE6E6F1-1B73-404F-A3A5-30B57E5E0731}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {BFE6E6F1-1B73-404F-A3A5-30B57E5E0731}.Debug|Any CPU.Build.0 = Debug|Any CPU + {BFE6E6F1-1B73-404F-A3A5-30B57E5E0731}.Release|Any CPU.ActiveCfg = Release|Any CPU + {BFE6E6F1-1B73-404F-A3A5-30B57E5E0731}.Release|Any CPU.Build.0 = Release|Any CPU + {2EF674B9-8B56-4796-9933-42B2629E52C3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {2EF674B9-8B56-4796-9933-42B2629E52C3}.Debug|Any CPU.Build.0 = Debug|Any CPU + {2EF674B9-8B56-4796-9933-42B2629E52C3}.Release|Any CPU.ActiveCfg = Release|Any CPU + {2EF674B9-8B56-4796-9933-42B2629E52C3}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection + GlobalSection(NestedProjects) = preSolution + {BFE6E6F1-1B73-404F-A3A5-30B57E5E0731} = {875D91AC-BA4C-4191-AB11-AE461DB9B8DB} + {2EF674B9-8B56-4796-9933-42B2629E52C3} = {875D91AC-BA4C-4191-AB11-AE461DB9B8DB} + EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {F9A60F3B-D894-4C8E-BA0F-C51115B25A5A} EndGlobalSection diff --git a/FSharp.sln b/FSharp.sln index da837f9b04f..bcbb76848ae 100644 --- a/FSharp.sln +++ b/FSharp.sln @@ -60,6 +60,18 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service.Tes EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service", "src\fsharp\FSharp.Compiler.Service\FSharp.Compiler.Service.fsproj", "{9B4CF83C-C215-4EA0-9F8B-B5A77090F634}" EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "FSharp.Compiler.Service.Tests support", "FSharp.Compiler.Service.Tests support", "{452EED3C-AA87-471F-B9AC-0F4479C5820C}" +EndProject +Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "CSharp_Analysis", "tests\service\data\CSharp_Analysis\CSharp_Analysis.csproj", "{F8743670-C8D4-41B3-86BE-BBB1226C352F}" +EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "TestTP", "tests\service\data\TestTP\TestTP.fsproj", "{7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}" +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Benchmarks", "Benchmarks", "{E02ADBCA-D6C0-4898-A8AA-86DE6EBE2DC2}" +EndProject +Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "MicroPerfCSharp", "tests\benchmarks\MicroPerf\CS\MicroPerfCSharp.csproj", "{2904313F-7782-4522-894C-DC946DFFE22D}" +EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MicroPerf", "tests\benchmarks\MicroPerf\MicroPerf.fsproj", "{C888A81D-2372-4B4A-8BA1-525AEE3918D6}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -298,6 +310,54 @@ Global {9B4CF83C-C215-4EA0-9F8B-B5A77090F634}.Release|Any CPU.Build.0 = Release|Any CPU {9B4CF83C-C215-4EA0-9F8B-B5A77090F634}.Release|x86.ActiveCfg = Release|Any CPU {9B4CF83C-C215-4EA0-9F8B-B5A77090F634}.Release|x86.Build.0 = Release|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Debug|Any CPU.Build.0 = Debug|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Debug|x86.ActiveCfg = Debug|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Debug|x86.Build.0 = Debug|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Proto|Any CPU.ActiveCfg = Debug|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Proto|Any CPU.Build.0 = Debug|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Proto|x86.ActiveCfg = Debug|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Proto|x86.Build.0 = Debug|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Release|Any CPU.ActiveCfg = Release|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Release|Any CPU.Build.0 = Release|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Release|x86.ActiveCfg = Release|Any CPU + {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Release|x86.Build.0 = Release|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Debug|Any CPU.Build.0 = Debug|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Debug|x86.ActiveCfg = Debug|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Debug|x86.Build.0 = Debug|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Proto|Any CPU.ActiveCfg = Debug|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Proto|Any CPU.Build.0 = Debug|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Proto|x86.ActiveCfg = Debug|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Proto|x86.Build.0 = Debug|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Release|Any CPU.ActiveCfg = Release|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Release|Any CPU.Build.0 = Release|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Release|x86.ActiveCfg = Release|Any CPU + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F}.Release|x86.Build.0 = Release|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Debug|Any CPU.Build.0 = Debug|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Debug|x86.ActiveCfg = Debug|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Debug|x86.Build.0 = Debug|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Proto|Any CPU.ActiveCfg = Debug|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Proto|Any CPU.Build.0 = Debug|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Proto|x86.ActiveCfg = Debug|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Proto|x86.Build.0 = Debug|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Release|Any CPU.ActiveCfg = Release|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Release|Any CPU.Build.0 = Release|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Release|x86.ActiveCfg = Release|Any CPU + {2904313F-7782-4522-894C-DC946DFFE22D}.Release|x86.Build.0 = Release|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Debug|Any CPU.Build.0 = Debug|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Debug|x86.ActiveCfg = Debug|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Debug|x86.Build.0 = Debug|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Proto|Any CPU.ActiveCfg = Debug|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Proto|Any CPU.Build.0 = Debug|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Proto|x86.ActiveCfg = Debug|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Proto|x86.Build.0 = Debug|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Release|Any CPU.ActiveCfg = Release|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Release|Any CPU.Build.0 = Release|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Release|x86.ActiveCfg = Release|Any CPU + {C888A81D-2372-4B4A-8BA1-525AEE3918D6}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -324,6 +384,11 @@ Global {25568CD2-E654-4C8F-BE5B-59BABFC5BD20} = {07482B5E-4980-4285-B732-820F15870284} {DDFD06DC-D7F2-417F-9177-107764EEBCD8} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {9B4CF83C-C215-4EA0-9F8B-B5A77090F634} = {3881429D-A97A-49EB-B7AE-A82BA5FE9C77} + {452EED3C-AA87-471F-B9AC-0F4479C5820C} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} + {F8743670-C8D4-41B3-86BE-BBB1226C352F} = {452EED3C-AA87-471F-B9AC-0F4479C5820C} + {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F} = {452EED3C-AA87-471F-B9AC-0F4479C5820C} + {2904313F-7782-4522-894C-DC946DFFE22D} = {E02ADBCA-D6C0-4898-A8AA-86DE6EBE2DC2} + {C888A81D-2372-4B4A-8BA1-525AEE3918D6} = {E02ADBCA-D6C0-4898-A8AA-86DE6EBE2DC2} EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {BD5177C7-1380-40E7-94D2-7768E1A8B1B8} diff --git a/VisualFSharp.sln b/VisualFSharp.sln index 4ab8ee853dc..d35c1ba10b9 100644 --- a/VisualFSharp.sln +++ b/VisualFSharp.sln @@ -157,6 +157,10 @@ EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service", "src\fsharp\FSharp.Compiler.Service\FSharp.Compiler.Service.fsproj", "{B5A9BBD9-2F45-4722-A6CA-BAE3C64CD4E2}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service.Tests", "tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj", "{14F3D3D6-5C8E-43C2-98A2-17EA704D4DEA}" + ProjectSection(ProjectDependencies) = postProject + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B} = {FF76BD3C-5E0A-4752-B6C3-044F6E15719B} + {887630A3-4B1D-40EA-B8B3-2D842E9C40DB} = {887630A3-4B1D-40EA-B8B3-2D842E9C40DB} + EndProjectSection EndProject Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "VisualFSharpDebug", "vsintegration\Vsix\VisualFSharpFull\VisualFSharpDebug.csproj", "{A422D673-8E3B-4924-821B-DD3174173426}" EndProject diff --git a/eng/Versions.props b/eng/Versions.props index 21424130395..49ed9028652 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -87,7 +87,7 @@ 4.3.0 4.5.4 4.3.0 - 4.3.0 + 4.3.1 4.3.0 5.0.0 4.3.0 @@ -95,7 +95,6 @@ 4.3.0 4.3.0 4.3.0 - 4.3.0 4.3.0 4.3.0 4.3.0 diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 10e4807a72d..b14c995f86e 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -10158,12 +10158,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn match dispatchSlotsArityMatch with | meths when methInfosEquivByNameAndSig meths -> meths | [] -> - let details = - slots - |> Seq.map (NicePrint.stringOfMethInfo cenv.infoReader m envinner.DisplayEnv) - |> Seq.map (sprintf "%s %s" System.Environment.NewLine) - |> String.concat "" - + let details = NicePrint.multiLineStringOfMethInfos cenv.infoReader m envinner.DisplayEnv slots errorR(Error(FSComp.SR.tcOverrideArityMismatch details, memberId.idRange)) [] | _ -> [] // check that method to override is sealed is located at CheckOverridesAreAllUsedOnce (typrelns.fs) diff --git a/src/fsharp/CompilerConfig.fs b/src/fsharp/CompilerConfig.fs index 0bdc81698c5..a98fb573140 100644 --- a/src/fsharp/CompilerConfig.fs +++ b/src/fsharp/CompilerConfig.fs @@ -201,12 +201,17 @@ type TimeStampCache(defaultTimeStamp: DateTime) = projects.[pr] <- v v +and [] + ProjectAssemblyDataResult = + | Available of IRawFSharpAssemblyData + | Unavailable of useOnDiskInstead: bool + and IProjectReference = /// The name of the assembly file generated by the project abstract FileName: string /// Evaluate raw contents of the assembly file generated by the project - abstract EvaluateRawContents: unit -> NodeCode + abstract EvaluateRawContents: unit -> NodeCode /// Get the logical timestamp that would be the timestamp of the assembly file generated by the project /// diff --git a/src/fsharp/CompilerConfig.fsi b/src/fsharp/CompilerConfig.fsi index acb5f140b3d..41f347e4528 100644 --- a/src/fsharp/CompilerConfig.fsi +++ b/src/fsharp/CompilerConfig.fsi @@ -63,13 +63,20 @@ type TimeStampCache = member GetFileTimeStamp: string -> DateTime member GetProjectReferenceTimeStamp: IProjectReference -> DateTime +and [] + ProjectAssemblyDataResult = + | Available of IRawFSharpAssemblyData + | Unavailable of useOnDiskInstead: bool + and IProjectReference = /// The name of the assembly file generated by the project abstract FileName: string - /// Evaluate raw contents of the assembly file generated by the project - abstract EvaluateRawContents: unit -> NodeCode + /// Evaluate raw contents of the assembly file generated by the project. + /// 'None' may be returned if an in-memory view of the contents is, for some reason, + /// not available. In this case the on-disk view of the contents will be preferred. + abstract EvaluateRawContents: unit -> NodeCode /// Get the logical timestamp that would be the timestamp of the assembly file generated by the project. /// diff --git a/src/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index 82b55aaff7e..4e25796592f 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -1635,19 +1635,20 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse | Some ilb -> return! ilb.EvaluateRawContents() | None -> - return None + return ProjectAssemblyDataResult.Unavailable true } // If we have a project reference but did not get any valid contents, // just return None and do not attempt to read elsewhere. - if contentsOpt.IsNone && r.ProjectReference.IsSome then + match contentsOpt with + | ProjectAssemblyDataResult.Unavailable false -> return None - else + | _ -> let assemblyData = match contentsOpt with - | Some ilb -> ilb - | None -> + | ProjectAssemblyDataResult.Available ilb -> ilb + | ProjectAssemblyDataResult.Unavailable _ -> let ilModule, ilAssemblyRefs = tcImports.OpenILBinaryModule(ctok, filename, m) RawFSharpAssemblyDataBackedByFileOnDisk (ilModule, ilAssemblyRefs) :> IRawFSharpAssemblyData diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index 609ab4c202f..2ff48082fa5 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -715,7 +715,7 @@ let fixupApp (penv: penv) (fx, fty, tys, args, m) = // Is it a val app, where the val has a transform? match fx with - | Expr.Val (vref, _, vm) -> + | Expr.Val (vref, _, m) -> let f = vref.Deref match hasTransfrom penv f with | Some trans -> @@ -723,7 +723,7 @@ let fixupApp (penv: penv) (fx, fty, tys, args, m) = let callPattern = trans.transformCallPattern let transformedVal = trans.transformedVal let fCty = transformedVal.Type - let fCx = exprForVal vm transformedVal + let fCx = exprForVal m transformedVal (* [[f tps args ]] -> transformedVal tps [[COLLAPSED: args]] *) let env = {prefix = "arg";m = m;eg=penv.g} let bindings = [] diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index ff48ded92fd..133ac7880bf 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -31,6 +31,7 @@ buildUnexpectedTypeArgs,"The non-generic type '%s' does not expect any type argu returnUsedInsteadOfReturnBang,"Consider using 'return!' instead of 'return'." yieldUsedInsteadOfYieldBang,"Consider using 'yield!' instead of 'yield'." tupleRequiredInAbstractMethod,"\nA tuple type is required for one or more arguments. Consider wrapping the given arguments in additional parentheses or review the definition of the interface." +202,unsupportedAttribute,"This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect." 203,buildInvalidWarningNumber,"Invalid warning number '%s'" 204,buildInvalidVersionString,"Invalid version string '%s'" 205,buildInvalidVersionFile,"Invalid version file '%s'" @@ -1556,7 +1557,8 @@ forFormatInvalidForInterpolated4,"Interpolated strings used as type IFormattable 3384,scriptSdkNotDeterminedNoHost,"The .NET SDK for this script could not be determined. dotnet.exe could not be found ensure a .NET SDK is installed." 3385,tcInvalidStructReturn,"The use of '[]' on values, functions and methods is only allowed on partial active pattern definitions" 3386,tcImplicitConversionUsed,"This expression uses an implicit conversion to convert type '%s' to type '%s'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning." -3387,tcAmbiguousImplicitConversion,"This expression has type '%s' and is only made compatible with type '%s' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'." +3386,tcImplicitConversionUsed2,"This expression uses the implicit conversion '%s' to convert type '%s' to type '%s'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning." +3387,tcAmbiguousImplicitConversion,"This expression has type '%s' and is only made compatible with type '%s' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:%s" #3501 "This construct is not supported by your version of the F# compiler" CompilerMessage(ExperimentalAttributeMessages.NotSupportedYet, 3501, IsError=true) 3390,xmlDocBadlyFormed,"This XML comment is invalid: '%s'" 3390,xmlDocMissingParameterName,"This XML comment is invalid: missing 'name' attribute for parameter or parameter reference" diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index 0d5abef0333..6fb92fe5c1d 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -23,11 +23,11 @@ namespace Microsoft.FSharp.Control let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(cancellationToken, failureCTS.Token) - member this.Token = linkedCTS.Token + member _.Token = linkedCTS.Token - member this.Cancel() = failureCTS.Cancel() + member _.Cancel() = failureCTS.Cancel() - member this.Dispose() = + member _.Dispose() = linkedCTS.Dispose() failureCTS.Dispose() @@ -108,11 +108,27 @@ namespace Microsoft.FSharp.Control | Some cont -> storedCont <- None action <- cont - // Let the exception propagate all the way to the trampoline to get a full .StackTrace entry + + // 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 @@ -168,11 +184,11 @@ namespace Microsoft.FSharp.Control trampoline <- Trampoline() trampoline.Execute firstAction - member this.PostWithTrampoline (syncCtxt: SynchronizationContext) (f: unit -> AsyncReturn) = + member _.PostWithTrampoline (syncCtxt: SynchronizationContext) (f: unit -> AsyncReturn) = syncCtxt.Post (sendOrPostCallbackWithTrampoline, state=(f |> box)) AsyncReturn.Fake() - member this.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) = + member _.QueueWorkItemWithTrampoline (f: unit -> AsyncReturn) = if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then failwith "failed to queue user work item" AsyncReturn.Fake() @@ -237,45 +253,47 @@ namespace Microsoft.FSharp.Control member ctxt.WithExceptionContinuation econt = AsyncActivation<'T> { contents with aux = { ctxt.aux with econt = econt } } /// Produce a new execution context for a composite async - member ctxt.WithContinuation cont = AsyncActivation<'U> { cont = cont; aux = contents.aux } + member _.WithContinuation cont = AsyncActivation<'U> { cont = cont; aux = contents.aux } /// Produce a new execution context for a composite async - member ctxt.WithContinuations(cont, econt) = AsyncActivation<'U> { cont = cont; aux = { contents.aux with econt = econt } } + 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 ctxt.aux = contents.aux + member _.aux = contents.aux /// The success continuation relevant to the execution of the async - member ctxt.cont = contents.cont + member _.cont = contents.cont /// The exception continuation relevant to the execution of the async - member ctxt.econt = contents.aux.econt + member _.econt = contents.aux.econt /// The cancellation continuation relevant to the execution of the async - member ctxt.ccont = contents.aux.ccont + member _.ccont = contents.aux.ccont /// The cancellation token relevant to the execution of the async - member ctxt.token = contents.aux.token + member _.token = contents.aux.token /// The trampoline holder being used to protect execution of the async - member ctxt.trampolineHolder = contents.aux.trampolineHolder + member _.trampolineHolder = contents.aux.trampolineHolder /// Check if cancellation has been requested - member ctxt.IsCancellationRequested = contents.aux.token.IsCancellationRequested + member _.IsCancellationRequested = contents.aux.token.IsCancellationRequested /// Call the cancellation continuation of the active computation - member ctxt.OnCancellation () = + member _.OnCancellation () = contents.aux.ccont (OperationCanceledException (contents.aux.token)) /// Check for trampoline hijacking. - member inline ctxt.HijackCheckThenCall cont arg = + member inline _.HijackCheckThenCall cont arg = contents.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 member ctxt.OnSuccess result = if ctxt.IsCancellationRequested then ctxt.OnCancellation () @@ -283,7 +301,7 @@ namespace Microsoft.FSharp.Control ctxt.HijackCheckThenCall ctxt.cont result /// Save the exception continuation during propagation of an exception, or prior to raising an exception - member ctxt.OnExceptionRaised() = + member _.OnExceptionRaised() = contents.aux.trampolineHolder.OnExceptionRaised contents.aux.econt /// Make an initial async activation. @@ -293,8 +311,28 @@ namespace Microsoft.FSharp.Control /// 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 ctxt = ctxt - ctxt.aux.trampolineHolder.QueueWorkItemWithTrampoline(fun () -> ctxt.cont result) + 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) = @@ -311,17 +349,7 @@ namespace Microsoft.FSharp.Control let mutable i = 0 /// Execute the latch - member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 - - /// Ensures that a function is only called once - [] - type Once() = - let latch = Latch() - - /// Execute the function at most once - member this.Do f = - if latch.Enter() then - f() + member _.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0 /// Represents the result of an asynchronous computation [] @@ -355,8 +383,11 @@ namespace Microsoft.FSharp.Control let Invoke (computation: Async<'T>) (ctxt: AsyncActivation<_>) : AsyncReturn = ctxt.HijackCheckThenCall computation.Invoke ctxt - /// Apply userCode to x. If no exception is raised then call the normal continuation. Used to implement + /// 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<_> @@ -375,8 +406,11 @@ namespace Microsoft.FSharp.Control fake() /// Apply 'part2' to 'result1' and invoke the resulting computation. - // - // Note: direct calls to this function end up in user assemblies via inlining + /// + /// 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<_> @@ -396,7 +430,7 @@ namespace Microsoft.FSharp.Control /// Like `CallThenInvoke` but does not do a hijack check for historical reasons (exact code compat) [] - let CallThenInvokeNoHijackCheck (ctxt: AsyncActivation<_>) userCode result1 = + let CallThenInvokeNoHijackCheck (ctxt: AsyncActivation<_>) result1 userCode = let mutable res = Unchecked.defaultof<_> let mutable ok = false @@ -412,15 +446,18 @@ namespace Microsoft.FSharp.Control else fake() - /// Apply 'catchFilter' to 'arg'. If the result is 'Some' invoke the resulting computation. If the result is 'None' + /// 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>) catchFilter (edi: ExceptionDispatchInfo) : AsyncReturn = - let mutable resOpt = Unchecked.defaultof<_> + let CallFilterThenInvoke (ctxt: AsyncActivation<'T>) filterFunction (edi: ExceptionDispatchInfo) : AsyncReturn = + let mutable resOpt = None let mutable ok = false try - resOpt <- catchFilter (edi.GetAssociatedSourceException()) + resOpt <- filterFunction (edi.GetAssociatedSourceException()) ok <- true finally if not ok then @@ -435,159 +472,220 @@ namespace Microsoft.FSharp.Control else fake() - /// Internal way of making an async from code, for exact code compat. - /// Perform a cancellation check and ensure that any exceptions raised by - /// the immediate execution of "userCode" are sent to the exception continuation. - [] - let ProtectedCode (ctxt: AsyncActivation<'T>) userCode = - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - let mutable ok = false - try - let res = userCode ctxt - ok <- true - res - finally - if not ok then - ctxt.OnExceptionRaised() - /// Build a primitive without any exception or resync protection [] let MakeAsync body = { Invoke = body } [] - // Note: direct calls to this function end up in user assemblies via inlining + 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 - Invoke part1 (ctxt.WithContinuation(fun result1 -> CallThenInvokeNoHijackCheck ctxt part2 result1 )) + // 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. - let TryFinally (ctxt: AsyncActivation<'T>) computation finallyFunction = + /// - 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 - // 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 exn = - CallThenContinue finallyFunction () (ctxt.WithContinuation(fun () -> ctxt.econt exn)) - // 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 newCtxt = ctxt.WithContinuations(cont=cont, econt=econt, ccont=ccont) - computation.Invoke newCtxt + 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 catchFunction = + let TryWith (ctxt: AsyncActivation<'T>) (computation: Async<'T>) catchFunction = if ctxt.IsCancellationRequested then ctxt.OnCancellation () else - let newCtxt = + let ctxt = ctxt.WithExceptionContinuation(fun edi -> if ctxt.IsCancellationRequested then ctxt.OnCancellation () else CallFilterThenInvoke ctxt catchFunction edi) - computation.Invoke newCtxt - /// Internal way of making an async from code, for exact code compat. - /// When run, ensures that any exceptions raised by the immediate execution of "f" are - /// sent to the exception continuation. - let CreateProtectedAsync f = - MakeAsync (fun ctxt -> ProtectedCode ctxt f) + computation.Invoke ctxt - /// Internal way of making an async from result, for exact code compat. + /// 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 oce -> ctxt.ccont oce) + | AsyncResult.Canceled cexn -> ctxt.ccont cexn) - // Generate async computation which calls its continuation with the given result + /// 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 -> ctxt.OnSuccess res) - // The primitive bind operation. Generate a process that runs the first process, takes - // its result, applies f and then runs the new process produced. Hijack if necessary and - // run 'f' with exception protection + /// 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, but first - // check for cancellation. + /// 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 -> - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - CallThenInvoke ctxt result1 part2) + 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 - CreateCallAsync computation () + 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 - let inline CreateTryWithFilterAsync catchFunction computation = - MakeAsync (fun ctxt -> TryWith ctxt computation (fun edi -> catchFunction edi)) + /// - 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 = - CreateTryWithFilterAsync (fun exn -> Some (catchFunction exn)) 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 newCtxt = - ctxt.WithCancellationContinuation(fun exn -> - CallThenContinue finallyFunction exn (ctxt.WithContinuations(cont = (fun _ -> ccont exn), econt = (fun _ -> ccont exn)))) - computation.Invoke newCtxt) + 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 mutable x = 0 - let disposeFunction _ = - if Interlocked.CompareExchange(&x, 1, 0) = 0 then - Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource - CreateTryFinallyAsync disposeFunction (CreateCallAsync computation resource) |> CreateWhenCancelledAsync disposeFunction + 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<_> @@ -596,39 +694,107 @@ namespace Microsoft.FSharp.Control else unitAsync +#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 + /// 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 + 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 + + /// - Initial cancellation check + /// - Call syncCtxt.Post with exception protection. THis may fail as it is arbitrary user code let CreateSwitchToAsync (syncCtxt: SynchronizationContext) = - CreateProtectedAsync (fun ctxt -> - ctxt.trampolineHolder.PostWithTrampoline syncCtxt ctxt.cont) + 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() = - CreateProtectedAsync (fun ctxt -> - ctxt.trampolineHolder.StartThreadWithTrampoline ctxt.cont) + 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() = - CreateProtectedAsync (fun ctxt -> - ctxt.trampolineHolder.QueueWorkItemWithTrampoline ctxt.cont) + 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.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.cont x)), - econt = (fun x -> ctxt.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.econt x)), - ccont = (fun x -> ctxt.trampolineHolder.PostWithTrampoline syncCtxt (fun () -> ctxt.ccont x))) - - // When run, ensures that each of the continuations of the process are run in the same synchronization context. - let CreateDelimitedUserCodeAsync f = - CreateProtectedAsync (fun ctxt -> - let ctxtWithSync = DelimitSyncContext ctxt - f ctxtWithSync) + 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))) [] [] @@ -650,14 +816,15 @@ namespace Microsoft.FSharp.Control match syncCtxt, currentSyncCtxt with | null, null -> executeImmediately () - // See bug 370350; this logic is incorrect from the perspective of how SynchronizationContext is meant to work, - // but the logic works for mainline scenarios (WinForms/WPF/ASP.NET) and we won't change it again. + // 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 - member _.ContinueWithPostOrQueue res = + member _.PostOrQueueWithTrampoline res = trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> ctxt.cont res) /// A utility type to provide a synchronization point between an asynchronous computation @@ -743,9 +910,9 @@ namespace Microsoft.FSharp.Control if reuseThread then cont.ContinueImmediate res else - cont.ContinueWithPostOrQueue res + cont.PostOrQueueWithTrampoline res | otherwise -> - otherwise |> List.iter (fun cont -> cont.ContinueWithPostOrQueue res |> unfake) |> fake + otherwise |> List.iter (fun cont -> cont.PostOrQueueWithTrampoline res |> unfake) |> fake member x.ResultAvailable = result.IsSome @@ -815,7 +982,7 @@ namespace Microsoft.FSharp.Control /// Run the asynchronous workflow and wait for its result. [] - let RunSynchronouslyInAnotherThread (token:CancellationToken, computation, timeout) = + 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. @@ -827,12 +994,12 @@ namespace Microsoft.FSharp.Control 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 + 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 @@ -851,7 +1018,7 @@ namespace Microsoft.FSharp.Control res.Commit() [] - let RunSynchronouslyInCurrentThread (cancellationToken:CancellationToken, computation) = + let RunImmediate (cancellationToken:CancellationToken) computation = use resultCell = new ResultCell>() let trampolineHolder = TrampolineHolder() @@ -873,17 +1040,8 @@ namespace Microsoft.FSharp.Control let RunSynchronously cancellationToken (computation: Async<'T>) timeout = // Reuse the current ThreadPool thread if possible. match Thread.CurrentThread.IsThreadPoolThread, timeout with - | true, None -> RunSynchronouslyInCurrentThread (cancellationToken, computation) - // When the timeout is given we need a dedicated thread - // which cancels the computation. - // Performing the cancellation in the ThreadPool eg. by using - // Timer from System.Threading or CancellationTokenSource.CancelAfter - // (which internally uses Timer) won't work properly - // when the ThreadPool is busy. - // - // And so when the timeout is given we always use the current thread - // for the cancellation and run the computation in another thread. - | _ -> RunSynchronouslyInAnotherThread (cancellationToken, computation, timeout) + | true, None -> RunImmediate cancellationToken computation + | _ -> QueueAsyncAndWaitForResultSynchronously cancellationToken computation timeout [] let Start cancellationToken (computation:Async) = @@ -921,46 +1079,92 @@ namespace Microsoft.FSharp.Control |> unfake task - // Helper to attach continuation to the given task. + // Call the appropriate continuation on completion of a task [] - let taskContinueWith (task: Task<'T>) (ctxt: AsyncActivation<'T>) = - - let continuation (completedTask: Task<_>) : unit = - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> - 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) |> unfake - - if task.IsCompleted then - continuation task |> fake + 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 - task.ContinueWith(Action>(continuation), TaskContinuationOptions.ExecuteSynchronously) - |> ignore |> fake + 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 taskContinueWithUnit (task: Task) (ctxt: AsyncActivation) = + 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 () - let continuation (completedTask: Task) : unit = + // 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 () -> - 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 ()) |> unfake - - if task.IsCompleted then - continuation task |> fake - else - task.ContinueWith(Action(continuation), TaskContinuationOptions.ExecuteSynchronously) - |> ignore |> fake + 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) = @@ -1006,10 +1210,10 @@ namespace Microsoft.FSharp.Control completedSynchronously <- false interface System.IAsyncResult with - member x.IsCompleted = result.ResultAvailable - member x.CompletedSynchronously = completedSynchronously - member x.AsyncWaitHandle = result.GetWaitHandle() - member x.AsyncState = state + member _.IsCompleted = result.ResultAvailable + member _.CompletedSynchronously = completedSynchronously + member _.AsyncWaitHandle = result.GetWaitHandle() + member _.AsyncState = state interface System.IDisposable with member x.Dispose() = x.Close() @@ -1017,9 +1221,9 @@ namespace Microsoft.FSharp.Control module AsBeginEndHelpers = let beginAction (computation, callback, state) = let aiar = new AsyncIAsyncResult<'T>(callback, state) - let cont v = aiar.SetResult (AsyncResult.Ok v) - let econt v = aiar.SetResult (AsyncResult.Error v) - let ccont v = aiar.SetResult (AsyncResult.Canceled v) + 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) @@ -1083,47 +1287,40 @@ namespace Microsoft.FSharp.Control static member CancelCheck () = unitAsync static member FromContinuations (callback: ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> = - MakeAsync (fun ctxt -> - if ctxt.IsCancellationRequested then - ctxt.OnCancellation () - else - 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) - else if 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 + 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 + underCurrentThreadStack <- false - match contToTailCall with - | Some k -> k() - | _ -> fake()) + 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>) = @@ -1150,46 +1347,46 @@ namespace Microsoft.FSharp.Control AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions static member StartChildAsTask (computation, ?taskCreationOptions) = - async { let! cancellationToken = cancellationTokenAsync - return AsyncPrimitives.StartAsTask cancellationToken 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>) = + 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")) | _ -> () - MakeAsync (fun ctxt -> - let tasks, result = + MakeAsyncWithCancelCheck (fun ctxt -> + // manually protect eval of seq + let result = try - Seq.toArray computations, None // manually protect eval of seq + Choice1Of2 (Seq.toArray computations) with exn -> - let edi = ExceptionDispatchInfo.RestoreOrCapture exn - null, Some (ctxt.econt edi) + Choice2Of2 (ExceptionDispatchInfo.RestoreOrCapture exn) match result with - | Some r -> r - | None -> - if tasks.Length = 0 then - // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior - ctxt.cont [| |] - else - ProtectedCode ctxt (fun ctxt -> - let ctxtWithSync = DelimitSyncContext ctxt // manually resync - let mutable count = tasks.Length + | 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 tasks.Length + 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(ctxtWithSync.token) + let innerCTS = new LinkedSubSource(ctxt.token) let finishTask remaining = if (remaining = 0) then innerCTS.Dispose() match firstExn with - | None -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) - | Some (Choice1Of2 exn) -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.econt exn) - | Some (Choice2Of2 cexn) -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.ccont cexn) + | 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() @@ -1219,14 +1416,14 @@ namespace Microsoft.FSharp.Control let maxDegreeOfParallelism = match maxDegreeOfParallelism with | None -> None - | Some x when x >= tasks.Length -> 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 | None -> - tasks |> Array.iteri (fun i p -> + computations |> Array.iteri (fun i p -> QueueAsync innerCTS.Token // on success, record the result @@ -1240,9 +1437,9 @@ namespace Microsoft.FSharp.Control | Some maxDegreeOfParallelism -> let mutable i = -1 let rec worker (trampolineHolder : TrampolineHolder) = - if i < tasks.Length then + if i < computations.Length then let j = Interlocked.Increment &i - if j < tasks.Length then + if j < computations.Length then if innerCTS.Token.IsCancellationRequested then let cexn = OperationCanceledException (innerCTS.Token) recordFailure (Choice2Of2 cexn) |> unfake @@ -1255,7 +1452,7 @@ namespace Microsoft.FSharp.Control (fun res -> recordSuccess j res |> unfake; worker trampolineHolder) (fun edi -> recordFailure (Choice1Of2 edi) |> unfake; worker trampolineHolder) (fun cexn -> recordFailure (Choice2Of2 cexn) |> unfake; worker trampolineHolder) - tasks.[j].Invoke taskCtxt |> unfake + computations.[j].Invoke taskCtxt |> unfake fake() for x = 1 to maxDegreeOfParallelism do let trampolineHolder = TrampolineHolder() @@ -1265,37 +1462,41 @@ namespace Microsoft.FSharp.Control fake())) - static member Sequential (computations: seq>) = Async.Parallel(computations, maxDegreeOfParallelism=1) + static member Sequential (computations: seq>) = + Async.Parallel(computations, maxDegreeOfParallelism=1) static member Choice(computations: Async<'T option> seq) : Async<'T option> = - MakeAsync (fun ctxt -> + MakeAsyncWithCancelCheck (fun ctxt -> + // manually protect eval of seq let result = - try Seq.toArray computations |> Choice1Of2 - with exn -> ExceptionDispatchInfo.RestoreOrCapture exn |> Choice2Of2 + try + Choice1Of2 (Seq.toArray computations) + with exn -> + Choice2Of2 (ExceptionDispatchInfo.RestoreOrCapture exn) match result with | Choice2Of2 edi -> ctxt.econt edi - | Choice1Of2 [||] -> ctxt.cont None + | Choice1Of2 [| |] -> ctxt.cont None | Choice1Of2 computations -> - ProtectedCode ctxt (fun ctxt -> - let ctxtWithSync = DelimitSyncContext ctxt + let ctxt = DelimitSyncContext ctxt + ctxt.ProtectCode (fun () -> let mutable count = computations.Length let mutable noneCount = 0 let mutable someOrExnCount = 0 - let innerCts = new LinkedSubSource(ctxtWithSync.token) + 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(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) + innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont result) else fake() | None -> if Interlocked.Increment &noneCount = computations.Length then - innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) + innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont None) else fake() @@ -1307,7 +1508,7 @@ namespace Microsoft.FSharp.Control let econt (exn: ExceptionDispatchInfo) = let result = if Interlocked.Increment &someOrExnCount = 1 then - innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.econt exn) + innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.econt exn) else fake() @@ -1316,10 +1517,10 @@ namespace Microsoft.FSharp.Control result - let ccont (exn: OperationCanceledException) = + let ccont (cexn: OperationCanceledException) = let result = if Interlocked.Increment &someOrExnCount = 1 then - innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.ccont exn) + innerCts.Cancel(); ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont cexn) else fake() @@ -1328,8 +1529,8 @@ namespace Microsoft.FSharp.Control result - for c in computations do - QueueAsync innerCts.Token scont econt ccont c |> unfake + for computation in computations do + QueueAsync innerCts.Token scont econt ccont computation |> unfake fake())) @@ -1358,44 +1559,37 @@ namespace Microsoft.FSharp.Control AsyncPrimitives.StartWithContinuations cancellationToken computation id (fun edi -> edi.ThrowAny()) ignore static member Sleep (millisecondsDueTime: int64) : Async = - CreateDelimitedUserCodeAsync (fun ctxt -> - let mutable timer = None: Timer option - let cont = ctxt.cont - let ccont = ctxt.ccont - let latch = Latch() - let registration = - ctxt.token.Register( - (fun () -> - if latch.Enter() then - match timer with - | None -> () - | Some t -> t.Dispose() - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ccont(OperationCanceledException(ctxt.token))) |> unfake) - ) + 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((fun _ -> + timer <- new Timer(TimerCallback(fun _ -> if latch.Enter() then - // NOTE: If the CTS for the token would have been disposed, disposal of the registration would throw - // However, our contract is that until async computation ceases execution (and invokes ccont) - // the CTS will not be disposed. Execution of savedCCont is guarded by latch, so we are safe unless - // user violates the contract. - registration.Dispose() - // Try to Dispose of the Timer. - // Note: there is a race here: the Timer time very occasionally - // calls the callback _before_ the timer object has been recorded anywhere. This makes it difficult to dispose the - // timer in this situation. In this case we just let the timer be collected by finalization. - match timer with - | None -> () - | Some t -> t.Dispose() + // Ensure cancellation is not possible beyond this point + DisposeCancellationRegistration ®istration + DisposeTimer &timer // Now we're done, so call the continuation - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> cont()) |> unfake), + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.cont()) |> unfake), null, dueTime=millisecondsDueTime, period = -1L) |> Some with exn -> if latch.Enter() then - // post exception to econt only if we successfully enter the latch (no other continuations were called) + // 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() @@ -1413,74 +1607,72 @@ namespace Microsoft.FSharp.Control /// Wait for a wait handle. Both timeout and cancellation are supported static member AwaitWaitHandle(waitHandle: WaitHandle, ?millisecondsTimeout:int) = - let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite - if millisecondsTimeout = 0 then - async.Delay(fun () -> + MakeAsyncWithCancelCheck (fun ctxt -> + let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite + if millisecondsTimeout = 0 then let ok = waitHandle.WaitOne(0, exitContext=false) - async.Return ok) - else - CreateDelimitedUserCodeAsync(fun ctxt -> - let aux = ctxt.aux - let rwh = ref (None: RegisteredWaitHandle option) + ctxt.cont ok + else + let ctxt = DelimitSyncContext ctxt + let mutable edi = null let latch = Latch() - let rec cancelHandler = - Action(fun () -> + let mutable rwh: RegisteredWaitHandle option = None + let mutable registration: CancellationTokenRegistration option = None + registration <- + ctxt.token.Register(Action(fun () -> if latch.Enter() then - // if we got here - then we need to unregister RegisteredWaitHandle + trigger cancellation - // entrance to TP callback is protected by latch - so savedCont will never be called - lock rwh (fun () -> - match !rwh with - | None -> () - | Some rwh -> rwh.Unregister null |> ignore) - Async.Start (async { do (ctxt.ccont (OperationCanceledException(aux.token)) |> unfake) })) + // Make sure we're not cancelled again + DisposeCancellationRegistration ®istration + + UnregisterWaitHandle &rwh - and registration: CancellationTokenRegistration = aux.token.Register(cancelHandler) + // Call the cancellation continuation + ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxt.ccont(OperationCanceledException(ctxt.token))) |> unfake)) + |> Some - let savedCont = ctxt.cont try - lock rwh (fun () -> - rwh := Some(ThreadPool.RegisterWaitForSingleObject - (waitObject=waitHandle, - callBack=WaitOrTimerCallback(fun _ timeOut -> - if latch.Enter() then - lock rwh (fun () -> rwh.Value.Value.Unregister null |> ignore) - rwh := None - registration.Dispose() - ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), - state=null, - millisecondsTimeOutInterval=millisecondsTimeout, - executeOnlyOnce=true)) - fake()) - with _ -> + 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 - registration.Dispose() - reraise() // reraise exception only if we successfully enter the latch (no other continuations were called) - else - fake() - ) - - static member AwaitIAsyncResult(iar: IAsyncResult, ?millisecondsTimeout): Async = - async { if iar.CompletedSynchronously then - return true - else - return! Async.AwaitWaitHandle(iar.AsyncWaitHandle, ?millisecondsTimeout=millisecondsTimeout) } + // 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) - /// Bind the result of a result cell, calling the appropriate continuation. - static member BindResult (result: AsyncResult<'T>) : Async<'T> = - MakeAsync (fun ctxt -> - (match result with - | Ok v -> ctxt.cont v - | Error exn -> ctxt.econt exn - | Canceled exn -> ctxt.ccont exn) ) + static member AwaitIAsyncResult(iar: IAsyncResult, ?millisecondsTimeout) = + async { + if iar.CompletedSynchronously then + return true + else + 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<'T> = + static member AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell: ResultCell>) = async { let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout - return! Async.BindResult result + return! CreateAsyncResultAsync result } /// Await the result of a result cell belonging to a child computation. The resulting async supports timeout and if @@ -1498,81 +1690,80 @@ namespace Microsoft.FSharp.Control 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 + 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 + 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() } + finally + resultCell.Close() + } static member FromBeginEnd(beginAction, endAction, ?cancelAction): Async<'T> = - async { let! cancellationToken = cancellationTokenAsync - let resultCell = new ResultCell<_>() - - let once = Once() + async { + let! ct = cancellationTokenAsync + let resultCell = new ResultCell<_>() - let registration: CancellationTokenRegistration = + 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 onCancel () = - // Call the cancellation routine + // Call the cancellation function. Ignore any exceptions from the + // cancellation function. match cancelAction with - | None -> - // Register the result. This may race with a successful result, but - // ResultCell allows a race and throws away whichever comes last. - once.Do(fun () -> - let canceledResult = Canceled (OperationCanceledException cancellationToken) - resultCell.RegisterResult(canceledResult, reuseThread=true) |> unfake - ) + | None -> () | Some cancel -> - // If we get an exception from a cooperative cancellation function - // we assume the operation has already completed. try cancel() with _ -> () - cancellationToken.Register(Action(onCancel)) - - let callback = - System.AsyncCallback(fun iar -> - if not iar.CompletedSynchronously then - // The callback has been activated, so ensure cancellation is not possible - // beyond this point. - match cancelAction with - | Some _ -> - registration.Dispose() - | None -> - once.Do(fun () -> registration.Dispose()) - - // 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. This may race with a cancellation result, but - // ResultCell allows a race and throws away whichever comes last. - resultCell.RegisterResult(res, reuseThread=true) |> unfake) - - let (iar:IAsyncResult) = beginAction (callback, (null:obj)) - if iar.CompletedSynchronously then - registration.Dispose() - 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 } + // 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 + // Ensure cancellation is not possible beyond this point + DisposeCancellationRegistration ®istration + + // 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> = @@ -1595,44 +1786,52 @@ namespace Microsoft.FSharp.Control beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> static member AwaitEvent(event:IEvent<'Delegate, 'T>, ?cancelAction) : Async<'T> = - async { let! cancellationToken = cancellationTokenAsync - let resultCell = new ResultCell<_>() - // Set up the handlers to listen to events and cancellation - let once = Once() - let rec registration: CancellationTokenRegistration= - let onCancel () = - // We've been cancelled. Call the given cancellation routine + 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 + + // 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 -> - // We've been cancelled without a cancel action. Stop listening to events - event.RemoveHandler del - // Register the result. This may race with a successful result, but - // ResultCell allows a race and throws away whichever comes last. - once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException cancellationToken), reuseThread=true) |> unfake) + | None -> () | Some cancel -> - // If we get an exception from a cooperative cancellation function - // we assume the operation has already completed. try cancel() with _ -> () - cancellationToken.Register(Action(onCancel)) + + // 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 - and del = - FuncDelegate<'T>.Create<'Delegate>(fun eventArgs -> // Stop listening to events - event.RemoveHandler del - // The callback has been activated, so ensure cancellation is not possible beyond this point - once.Do(fun () -> registration.Dispose()) - let res = Ok eventArgs - // Register the result. This may race with a cancellation result, but - // ResultCell allows a race and throws away whichever comes last. - resultCell.RegisterResult(res, reuseThread=true) |> unfake) - - // Start listening to events - event.AddHandler del - - // 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 } + RemoveHandler event &del + + // Register the successful result. + resultCell.RegisterResult(Ok eventArgs, reuseThread=true) |> unfake) + + // Start listening to events + event.AddHandler del + + // 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 @@ -1643,65 +1842,86 @@ namespace Microsoft.FSharp.Control static member StartChild (computation:Async<'T>, ?millisecondsTimeout) = async { let resultCell = new ResultCell<_>() - let! cancellationToken = cancellationTokenAsync + let! ct = cancellationTokenAsync let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal let mutable ctsRef = innerCTS - let reg = cancellationToken.Register( - (fun () -> - match ctsRef with - | null -> () - | otherwise -> otherwise.Cancel())) + 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; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) - (fun edi -> ctsRef <- null; reg.Dispose(); resultCell.RegisterResult (Error edi, reuseThread=true)) - (fun err -> ctsRef <- null; reg.Dispose(); resultCell.RegisterResult (Canceled err, reuseThread=true)) + (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 } + 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! cancellationToken = cancellationTokenAsync - // latch protects CancellationTokenRegistration.Dispose from being called twice - let latch = Latch() - let rec handler () = - try - if latch.Enter() then registration.Dispose() - interruption () - with _ -> () - and registration: CancellationTokenRegistration = cancellationToken.Register(Action(handler)) - return { new System.IDisposable with - member this.Dispose() = - // dispose CancellationTokenRegistration only if cancellation was not requested. - // otherwise - do nothing, disposal will be performed by the handler itself - if not cancellationToken.IsCancellationRequested then - if latch.Enter() then registration.Dispose() } } + 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> = - if task.IsCompleted then - CreateProtectedAsync (fun ctxt -> taskContinueWith task ctxt) - else - CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith task ctxt) + 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 = - if task.IsCompleted then - CreateProtectedAsync (fun ctxt -> taskContinueWithUnit task ctxt) - else - CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit task ctxt) + 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 = @@ -1715,14 +1935,16 @@ namespace Microsoft.FSharp.Control [] // 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 } + 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) = @@ -1759,7 +1981,7 @@ namespace Microsoft.FSharp.Control | :? System.Net.WebException as webExn when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && canceled -> - Some (Async.BindResult(AsyncResult.Canceled (OperationCanceledException webExn.Message))) + Some (CreateAsyncResultAsync(AsyncResult.Canceled (OperationCanceledException webExn.Message))) | _ -> None) diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index fb070b66176..7721d0ccbac 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -967,14 +967,13 @@ module Pass4_RewriteAssembly = // pass4: lowertop - convert_vterm_bind on TopLevel binds //------------------------------------------------------------------------- - let AdjustBindToTopVal g (TBind(v, repr, _)) = + let ConvertBind g (TBind(v, repr, _) as bind) = match v.ValReprInfo with - | None -> - v.SetValReprInfo (Some (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes v repr )) - // Things that don't have an arity from type inference but are top-level are compiler-generated - v.SetIsCompilerGenerated(true) + | None -> v.SetValReprInfo (Some (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes v repr )) | Some _ -> () + bind + //------------------------------------------------------------------------- // pass4: transBind (translate) //------------------------------------------------------------------------- @@ -1036,9 +1035,6 @@ module Pass4_RewriteAssembly = | None -> List.empty // no env for this mutual binding | Some envp -> envp.ep_pack // environment pack bindings - let forceTopBindToHaveArity penv (bind: Binding) = - if penv.topValS.Contains(bind.Var) then AdjustBindToTopVal penv.g bind - let TransBindings xisRec penv (binds: Bindings) = let tlrBs, nonTlrBs = binds |> List.partition (fun b -> Zset.contains b.Var penv.tlrS) let fclass = BindingGroupSharingSameReqdItems tlrBs @@ -1049,9 +1045,12 @@ module Pass4_RewriteAssembly = // QUERY: we repeat this logic in LowerCallsAndSeqs. Do we really need to do this here? // QUERY: yes and no - if we don't, we have an unrealizable term, and many decisions must // QUERY: correlate with LowerCallsAndSeqs. + let forceTopBindToHaveArity (bind: Binding) = + if penv.topValS.Contains(bind.Var) then ConvertBind penv.g bind + else bind - nonTlrBs |> List.iter (forceTopBindToHaveArity penv) - tlrRebinds |> List.iter (forceTopBindToHaveArity penv) + let nonTlrBs = nonTlrBs |> List.map forceTopBindToHaveArity + let tlrRebinds = tlrRebinds |> List.map forceTopBindToHaveArity // assemble into replacement bindings let bindAs, rebinds = match xisRec with @@ -1068,7 +1067,7 @@ module Pass4_RewriteAssembly = // Is it a val app, where the val f is TLR with arity wf? // CLEANUP NOTE: should be using a mkApps to make all applications match fx with - | Expr.Val (fvref: ValRef, _, vm) when + | Expr.Val (fvref: ValRef, _, m) when (Zset.contains fvref.Deref penv.tlrS) && (let wf = Zmap.force fvref.Deref penv.arityM ("TransApp - wf", nameOfVal) IsArityMet fvref wf tys args) -> @@ -1079,9 +1078,9 @@ module Pass4_RewriteAssembly = let envp = Zmap.force fc penv.envPackM ("TransApp - envp", string) let fHat = Zmap.force f penv.fHatM ("TransApp - fHat", nameOfVal) let tys = (List.map mkTyparTy envp.ep_etps) @ tys - let aenvExprs = List.map (exprForVal vm) envp.ep_aenvs + let aenvExprs = List.map (exprForVal m) envp.ep_aenvs let args = aenvExprs @ args - mkApps penv.g ((exprForVal vm fHat, fHat.Type), [tys], args, m) (* change, direct fHat call with closure (reqdTypars, aenvs) *) + mkApps penv.g ((exprForVal m fHat, fHat.Type), [tys], args, m) (* change, direct fHat call with closure (reqdTypars, aenvs) *) | _ -> if isNil tys && isNil args then fx diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 3643a31ff47..b9edef9a7a3 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -218,13 +218,19 @@ let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualT | minfo :: _ -> Some (minfo, (reqdTy, reqdTy2, fun denv -> let reqdTy2Text, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes denv reqdTy2 actualTy - errorR(Error(FSComp.SR.tcAmbiguousImplicitConversion(actualTyText, reqdTy2Text), m)))) + let implicitsText = NicePrint.multiLineStringOfMethInfos infoReader m denv implicits + errorR(Error(FSComp.SR.tcAmbiguousImplicitConversion(actualTyText, reqdTy2Text, implicitsText), m)))) | _ -> None else None else None +[] +type TypeDirectedConversion = + | BuiltIn + | Implicit of MethInfo + [] type TypeDirectedConversionUsed = | Yes of (DisplayEnv -> exn) @@ -243,9 +249,14 @@ let MapCombineTDC2D mapper xs ys = let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad isConstraint (reqdTy: TType) actualTy m = let g = infoReader.g - let warn denv = + let warn info denv = let reqdTyText, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes denv reqdTy actualTy - Error(FSComp.SR.tcImplicitConversionUsed(actualTyText, reqdTyText), m) + match info with + | TypeDirectedConversion.BuiltIn -> + Error(FSComp.SR.tcImplicitConversionUsed(actualTyText, reqdTyText), m) + | TypeDirectedConversion.Implicit convMeth -> + let methText = NicePrint.stringOfMethInfo infoReader m denv convMeth + Error(FSComp.SR.tcImplicitConversionUsed2(methText, actualTyText, reqdTyText), m) if isConstraint then reqdTy, TypeDirectedConversionUsed.No, None @@ -262,17 +273,21 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // Adhoc int32 --> int64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.int64_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None + + // Adhoc int32 --> nativeint + elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.nativeint_ty reqdTy && typeEquiv g g.int32_ty actualTy then + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None // Adhoc int32 --> float64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.float_ty reqdTy && typeEquiv g g.int32_ty actualTy then - g.int32_ty, TypeDirectedConversionUsed.Yes(warn), None + g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None // Adhoc based on op_Implicit, perhaps returing a new equational type constraint to // eliminate articifical constrained type variables. elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (_minfo, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn), Some eqn + | Some (minfo, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo)), Some eqn | None -> reqdTy, TypeDirectedConversionUsed.No, None else reqdTy, TypeDirectedConversionUsed.No, None @@ -1204,6 +1219,10 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.int64_ty reqdTy && typeEquiv g g.int32_ty actualTy then mkCallToInt64Operator g m actualTy expr + // Adhoc int32 --> nativeint + elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.nativeint_ty reqdTy && typeEquiv g g.int32_ty actualTy then + mkCallToIntPtrOperator g m actualTy expr + // Adhoc int32 --> float64 elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.float_ty reqdTy && typeEquiv g g.int32_ty actualTy then mkCallToDoubleOperator g m actualTy expr diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 4cf03cb77ec..6ec8c38b2dd 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -2214,7 +2214,15 @@ let prettyLayoutOfMethInfoFreeStyle infoReader m denv typarInst minfo = InfoMemb let prettyLayoutOfPropInfoFreeStyle g amap m denv d = InfoMemberPrinting.prettyLayoutOfPropInfoFreeStyle g amap m denv d /// Convert a MethInfo to a string -let stringOfMethInfo infoReader m denv d = bufs (fun buf -> InfoMemberPrinting.formatMethInfoToBufferFreeStyle infoReader m denv buf d) +let stringOfMethInfo infoReader m denv minfo = + bufs (fun buf -> InfoMemberPrinting.formatMethInfoToBufferFreeStyle infoReader m denv buf minfo) + +/// Convert MethInfos to lines separated by newline including a newline as the first character +let multiLineStringOfMethInfos infoReader m denv minfos = + minfos + |> List.map (stringOfMethInfo infoReader m denv) + |> List.map (sprintf "%s %s" System.Environment.NewLine) + |> String.concat "" /// Convert a ParamData to a string let stringOfParamData denv paramData = bufs (fun buf -> InfoMemberPrinting.formatParamDataToBuffer denv buf paramData) diff --git a/src/fsharp/NicePrint.fsi b/src/fsharp/NicePrint.fsi index fd7fc1cbd88..fece7c07232 100644 --- a/src/fsharp/NicePrint.fsi +++ b/src/fsharp/NicePrint.fsi @@ -58,7 +58,9 @@ val prettyLayoutOfMethInfoFreeStyle: infoReader:InfoReader -> m:range -> denv:Di val prettyLayoutOfPropInfoFreeStyle: g:TcGlobals -> amap:ImportMap -> m:range -> denv:DisplayEnv -> d:PropInfo -> Layout -val stringOfMethInfo: infoReader:InfoReader -> m:range -> denv:DisplayEnv -> d:MethInfo -> string +val stringOfMethInfo: infoReader:InfoReader -> m:range -> denv:DisplayEnv -> minfo:MethInfo -> string + +val multiLineStringOfMethInfos: infoReader:InfoReader -> m:range -> denv:DisplayEnv -> minfos:MethInfo list -> string val stringOfParamData: denv:DisplayEnv -> paramData:ParamData -> string diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 6c61ca7985b..d579077b081 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -97,13 +97,13 @@ type ExprValueInfo = | ConstValue of Const * TType - /// CurriedLambdaValue(id, arity, size, lambdaExpression, isCrossAssembly, ty) + /// CurriedLambdaValue(id, arity, size, lambdaExpression, ty) /// /// arities: The number of bunches of untupled args and type args, and /// the number of args in each bunch. NOTE: This include type arguments. /// expr: The value, a lambda term. /// ty: The type of lambda term - | CurriedLambdaValue of id: Unique * arity: int * size: int * lambdaExpr: Expr * isCrossAssembly: bool * lambdaExprTy: TType + | CurriedLambdaValue of id: Unique * arity: int * size: int * value: Expr * TType /// ConstExprValue(size, value) | ConstExprValue of size: int * value: Expr @@ -202,7 +202,7 @@ let rec exprValueInfoL g exprVal = | TupleValue vinfos -> bracketL (exprValueInfosL g vinfos) | RecdValue (_, vinfos) -> braceL (exprValueInfosL g vinfos) | UnionCaseValue (ucr, vinfos) -> unionCaseRefL ucr ^^ bracketL (exprValueInfosL g vinfos) - | CurriedLambdaValue(_lambdaId, _arities, _bsize, expr, _isCrossAssembly, _ety) -> wordL (tagText "lam") ++ exprL expr (* (sprintf "lam(size=%d)" bsize) *) + | CurriedLambdaValue(_lambdaId, _arities, _bsize, expr, _ety) -> wordL (tagText "lam") ++ exprL expr (* (sprintf "lam(size=%d)" bsize) *) | ConstExprValue (_size, x) -> exprL x and exprValueInfosL g vinfos = commaListL (List.map (exprValueInfoL g) (Array.toList vinfos)) @@ -252,7 +252,7 @@ and SizeOfValueInfo x = | TupleValue vinfos | RecdValue (_, vinfos) | UnionCaseValue (_, vinfos) -> 1 + SizeOfValueInfos vinfos - | CurriedLambdaValue _ -> 1 + | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> 1 | ConstExprValue (_size, _) -> 1 let [] minDepthForASizeNode = 5 // for small vinfos do not record size info, save space @@ -279,7 +279,7 @@ let BoundValueInfoBySize vinfo = | UnionCaseValue (ucr, vinfos) -> UnionCaseValue (ucr, Array.map (bound (depth-1)) vinfos) | ConstValue _ -> x | UnknownValue -> x - | CurriedLambdaValue _ -> x + | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> x | ConstExprValue (_size, _) -> x let maxDepth = 6 (* beware huge constants! *) let trimDepth = 3 @@ -661,7 +661,7 @@ let (|StripConstValue|_|) ev = let (|StripLambdaValue|_|) ev = match stripValue ev with - | CurriedLambdaValue (id, arity, sz, expr, isCrossAssembly, ty) -> Some (id, arity, sz, expr, isCrossAssembly, ty) + | CurriedLambdaValue (id, arity, sz, expr, ty) -> Some (id, arity, sz, expr, ty) | _ -> None let destTupleValue ev = @@ -1064,7 +1064,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = else ValValue (vref2, detailR) // Check for escape in lambda - | CurriedLambdaValue (_, _, _, expr, _, _) | ConstExprValue(_, expr) when + | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when (let fvs = freeInExpr CollectAll expr (isAssemblyBoundary && not (freeVarsAllPublic fvs)) || Zset.exists hiddenVal fvs.FreeLocals || @@ -1158,7 +1158,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = ValValue (v2, detailR) // Check for escape in lambda - | CurriedLambdaValue (_, _, _, expr, _, _) | ConstExprValue(_, expr) when + | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when (let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr (not (isNil boundVars) && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) || (not (isNil boundTyVars) && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) || @@ -1207,7 +1207,7 @@ let RemapOptimizationInfo g tmenv = | UnionCaseValue(cspec, vinfos) -> UnionCaseValue (remapUnionCaseRef tmenv.tyconRefRemap cspec, Array.map remapExprInfo vinfos) | SizeValue(_vdepth, vinfo) -> MakeSizedValueInfo (remapExprInfo vinfo) | UnknownValue -> UnknownValue - | CurriedLambdaValue (uniq, arity, sz, expr, isCrossAssembly, ty) -> CurriedLambdaValue (uniq, arity, sz, remapExpr g CloneAll tmenv expr, isCrossAssembly, remapPossibleForallTy g tmenv ty) + | CurriedLambdaValue (uniq, arity, sz, expr, ty) -> CurriedLambdaValue (uniq, arity, sz, remapExpr g CloneAll tmenv expr, remapPossibleForallTy g tmenv ty) | ConstValue (c, ty) -> ConstValue (c, remapPossibleForallTy g tmenv ty) | ConstExprValue (sz, expr) -> ConstExprValue (sz, remapExpr g CloneAll tmenv expr) @@ -2557,17 +2557,6 @@ and OptimizeTraitCall cenv env (traitInfo, args, m) = let argsR, arginfos = OptimizeExprsThenConsiderSplits cenv env args OptimizeExprOpFallback cenv env (TOp.TraitCall traitInfo, [], argsR, m) arginfos UnknownValue -and CopyExprForInlining cenv isCrossAssembly expr m = - if isCrossAssembly then - // Debug points are erased when doing cross-assembly inlining - // Locals are marked compiler generated when doing cross-assembly inlining - expr - |> copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated - |> remarkExpr m - else - expr - |> copyExpr cenv.g CloneAll - /// Make optimization decisions once we know the optimization information /// for a value and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m) = @@ -2590,10 +2579,9 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m) // If we have proven 'v = compilerGeneratedValue' // and 'v' is being eliminated in favour of 'compilerGeneratedValue' // then replace the name of 'compilerGeneratedValue' - // by 'v' and mark it not compiler generated so we preserve good debugging and names. - // Don't do this for things represented statically as it may publish multiple values with the same name. + // by 'v' and mark it not compiler generated so we preserve good debugging and names match vOpt with - | Some v when not v.IsCompilerGenerated && vR.IsCompilerGenerated && not vR.IsCompiledAsTopLevel && not v.IsCompiledAsTopLevel -> + | Some v when not v.IsCompilerGenerated && vR.IsCompilerGenerated -> vR.Deref.SetIsCompilerGenerated(false) vR.Deref.SetLogicalName(v.LogicalName) | _ -> () @@ -2602,9 +2590,8 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m) | ConstExprValue(_size, expr) -> Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) - | CurriedLambdaValue (_, _, _, expr, isCrossAssembly, _) when mustInline -> - let exprCopy = CopyExprForInlining cenv isCrossAssembly expr m - Some exprCopy + | CurriedLambdaValue (_, _, _, expr, _) when mustInline -> + Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) | TupleValue _ | UnionCaseValue _ | RecdValue _ when mustInline -> failwith "tuple, union and record values cannot be marked 'inline'" @@ -2900,7 +2887,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) = // Considering inlining app match finfo.Info with - | StripLambdaValue (lambdaId, arities, size, f2, isCrossAssembly, f2ty) when + | StripLambdaValue (lambdaId, arities, size, f2, f2ty) when (// Considering inlining lambda cenv.optimizing && cenv.settings.InlineLambdas () && @@ -2961,8 +2948,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) // Inlining lambda (* ---------- printf "Inlining lambda near %a = %s\n" outputRange m (showL (exprL f2)) (* JAMES: *) ----------*) - let f2R = CopyExprForInlining cenv isCrossAssembly f2 m - + let f2R = remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated f2) // Optimizing arguments after inlining // REVIEW: this is a cheapshot way of optimizing the arg expressions as well without the restriction of recursive @@ -2976,16 +2962,6 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) | _ -> None -/// When optimizing a function in an application, use the whole range including arguments for the range -/// to apply to 'inline' code -and OptimizeFuncInApplication cenv env f0 mWithArgs = - let f0 = stripExpr f0 - match f0 with - | Expr.Val (v, _vFlags, _) -> - OptimizeVal cenv env f0 (v, mWithArgs) - | _ -> - OptimizeExpr cenv env f0 - /// Optimize/analyze an application of a function to type and term arguments and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = // trying to devirtualize @@ -2994,7 +2970,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = // devirtualized res | None -> - let newf0, finfo = OptimizeFuncInApplication cenv env f0 m + let newf0, finfo = OptimizeExpr cenv env f0 match TryInlineApplication cenv env finfo (tyargs, args, m) with | Some res -> // inlined @@ -3110,14 +3086,14 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = // can't inline any values with semi-recursive object references to self or base let valu = match baseValOpt with - | None -> CurriedLambdaValue (lambdaId, arities, bsize, exprR, false, ety) + | None -> CurriedLambdaValue (lambdaId, arities, bsize, exprR, ety) | Some baseVal -> let fvs = freeInExpr CollectLocals bodyR if fvs.UsesMethodLocalConstructs || fvs.FreeLocals.Contains baseVal then UnknownValue else let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (bodyR, bodyty) - CurriedLambdaValue (lambdaId, arities, bsize, expr2, false, ety) + CurriedLambdaValue (lambdaId, arities, bsize, expr2, ety) let estimatedSize = match vspec with @@ -3347,7 +3323,7 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = // Trim out optimization information for expressions that call protected members let rec cut ivalue = match ivalue with - | CurriedLambdaValue (_, arities, size, body, _, _) -> + | CurriedLambdaValue (_, arities, size, body, _) -> if size > (cenv.settings.lambdaInlineThreshold + arities + 2) then // Discarding lambda for large binding UnknownValue @@ -3624,7 +3600,7 @@ let rec p_ExprValueInfo x st = | UnionCaseValue (a, b) -> p_byte 4 st p_tup2 p_ucref (p_array p_ExprValueInfo) (a, b) st - | CurriedLambdaValue (_, b, c, d, _isCrossAssembly, e) -> + | CurriedLambdaValue (_, b, c, d, e) -> p_byte 5 st p_tup4 p_int p_int p_expr p_ty (b, c, d, e) st | ConstExprValue (a, b) -> @@ -3659,12 +3635,11 @@ let rec u_ExprInfo st = | 2 -> u_tup2 u_vref loop st |> (fun (a, b) -> ValValue (a, b)) | 3 -> u_array loop st |> (fun a -> TupleValue a) | 4 -> u_tup2 u_ucref (u_array loop) st |> (fun (a, b) -> UnionCaseValue (a, b)) - | 5 -> u_tup4 u_int u_int u_expr u_ty st |> (fun (b, c, d, e) -> CurriedLambdaValue (newUnique(), b, c, d, (* isCrossAssembly *) true, e)) + | 5 -> u_tup4 u_int u_int u_expr u_ty st |> (fun (b, c, d, e) -> CurriedLambdaValue (newUnique(), b, c, d, e)) | 6 -> u_tup2 u_int u_expr st |> (fun (a, b) -> ConstExprValue (a, b)) | 7 -> u_tup2 u_tcref (u_array loop) st |> (fun (a, b) -> RecdValue (a, b)) | _ -> failwith "loop" - // calc size of unpicked ExprValueInfo - MakeSizedValueInfo (loop st) + MakeSizedValueInfo (loop st) (* calc size of unpicked ExprValueInfo *) and u_ValInfo st = let a, b = u_tup2 u_ExprInfo u_bool st diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index d196a60e363..6008120291e 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -1639,7 +1639,9 @@ and CheckDecisionTreeTest cenv env m discrim = | DecisionTreeTest.ActivePatternCase (exp, _, _, _, _, _) -> CheckExprNoByrefs cenv env exp | DecisionTreeTest.Error _ -> () -and CheckAttrib cenv env (Attrib(_, _, args, props, _, _, _)) = +and CheckAttrib cenv env (Attrib(tcref, _, args, props, _, _, m)) = + if List.exists (tyconRefEq cenv.g tcref) cenv.g.attribs_Unsupported then + warning(Error(FSComp.SR.unsupportedAttribute(), m)) props |> List.iter (fun (AttribNamedArg(_, _, _, expr)) -> CheckAttribExpr cenv env expr) args |> List.iter (CheckAttribExpr cenv env) diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs index efec365b65d..06e1b054ba0 100644 --- a/src/fsharp/SyntaxTree.fs +++ b/src/fsharp/SyntaxTree.fs @@ -1826,7 +1826,7 @@ type SynModuleOrNamespaceSig = match this with | SynModuleOrNamespaceSig (range=m) -> m -[] +[] type ParsedHashDirectiveArgument = | String of value: string * stringKind: SynStringKind * range: Range | SourceIdentifier of constant: string * value: string * range: Range diff --git a/src/fsharp/SyntaxTree.fsi b/src/fsharp/SyntaxTree.fsi index a04fc70da39..4a82c325a5f 100644 --- a/src/fsharp/SyntaxTree.fsi +++ b/src/fsharp/SyntaxTree.fsi @@ -2015,7 +2015,7 @@ type SynModuleOrNamespaceSig = member Range: range /// Represents a parsed hash directive argument -[] +[] type ParsedHashDirectiveArgument = | String of value: string * stringKind: SynStringKind * range: Range | SourceIdentifier of constant: string * value: string * range: Range diff --git a/src/fsharp/SyntaxTreeOps.fs b/src/fsharp/SyntaxTreeOps.fs index 0efa2344877..ce22c839900 100644 --- a/src/fsharp/SyntaxTreeOps.fs +++ b/src/fsharp/SyntaxTreeOps.fs @@ -174,10 +174,15 @@ let rec SimplePatOfPat (synArgNameGenerator: SynArgNameGenerator) p = let id = mkSynId m nm let item = mkSynIdGet m nm true, None, id, item - SynSimplePat.Id (id, altNameRefCell, isCompGen, false, false, id.idRange), - Some (fun e -> - let clause = SynMatchClause(p, None, e, m, DebugPointForTarget.No) - SynExpr.Match (DebugPointAtBinding.NoneAtInvisible, item, [clause], clause.Range)) + let fn = + match p with + | SynPat.Wild _ -> None + | _ -> + Some (fun e -> + let clause = SynMatchClause(p, None, e, m, DebugPointForTarget.No) + SynExpr.Match (DebugPointAtBinding.NoneAtInvisible, item, [clause], clause.Range)) + + SynSimplePat.Id (id, altNameRefCell, isCompGen, false, false, id.idRange), fn let appFunOpt funOpt x = match funOpt with None -> x | Some f -> f x diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 80ef6017a0e..87b1810fe34 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1202,6 +1202,10 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member val attrib_CallerFilePathAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" member val attrib_CallerMemberNameAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" member val attrib_SkipLocalsInitAttribute = findSysAttrib "System.Runtime.CompilerServices.SkipLocalsInitAttribute" + member val attribs_Unsupported = [ + tryFindSysAttrib "System.Runtime.CompilerServices.ModuleInitializerAttribute" + tryFindSysAttrib "System.Runtime.CompilerServices.CallerArgumentExpressionAttribute" + ] |> List.choose (Option.map (fun x -> x.TyconRef)) member val attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" member val attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 18b78371c1c..3cdda13adc8 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -7544,7 +7544,7 @@ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl: TType list list, arg match f with | Expr.TyLambda (_, tyvs, body, _, bodyty) when tyvs.Length = List.length tyargs -> let tpenv = bindTypars tyvs tyargs emptyTyparInst - let body = instExpr g tpenv body + let body = remarkExpr m (instExpr g tpenv body) let bodyty' = instType tpenv bodyty MakeApplicationAndBetaReduceAux g (body, bodyty', rest, argsl, m) diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 904d5418592..f1ec999e55e 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -8,6 +8,7 @@ open System.Collections.Concurrent open System.Diagnostics open System.IO open System.Threading +open System.Threading.Tasks open System.Runtime.CompilerServices [] @@ -86,6 +87,19 @@ module internal PervasiveAutoOpens = let notFound() = raise (KeyNotFoundException()) + type Async with + static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = + let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + 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.Result + [] /// An efficient lazy for inline storage in a class type. Results in fewer thunks. type InlineDelayInit<'T when 'T : not struct> = diff --git a/src/fsharp/absil/illib.fsi b/src/fsharp/absil/illib.fsi index 2a66a699857..fd21e0d038f 100644 --- a/src/fsharp/absil/illib.fsi +++ b/src/fsharp/absil/illib.fsi @@ -47,6 +47,10 @@ module internal PervasiveAutoOpens = member inline EndsWithOrdinal: value:string -> bool + type Async with + /// Runs the computation synchronously, always starting on the current thread. + static member RunImmediate: computation: Async<'T> * ?cancellationToken: CancellationToken -> 'T + val foldOn: p:('a -> 'b) -> f:('c -> 'b -> 'd) -> z:'c -> x:'a -> 'd val notFound: unit -> 'a diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index d7509fee975..2e8a7164019 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -2184,7 +2184,7 @@ type FSharpCheckProjectResults keepAssemblyContents: bool, diagnostics: FSharpDiagnostic[], details:(TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * Choice * - TopAttribs option * IRawFSharpAssemblyData option * ILAssemblyRef * + TopAttribs option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * string[] * FSharpProjectOptions) option) = let getDetails() = @@ -2202,12 +2202,12 @@ type FSharpCheckProjectResults member _.HasCriticalErrors = details.IsNone member _.AssemblySignature = - let (tcGlobals, tcImports, thisCcu, ccuSig, _builderOrSymbolUses, topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() + let (tcGlobals, tcImports, thisCcu, ccuSig, _builderOrSymbolUses, topAttribs, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() FSharpAssemblySignature(tcGlobals, thisCcu, ccuSig, tcImports, topAttribs, ccuSig) member _.TypedImplementationFiles = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let (tcGlobals, tcImports, thisCcu, _ccuSig, _builderOrSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() + let (tcGlobals, tcImports, thisCcu, _ccuSig, _builderOrSymbolUses, _topAttribs, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let mimpls = match tcAssemblyExpr with | None -> [] @@ -2216,7 +2216,7 @@ type FSharpCheckProjectResults member info.AssemblyContents = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let (tcGlobals, tcImports, thisCcu, ccuSig, _builderOrSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() + let (tcGlobals, tcImports, thisCcu, ccuSig, _builderOrSymbolUses, _topAttribs, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let mimpls = match tcAssemblyExpr with | None -> [] @@ -2225,7 +2225,7 @@ type FSharpCheckProjectResults member _.GetOptimizedAssemblyContents() = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let (tcGlobals, tcImports, thisCcu, ccuSig, _builderOrSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() + let (tcGlobals, tcImports, thisCcu, ccuSig, _builderOrSymbolUses, _topAttribs, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let mimpls = match tcAssemblyExpr with | None -> [] @@ -2244,7 +2244,7 @@ type FSharpCheckProjectResults // Not, this does not have to be a SyncOp, it can be called from any thread member _.GetUsesOfSymbol(symbol:FSharpSymbol, ?cancellationToken: CancellationToken) = - let (tcGlobals, _tcImports, _thisCcu, _ccuSig, builderOrSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() + let (tcGlobals, _tcImports, _thisCcu, _ccuSig, builderOrSymbolUses, _topAttribs, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let results = match builderOrSymbolUses with @@ -2275,7 +2275,7 @@ type FSharpCheckProjectResults // Not, this does not have to be a SyncOp, it can be called from any thread member _.GetAllUsesOfAllSymbols(?cancellationToken: CancellationToken) = - let (tcGlobals, tcImports, thisCcu, ccuSig, builderOrSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() + let (tcGlobals, tcImports, thisCcu, ccuSig, builderOrSymbolUses, _topAttribs, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let cenv = SymbolEnv(tcGlobals, thisCcu, Some ccuSig, tcImports) let tcSymbolUses = @@ -2306,22 +2306,18 @@ type FSharpCheckProjectResults yield FSharpSymbolUse(tcGlobals, symbolUse.DisplayEnv, symbol, symbolUse.ItemOccurence, symbolUse.Range) |] member _.ProjectContext = - let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, ad, _tcAssemblyExpr, _dependencyFiles, projectOptions) = getDetails() + let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _ilAssemRef, ad, _tcAssemblyExpr, _dependencyFiles, projectOptions) = getDetails() let assemblies = tcImports.GetImportedAssemblies() |> List.map (fun x -> FSharpAssembly(tcGlobals, tcImports, x.FSharpViewOfMetadata)) FSharpProjectContext(thisCcu, assemblies, ad, projectOptions) - member _.RawFSharpAssemblyData = - let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() - tcAssemblyData - member _.DependencyFiles = - let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, dependencyFiles, _projectOptions) = getDetails() + let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _ilAssemRef, _ad, _tcAssemblyExpr, dependencyFiles, _projectOptions) = getDetails() dependencyFiles member _.AssemblyFullName = - let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() + let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() ilAssemRef.QualifiedName override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" @@ -2391,7 +2387,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, FSharpCheckProjectResults (filename, Some tcConfig, keepAssemblyContents, errors, Some(tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, - (Choice2Of2 tcFileInfo.ScopeSymbolUses), None, None, mkSimpleAssemblyRef "stdin", + (Choice2Of2 tcFileInfo.ScopeSymbolUses), None, mkSimpleAssemblyRef "stdin", tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles, projectOptions)) diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 1858e4b24db..319a95991bb 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -434,8 +434,6 @@ type public FSharpCheckProjectResults = /// in the documentation for compiler service. member DependencyFiles: string[] - member internal RawFSharpAssemblyData : IRawFSharpAssemblyData option - // Internal constructor. internal new : projectFileName:string * @@ -448,7 +446,6 @@ type public FSharpCheckProjectResults = ModuleOrNamespaceType * Choice * TopAttribs option * - IRawFSharpAssemblyData option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index f4267b9d5e6..2db5ed5680d 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -897,16 +897,16 @@ module IncrementalBuilderHelpers = nm = typeof.FullName) if tcState.CreatesGeneratedProvidedTypes || hasTypeProviderAssemblyAttrib then - None + ProjectAssemblyDataResult.Unavailable true else - Some (RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, generatedCcu, outfile, topAttrs, assemblyName, ilAssemRef) :> IRawFSharpAssemblyData) + ProjectAssemblyDataResult.Available (RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, generatedCcu, outfile, topAttrs, assemblyName, ilAssemRef) :> IRawFSharpAssemblyData) with e -> errorRecoveryNoRange e - None + ProjectAssemblyDataResult.Unavailable true ilAssemRef, tcAssemblyDataOpt, Some tcAssemblyExpr with e -> errorRecoveryNoRange e - mkSimpleAssemblyRef assemblyName, None, None + mkSimpleAssemblyRef assemblyName, ProjectAssemblyDataResult.Unavailable true, None let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev let! finalBoundModelWithErrors = finalBoundModel.Finish(diagnostics, Some topAttrs) @@ -995,7 +995,7 @@ type IncrementalBuilderState = stampedReferencedAssemblies: block initialBoundModel: GraphNode boundModels: block> - finalizedBoundModel: GraphNode<((ILAssemblyRef * IRawFSharpAssemblyData option * TypedImplFile list option * BoundModel) * DateTime)> + finalizedBoundModel: GraphNode<((ILAssemblyRef * ProjectAssemblyDataResult * TypedImplFile list option * BoundModel) * DateTime)> } [] diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index c8c5c26da6a..9b246582e30 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -219,12 +219,12 @@ type internal IncrementalBuilder = /// Get the final typecheck result. If 'generateTypedImplFiles' was set on Create then the TypedAssemblyAfterOptimization will contain implementations. /// This may be a long-running operation. - member GetCheckResultsAndImplementationsForProject : unit -> NodeCode + member GetCheckResultsAndImplementationsForProject : unit -> NodeCode /// Get the final typecheck result. If 'generateTypedImplFiles' was set on Create then the TypedAssemblyAfterOptimization will contain implementations. /// This may be a long-running operation. /// This will get full type-check info for the project, meaning no partial type-checking. - member GetFullCheckResultsAndImplementationsForProject : unit -> NodeCode + member GetFullCheckResultsAndImplementationsForProject : unit -> NodeCode /// Get the logical time stamp that is associated with the output of the project if it were gully built immediately member GetLogicalTimeStampForProject: TimeStampCache -> DateTime diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 501ad1c4b02..563168f8109 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -279,9 +279,12 @@ type BackgroundCompiler( match ilReaderOpt with | Some ilReader -> let ilModuleDef, ilAsmRefs = ilReader.ILModuleDef, ilReader.ILAssemblyRefs - return RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData |> Some + let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData + return ProjectAssemblyDataResult.Available data | _ -> - return None + // Note 'false' - if a PEReference doesn't find an ILModuleReader then we don't + // continue to try to use an on-disk DLL + return ProjectAssemblyDataResult.Unavailable false } member x.TryGetLogicalTimeStamp(_) = stamp |> Some member x.FileName = nm } @@ -293,7 +296,8 @@ type BackgroundCompiler( node { let ilReader = getReader() let ilModuleDef, ilAsmRefs = ilReader.ILModuleDef, ilReader.ILAssemblyRefs - return RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData |> Some + let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData + return ProjectAssemblyDataResult.Available data } member x.TryGetLogicalTimeStamp(_) = getStamp() |> Some member x.FileName = nm } @@ -806,7 +810,7 @@ type BackgroundCompiler( | None -> return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationDiags, None) | Some builder -> - let! (tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt) = builder.GetFullCheckResultsAndImplementationsForProject() + let! (tcProj, ilAssemRef, _, tcAssemblyExprOpt) = builder.GetFullCheckResultsAndImplementationsForProject() let errorOptions = tcProj.TcConfig.errorSeverityOptions let fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation @@ -828,7 +832,7 @@ type BackgroundCompiler( keepAssemblyContents, diagnostics, Some(tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, - (Choice1Of2 builder), topAttribs, tcAssemblyDataOpt, ilAssemRef, + (Choice1Of2 builder), topAttribs, ilAssemRef, tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, Array.ofList tcDependencyFiles, options)) @@ -840,7 +844,7 @@ type BackgroundCompiler( let! builderOpt,_ = getOrCreateBuilder (options, userOpName) match builderOpt with | None -> - return None + return ProjectAssemblyDataResult.Unavailable true | Some builder -> let! (_, _, tcAssemblyDataOpt, _) = builder.GetCheckResultsAndImplementationsForProject() return tcAssemblyDataOpt @@ -955,31 +959,25 @@ type BackgroundCompiler( member _.ProjectChecked = projectChecked.Publish - member _.ClearCachesAsync (_userOpName) = - async { - return - lock gate (fun () -> - parseCacheLock.AcquireLock (fun ltok -> - checkFileInProjectCache.Clear(ltok) - parseFileCache.Clear(ltok)) - incrementalBuildersCache.Clear(AnyCallerThread) - frameworkTcImportsCache.Clear() - scriptClosureCache.Clear (AnyCallerThread) - ) - } + member _.ClearCaches() = + lock gate (fun () -> + parseCacheLock.AcquireLock (fun ltok -> + checkFileInProjectCache.Clear(ltok) + parseFileCache.Clear(ltok)) + incrementalBuildersCache.Clear(AnyCallerThread) + frameworkTcImportsCache.Clear() + scriptClosureCache.Clear (AnyCallerThread) + ) - member _.DownsizeCaches(_userOpName) = - async { - return - lock gate (fun () -> - parseCacheLock.AcquireLock (fun ltok -> - checkFileInProjectCache.Resize(ltok, newKeepStrongly=1) - parseFileCache.Resize(ltok, newKeepStrongly=1)) - incrementalBuildersCache.Resize(AnyCallerThread, newKeepStrongly=1, newKeepMax=1) - frameworkTcImportsCache.Downsize() - scriptClosureCache.Resize(AnyCallerThread,newKeepStrongly=1, newKeepMax=1) - ) - } + member _.DownsizeCaches() = + lock gate (fun () -> + parseCacheLock.AcquireLock (fun ltok -> + checkFileInProjectCache.Resize(ltok, newKeepStrongly=1) + parseFileCache.Resize(ltok, newKeepStrongly=1)) + incrementalBuildersCache.Resize(AnyCallerThread, newKeepStrongly=1, newKeepMax=1) + frameworkTcImportsCache.Downsize() + scriptClosureCache.Resize(AnyCallerThread,newKeepStrongly=1, newKeepMax=1) + ) member _.FrameworkImportsCache = frameworkTcImportsCache @@ -1195,29 +1193,24 @@ type FSharpChecker(legacyReferenceResolver, member ic.InvalidateAll() = ic.ClearCaches() - member _.ClearCachesAsync(?userOpName: string) = + member ic.ClearCaches() = let utok = AnyCallerThread - let userOpName = defaultArg userOpName "Unknown" braceMatchCache.Clear(utok) - backgroundCompiler.ClearCachesAsync(userOpName) - - member ic.ClearCaches(?userOpName) = - ic.ClearCachesAsync(?userOpName=userOpName) |> Async.Start // this cache clearance is not synchronous, it will happen when the background op gets run + backgroundCompiler.ClearCaches() member _.CheckMaxMemoryReached() = if not maxMemoryReached && System.GC.GetTotalMemory(false) > int64 maxMB * 1024L * 1024L then Trace.TraceWarning("!!!!!!!! MAX MEMORY REACHED, DOWNSIZING F# COMPILER CACHES !!!!!!!!!!!!!!!") // If the maxMB limit is reached, drastic action is taken // - reduce strong cache sizes to a minimum - let userOpName = "MaxMemoryReached" maxMemoryReached <- true braceMatchCache.Resize(AnyCallerThread, newKeepStrongly=10) - backgroundCompiler.DownsizeCaches(userOpName) |> Async.RunSynchronously + backgroundCompiler.DownsizeCaches() maxMemEvent.Trigger( () ) // This is for unit testing only member ic.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() = - ic.ClearCachesAsync() |> Async.RunSynchronously + ic.ClearCaches() System.GC.Collect() System.GC.WaitForPendingFinalizers() FxResolver.ClearStaticCaches() @@ -1229,7 +1222,7 @@ type FSharpChecker(legacyReferenceResolver, backgroundCompiler.InvalidateConfiguration(options, userOpName) /// Clear the internal cache of the given projects. - member _.ClearCache(options: FSharpProjectOptions seq, ?userOpName: string) = + member _.ClearCache(options: seq, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.ClearCache(options, userOpName) diff --git a/src/fsharp/utils/FileSystem.fs b/src/fsharp/utils/FileSystem.fs index 9346e6ab1a8..51ee480bf4f 100644 --- a/src/fsharp/utils/FileSystem.fs +++ b/src/fsharp/utils/FileSystem.fs @@ -353,7 +353,6 @@ module MemoryMappedFileExtensions = let length = int64 bytes.Length trymmf length (fun stream -> - stream.SetLength(stream.Length + length) let span = Span(stream.PositionPointer |> NativePtr.toVoidPtr, int length) bytes.Span.CopyTo(span) stream.Position <- stream.Position + length diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index d0a4a987163..a36f27f2a05 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -378,8 +378,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Neshoda v interpolovaném řetězci. Interpolované řetězce nemůžou používat specifikátory formátu %, pokud se každému z nich nezadá nějaký výraz, např. %d{{1+1}}. @@ -622,6 +627,11 @@ Zvažte použití parametru return! namísto return. + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Pro odkazy na rozhraní .NET používejte referenční sestavení, pokud jsou k dispozici (ve výchozím nastavení povolené). diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index bd129dcab3c..d7dd65e3e5b 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -378,8 +378,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Konflikt in interpolierter Zeichenfolge. Interpolierte Zeichenfolgen dürfen keine Formatbezeichner vom Typ "%" verwenden, es sei denn, jeder erhält einen Ausdruck, z. B. "%d{{1+1}}" @@ -622,6 +627,11 @@ Verwenden Sie ggf. "return!" anstelle von "return". + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Verweisassemblys für .NET Framework-Verweise verwenden, wenn verfügbar (standardmäßig aktiviert). diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 94172c49822..10b5251ea9d 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' La cadena interpolada no coincide. Las cadenas interpoladas no pueden usar los especificadores de formato "%", a menos que se les proporcione una expresión individualmente; por ejemplo, "%d{{1+1}}". @@ -622,6 +627,11 @@ Considere la posibilidad de usar "return!" en lugar de "return". + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Use ensamblados de referencia para las referencias de .NET Framework cuando estén disponibles (habilitado de forma predeterminada). diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 9029b98de5e..7208751af4a 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Incompatibilité dans la chaîne interpolée. Les chaînes interpolées ne peuvent pas utiliser les spécificateurs de format '%' à moins de recevoir une expression, par exemple '%d{{1+1}}' @@ -622,6 +627,11 @@ Utilisez 'return!' à la place de 'return'. + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Utilisez des assemblys de référence pour les références .NET Framework quand ils sont disponibles (activé par défaut). diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 0c4cd6fea03..2594f045627 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Mancata corrispondenza nella stringa interpolata. Nelle stringhe interpolate non è possibile usare gli identificatori di formato '%' a meno che non si indichi un'espressione per ognuno di essi, ad esempio '%d{{1+1}}' @@ -622,6 +627,11 @@ Provare a usare 'return!' invece di 'return'. + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Usa gli assembly di riferimento per i riferimenti a .NET Framework quando disponibili (abilitato per impostazione predefinita). diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 653250970d6..db3c023a9f7 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' 補間された文字列が一致しません。'%d{{1+1}}' などの式が指定されている場合を除き、補間された文字列では '%' 書式指定子を使用できません @@ -622,6 +627,11 @@ 'return' の代わりに 'return!' を使うことを検討してください。 + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). 使用可能な場合は、.NET Framework リファレンスの参照アセンブリを使用します (既定で有効)。 diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index 0fbdbb2a9a6..6cf3d27d191 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' 보간 문자열의 불일치. 각 보간 문자열에 식(예: '%d{{1+1}}')이 지정되지 않는 한 '%' 형식 지정자를 사용할 수 없습니다. @@ -622,6 +627,11 @@ 'return'이 아니라 'return!'를 사용하세요. + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). 기본적으로 활성화되는 참조 어셈블리를 .NET Framework 참조에 사용합니다(사용 가능한 경우). diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index ab5274e1e9c..87219dc337b 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Niezgodność w interpolowanym ciągu. W interpolowanych ciągach nie można używać specyfikatorów formatu „%”, chyba że każdemu z nich odpowiada wyrażenie, na przykład „%d{{1+1}}”. @@ -622,6 +627,11 @@ Rozważ użycie polecenia „return!” zamiast „return”. + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Użyj zestawów odwołań dla odwołań do programu .NET Framework, gdy są dostępne (domyślnie włączone). diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index a3e8c17c143..61daa2e5942 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Incompatibilidade na cadeia de caracteres interpolada. As cadeias de caracteres interpoladas não podem usar especificadores de formato '%', a menos que cada um receba uma expressão, por exemplo, '%d{{1+1}}' @@ -622,6 +627,11 @@ Considere usar 'return!' em vez de 'return'. + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Use assemblies de referência para referências do .NET Framework quando disponível (habilitado por padrão). @@ -4574,7 +4584,7 @@ Freely distributed under the MIT Open Source License. https://github.com/Microsoft/visualfsharp/blob/master/License.txt - Distribuído gratuitamente sob a Licença de Software Livre do MIT. https://github.com/Microsoft/visualfsharp/blob/master/License.txt + Distribuído gratuitamente sob a Licença de Código Aberto do MIT. https://github.com/Microsoft/visualfsharp/blob/master/License.txt diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index 74829d26b0d..1bdb902b9b3 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Несоответствие в интерполированной строке. В интерполированных строках запрещено использовать описатели формата "%", если только каждому из них не назначено выражение, например "'%d{{1+1}}". @@ -622,6 +627,11 @@ Рекомендуется использовать "return!" вместо "return". + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Использовать базовые сборки для ссылок на платформу .NET, если базовые сборки доступны (включено по умолчанию). diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index e6d11c8a091..4e0c2312709 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' Düz metin arasına kod eklenmiş dizede uyuşmazlık. Düz metin arasına kod eklenmiş dizeler, her birine '%d{{1+1}}' gibi bir ifade verilmedikçe '%' biçim belirticilerini kullanamaz @@ -622,6 +627,11 @@ 'return' yerine 'return!' kullanmayı deneyin. + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). Kullanılabilir olduğunda, .NET Framework başvuruları için başvuru bütünleştirilmiş kodlarını kullanın (Varsayılan olarak etkindir). diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index dd1f942cbe0..84014d409a3 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' 在内插字符串中不匹配。内插字符串不会使用 "%" 格式说明符，除非为每个字符串提供像 "'%d{{1+1}}" 这样的表达式 @@ -622,6 +627,11 @@ 考虑使用 "return!"，而非 "return"。 + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). 如果可用，请对 .NET Framework 引用使用引用程序集(默认启用)。 diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index 98e1a87ca9f..9457b3d32d3 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -368,8 +368,8 @@ - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. - This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} + This expression has type '{0}' and is only made compatible with type '{1}' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are:{2} @@ -422,6 +422,11 @@ This expression uses an implicit conversion to convert type '{0}' to type '{1}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + This expression uses the implicit conversion '{0}' to convert type '{1}' to type '{2}'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. + + Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}' 插補字串不相符。除非每個插補字串都有一個運算式，否則不可使用 '%' 格式指定名稱，例如 '%d{{1+1}}' @@ -622,6 +627,11 @@ 請考慮使用 'return!'，而不使用 'return'。 + + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect. + + Use reference assemblies for .NET framework references when available (Enabled by default). 請在可行的情況下使用適用於 .NET 架構參考的參考組件 (預設會啟用)。 diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnsupportedAttributes.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnsupportedAttributes.fs new file mode 100644 index 00000000000..ed112bac76c --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/UnsupportedAttributes.fs @@ -0,0 +1,55 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.ComponentTests.ErrorMessages + +#if NETCOREAPP +open Xunit +open FSharp.Test.Utilities.Compiler + +module ``Unsupported Attributes`` = + + [] + let ``Warn successfully`` () = + """ +open System.Runtime.CompilerServices +let f (w, [] x : string) = () +let [] g () = () +type C() = + member _.F (w, [] x : string) = () + [] + member _.G() = () + """ + |> FSharp + |> typecheck + |> shouldFail + |> withResults [ + { Error = Warning 202 + Range = { StartLine = 3 + StartColumn = 13 + EndLine = 3 + EndColumn = 37 } + Message = + "This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect." } + { Error = Warning 202 + Range = { StartLine = 4 + StartColumn = 7 + EndLine = 4 + EndColumn = 24 } + Message = + "This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect." } + { Error = Warning 202 + Range = { StartLine = 6 + StartColumn = 22 + EndLine = 6 + EndColumn = 78 } + Message = + "This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect." } + { Error = Warning 202 + Range = { StartLine = 7 + StartColumn = 7 + EndLine = 7 + EndColumn = 56 } + Message = + "This attribute is currently unsupported by the F# compiler. Applying it will not achieve its intended effect." } + ] +#endif \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index e4ec28b52a9..f599a3f9b05 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -26,6 +26,7 @@ + diff --git a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs index e46d4e88f4f..fdcf8dfda9a 100644 --- a/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BuildGraphTests.fs @@ -71,7 +71,7 @@ module BuildGraphTests = let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode)) - Async.RunSynchronously(work) + Async.RunImmediate(work) |> ignore Assert.shouldBe 1 computationCount @@ -84,7 +84,7 @@ module BuildGraphTests = let work = Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode)) - let result = Async.RunSynchronously(work) + let result = Async.RunImmediate(work) Assert.shouldNotBeEmpty result Assert.shouldBe requests result.Length @@ -116,7 +116,7 @@ module BuildGraphTests = Assert.shouldBeTrue weak.IsAlive - Async.RunSynchronously(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode))) + Async.RunImmediate(Async.Parallel(Array.init requests (fun _ -> graphNode.GetOrComputeValue() |> Async.AwaitNodeCode))) |> ignore GC.Collect(2, GCCollectionMode.Forced, true) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 303df51ecb8..c6718e41863 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -691,3 +691,56 @@ type AsyncModule() = } |> Async.RunSynchronously Assert.AreEqual(54, counter) + + [] + member this.``async doesn't do cancel check between do! and try-finally``() = + let gate = obj() + for i in 0..10 do + let procCount = 3 + use semaphore = new SemaphoreSlim(procCount-1) + printfn "Semaphore count available: %i" semaphore.CurrentCount + let mutable acquiredCount = 0 + let mutable releaseCount = 0 + try + List.init procCount (fun index -> + async { + lock gate <| fun () -> printfn "[%i] Waiting to enter semaphore" index + let! cancellationToken = Async.CancellationToken + + // The semaphore lets two threads through at a time + do! semaphore.WaitAsync(cancellationToken) |> Async.AwaitTask + + // No implicit cancellation checks should take place between a do! and a try + // if there are no other async control constructs present. If there is synchronous code + // it runs without cancellation checks + // + // index 1 will enter the try/finally quickly, call failwith and cancel the other tasks + // One of index 2 and index 3 will be stuck here before the try/finally. But having got + // this far it should enter the try/finally before cancellation takes effect + do + lock gate <| fun () -> printfn "[%i] Acquired semaphore" index + Interlocked.Increment(&acquiredCount) |> ignore + if index <> 0 then + lock gate <| fun () -> printfn "[%i] Slowly entering try/finally" index + System.Threading.Thread.Sleep(100) + + try + lock gate <| fun () -> printfn "[%i] Within try-finally" index + if index = 0 then + lock gate <| fun () -> printfn "[%i] Error" index + // The failure will cause others to cancel + failwith "Something bad happened!" + finally + semaphore.Release() |> ignore + // This should always get executed + Interlocked.Increment(&releaseCount) |> ignore + lock gate <| fun () -> printfn "[%i] Semaphore released" index + }) + |> Async.Parallel + |> Async.Ignore + |> Async.RunSynchronously + with + | exn -> + lock gate <| fun () -> printfn "Unhandled exception: %s" exn.Message + lock gate <| fun () -> printfn "Semaphore count available: %i" semaphore.CurrentCount + Assert.AreEqual(acquiredCount, releaseCount) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 689bcec6d1b..6247da500b7 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -21,9 +21,12 @@ type AsyncType() = let ignoreSynchCtx f = f () + let waitASec (t:Task) = + let result = t.Wait(TimeSpan(hours=0,minutes=0,seconds=1)) + Assert.True(result, "Task did not finish after waiting for a second.") [] - member this.StartWithContinuations() = + member _.StartWithContinuations() = let whatToDo = ref Exit @@ -75,7 +78,7 @@ type AsyncType() = () [] - member this.AsyncRunSynchronouslyReusesThreadPoolThread() = + member _.AsyncRunSynchronouslyReusesThreadPoolThread() = let action = async { async { () } |> Async.RunSynchronously } let computation = [| for i in 1 .. 1000 -> action |] @@ -90,7 +93,7 @@ type AsyncType() = [] [] [] - member this.AsyncSleepCancellation1(sleepType) = + member _.AsyncSleepCancellation1(sleepType) = ignoreSynchCtx (fun () -> let computation = match sleepType with @@ -112,7 +115,7 @@ type AsyncType() = [] [] [] - member this.AsyncSleepCancellation2(sleepType) = + member _.AsyncSleepCancellation2(sleepType) = ignoreSynchCtx (fun () -> let computation = match sleepType with @@ -137,7 +140,7 @@ type AsyncType() = [] [] [] - member this.AsyncSleepThrowsOnNegativeDueTimes(sleepType) = + member _.AsyncSleepThrowsOnNegativeDueTimes(sleepType) = async { try do! match sleepType with @@ -150,7 +153,7 @@ type AsyncType() = } |> Async.RunSynchronously [] - member this.AsyncSleepInfinitely() = + member _.AsyncSleepInfinitely() = ignoreSynchCtx (fun () -> let computation = Async.Sleep(System.Threading.Timeout.Infinite) let result = TaskCompletionSource() @@ -164,27 +167,17 @@ type AsyncType() = Assert.AreEqual("Cancel", result) ) - member private this.WaitASec (t:Task) = - let result = t.Wait(TimeSpan(hours=0,minutes=0,seconds=1)) - Assert.True(result, "Task did not finish after waiting for a second.") - - [] - member this.CreateTask () = + member _.CreateTask () = let s = "Hello tasks!" let a = async { return s } -#if !NET46 - let t : Task = -#else - use t : Task = -#endif - Async.StartAsTask a - this.WaitASec t + use t : Task = Async.StartAsTask a + waitASec t Assert.True (t.IsCompleted) Assert.AreEqual(s, t.Result) [] - member this.StartAsTaskCancellation () = + member _.StartAsTaskCancellation () = let cts = new CancellationTokenSource() let mutable spinloop = true let doSpinloop () = while spinloop do () @@ -192,12 +185,7 @@ type AsyncType() = cts.CancelAfter (100) doSpinloop() } -#if !NET46 - let t : Task = -#else - use t : Task = -#endif - Async.StartAsTask(a, cancellationToken = cts.Token) + use t : Task = Async.StartAsTask(a, cancellationToken = cts.Token) // Should not finish, we don't eagerly mark the task done just because it's been signaled to cancel. try @@ -208,7 +196,7 @@ type AsyncType() = spinloop <- false try - this.WaitASec t + waitASec t with :? AggregateException as a -> match a.InnerException with | :? TaskCanceledException as t -> () @@ -216,7 +204,7 @@ type AsyncType() = Assert.True (t.IsCompleted, "Task is not completed") [] - member this.``AwaitTask ignores Async cancellation`` () = + member _.``AwaitTask ignores Async cancellation`` () = let cts = new CancellationTokenSource() let tcs = new TaskCompletionSource() let innerTcs = new TaskCompletionSource() @@ -233,7 +221,7 @@ type AsyncType() = innerTcs.SetResult () try - this.WaitASec tcs.Task + waitASec tcs.Task with :? AggregateException as a -> match a.InnerException with | :? TaskCanceledException -> () @@ -241,7 +229,7 @@ type AsyncType() = Assert.True (tcs.Task.IsCompleted, "Task is not completed") [] - member this.RunSynchronouslyCancellationWithDelayedResult () = + member _.RunSynchronouslyCancellationWithDelayedResult () = let cts = new CancellationTokenSource() let tcs = TaskCompletionSource() let _ = cts.Token.Register(fun () -> tcs.SetResult 42) @@ -260,45 +248,35 @@ type AsyncType() = Assert.True (cancelled, "Task is not cancelled") [] - member this.ExceptionPropagatesToTask () = + member _.ExceptionPropagatesToTask () = let a = async { do raise (Exception ()) } -#if !NET46 - let t = -#else - use t = -#endif - Async.StartAsTask a + use t = Async.StartAsTask a let mutable exceptionThrown = false try - this.WaitASec t + waitASec t with e -> exceptionThrown <- true Assert.True (t.IsFaulted) Assert.True(exceptionThrown) [] - member this.CancellationPropagatesToTask () = + member _.CancellationPropagatesToTask () = let a = async { while true do () } -#if !NET46 - let t = -#else - use t = -#endif - Async.StartAsTask a + use t = Async.StartAsTask a Async.CancelDefaultToken () let mutable exceptionThrown = false try - this.WaitASec t + waitASec t with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) [] - member this.CancellationPropagatesToGroup () = + member _.CancellationPropagatesToGroup () = let ewh = new ManualResetEvent(false) let cancelled = ref false let a = async { @@ -308,67 +286,47 @@ type AsyncType() = } let cts = new CancellationTokenSource() let token = cts.Token -#if !NET46 - let t = -#else - use t = -#endif - Async.StartAsTask(a, cancellationToken=token) + use t = Async.StartAsTask(a, cancellationToken=token) // printfn "%A" t.Status ewh.WaitOne() |> Assert.True cts.Cancel() // printfn "%A" t.Status let mutable exceptionThrown = false try - this.WaitASec t + waitASec t with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) Assert.True(!cancelled) [] - member this.CreateImmediateAsTask () = + member _.CreateImmediateAsTask () = let s = "Hello tasks!" let a = async { return s } -#if !NET46 - let t : Task = -#else - use t : Task = -#endif - Async.StartImmediateAsTask a - this.WaitASec t + use t : Task = Async.StartImmediateAsTask a + waitASec t Assert.True (t.IsCompleted) Assert.AreEqual(s, t.Result) [] - member this.StartImmediateAsTask () = + member _.StartImmediateAsTask () = let s = "Hello tasks!" let a = async { return s } -#if !NET46 - let t = -#else - use t = -#endif - Async.StartImmediateAsTask a - this.WaitASec t + use t = Async.StartImmediateAsTask a + waitASec t Assert.True (t.IsCompleted) Assert.AreEqual(s, t.Result) [] - member this.ExceptionPropagatesToImmediateTask () = + member _.ExceptionPropagatesToImmediateTask () = let a = async { do raise (Exception ()) } -#if !NET46 - let t = -#else - use t = -#endif - Async.StartImmediateAsTask a + use t = Async.StartImmediateAsTask a let mutable exceptionThrown = false try - this.WaitASec t + waitASec t with e -> exceptionThrown <- true Assert.True (t.IsFaulted) @@ -377,20 +335,15 @@ type AsyncType() = #if IGNORED [] [] - member this.CancellationPropagatesToImmediateTask () = + member _.CancellationPropagatesToImmediateTask () = let a = async { while true do () } -#if !NET46 - let t = -#else - use t = -#endif - Async.StartImmediateAsTask a + use t = Async.StartImmediateAsTask a Async.CancelDefaultToken () let mutable exceptionThrown = false try - this.WaitASec t + waitASec t with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) @@ -399,7 +352,7 @@ type AsyncType() = #if IGNORED [] [] - member this.CancellationPropagatesToGroupImmediate () = + member _.CancellationPropagatesToGroupImmediate () = let ewh = new ManualResetEvent(false) let cancelled = ref false let a = async { @@ -417,7 +370,7 @@ type AsyncType() = // printfn "%A" t.Status let mutable exceptionThrown = false try - this.WaitASec t + waitASec t with e -> exceptionThrown <- true Assert.True (exceptionThrown) Assert.True(t.IsCanceled) @@ -425,14 +378,9 @@ type AsyncType() = #endif [] - member this.TaskAsyncValue () = + member _.TaskAsyncValue () = let s = "Test" -#if !NET46 - let t = -#else - use t = -#endif - Task.Factory.StartNew(Func<_>(fun () -> s)) + use t = Task.Factory.StartNew(Func<_>(fun () -> s)) let a = async { let! s1 = Async.AwaitTask(t) return s = s1 @@ -440,7 +388,7 @@ type AsyncType() = Async.RunSynchronously(a) |> Assert.True [] - member this.AwaitTaskCancellation () = + member _.AwaitTaskCancellation () = let test() = async { let tcs = new System.Threading.Tasks.TaskCompletionSource() tcs.SetCanceled() @@ -453,7 +401,7 @@ type AsyncType() = Async.RunSynchronously(test()) |> Assert.True [] - member this.AwaitCompletedTask() = + member _.AwaitCompletedTask() = let test() = async { let threadIdBefore = Thread.CurrentThread.ManagedThreadId do! Async.AwaitTask Task.CompletedTask @@ -464,7 +412,7 @@ type AsyncType() = Async.RunSynchronously(test()) |> Assert.True [] - member this.AwaitTaskCancellationUntyped () = + member _.AwaitTaskCancellationUntyped () = let test() = async { let tcs = new System.Threading.Tasks.TaskCompletionSource() tcs.SetCanceled() @@ -477,13 +425,8 @@ type AsyncType() = Async.RunSynchronously(test()) |> Assert.True [] - member this.TaskAsyncValueException () = -#if !NET46 - let t = -#else - use t = -#endif - Task.Factory.StartNew(Func(fun () -> raise <| Exception())) + member _.TaskAsyncValueException () = + use t = Task.Factory.StartNew(Func(fun () -> raise <| Exception())) let a = async { try let! v = Async.AwaitTask(t) @@ -494,16 +437,11 @@ type AsyncType() = // test is flaky: https://github.com/dotnet/fsharp/issues/11586 //[] - member this.TaskAsyncValueCancellation () = + member _.TaskAsyncValueCancellation () = use ewh = new ManualResetEvent(false) let cts = new CancellationTokenSource() let token = cts.Token -#if !NET46 - let t : Task= -#else - use t : Task= -#endif - Task.Factory.StartNew(Func(fun () -> while not token.IsCancellationRequested do ()), token) + use t : Task = Task.Factory.StartNew(Func(fun () -> while not token.IsCancellationRequested do ()), token) let cancelled = ref true let a = async { @@ -521,14 +459,9 @@ type AsyncType() = ewh.WaitOne(10000) |> ignore [] - member this.NonGenericTaskAsyncValue () = + member _.NonGenericTaskAsyncValue () = let hasBeenCalled = ref false -#if !NET46 - let t = -#else - use t = -#endif - Task.Factory.StartNew(Action(fun () -> hasBeenCalled := true)) + use t = Task.Factory.StartNew(Action(fun () -> hasBeenCalled := true)) let a = async { do! Async.AwaitTask(t) return true @@ -537,13 +470,8 @@ type AsyncType() = (!hasBeenCalled && result) |> Assert.True [] - member this.NonGenericTaskAsyncValueException () = -#if !NET46 - let t = -#else - use t = -#endif - Task.Factory.StartNew(Action(fun () -> raise <| Exception())) + member _.NonGenericTaskAsyncValueException () = + use t = Task.Factory.StartNew(Action(fun () -> raise <| Exception())) let a = async { try let! v = Async.AwaitTask(t) @@ -553,16 +481,11 @@ type AsyncType() = Async.RunSynchronously(a) |> Assert.True [] - member this.NonGenericTaskAsyncValueCancellation () = + member _.NonGenericTaskAsyncValueCancellation () = use ewh = new ManualResetEvent(false) let cts = new CancellationTokenSource() let token = cts.Token -#if !NET46 - let t = -#else - use t = -#endif - Task.Factory.StartNew(Action(fun () -> while not token.IsCancellationRequested do ()), token) + use t = Task.Factory.StartNew(Action(fun () -> while not token.IsCancellationRequested do ()), token) let a = async { try @@ -579,7 +502,7 @@ type AsyncType() = ewh.WaitOne(10000) |> ignore [] - member this.CancellationExceptionThrown () = + member _.CancellationExceptionThrown () = use ewh = new ManualResetEventSlim(false) let cts = new CancellationTokenSource() let token = cts.Token @@ -594,3 +517,20 @@ type AsyncType() = cts.Cancel() ewh.Wait(10000) |> ignore Assert.False hasThrown + + [] + member _.NoStackOverflowOnRecursion() = + + let mutable hasThrown = false + let rec loop (x: int) = async { + do! Task.CompletedTask |> Async.AwaitTask + Console.WriteLine (if x = 10000 then failwith "finish" else x) + return! loop(x+1) + } + + try + Async.RunSynchronously (loop 0) + hasThrown <- false + with Failure "finish" -> + hasThrown <- true + Assert.True hasThrown diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index c9e0d50582f..5e3001a5145 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -132,7 +132,7 @@ type CompilerAssert private () = options |> Array.append defaultProjectOptions.OtherOptions |> Array.append [| "fsc.dll"; inputFilePath; "-o:" + outputFilePath; (if isExe then "--target:exe" else "--target:library"); "--nowin32manifest" |] - let errors, _ = checker.Compile args |> Async.RunSynchronously + let errors, _ = checker.Compile args |> Async.RunImmediate errors, outputFilePath static let compileAux isExe options source f : unit = @@ -397,7 +397,7 @@ type CompilerAssert private () = let parseResults = checker.ParseFile("test.fs", SourceText.ofString source, parseOptions) - |> Async.RunSynchronously + |> Async.RunImmediate Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) @@ -410,7 +410,7 @@ type CompilerAssert private () = let compileErrors, statusCode = checker.Compile([parseResults.ParseTree], "test", outputFilePath, dependencies, executable = isExe, noframework = true) - |> Async.RunSynchronously + |> Async.RunImmediate Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors) Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode) @@ -421,7 +421,7 @@ type CompilerAssert private () = let parseOptions = { FSharpParsingOptions.Default with SourceFiles = [|"test.fs"|] } let parseResults = checker.ParseFile("test.fs", SourceText.ofString source, parseOptions) - |> Async.RunSynchronously + |> Async.RunImmediate Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) @@ -434,7 +434,7 @@ type CompilerAssert private () = let compileErrors, statusCode, assembly = checker.CompileToDynamicAssembly([parseResults.ParseTree], assemblyName, dependencies, None, noframework = true) - |> Async.RunSynchronously + |> Async.RunImmediate Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors) Assert.AreEqual(0, statusCode, sprintf "Nonzero status code: %d" statusCode) @@ -442,7 +442,7 @@ type CompilerAssert private () = Option.get assembly static member Pass (source: string) = - let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously + let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunImmediate Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) @@ -455,7 +455,7 @@ type CompilerAssert private () = static member PassWithOptions options (source: string) = let options = { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions} - let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, options) |> Async.RunSynchronously + let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, options) |> Async.RunImmediate Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) @@ -473,7 +473,7 @@ type CompilerAssert private () = 0, SourceText.ofString (File.ReadAllText absoluteSourceFile), { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions; SourceFiles = [|sourceFile|] }) - |> Async.RunSynchronously + |> Async.RunImmediate Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) @@ -503,7 +503,7 @@ type CompilerAssert private () = 0, SourceText.ofString source, { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions; SourceFiles = [|name|] }) - |> Async.RunSynchronously + |> Async.RunImmediate if parseResults.Diagnostics.Length > 0 then parseResults.Diagnostics @@ -523,7 +523,7 @@ type CompilerAssert private () = 0, SourceText.ofString source, { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}) - |> Async.RunSynchronously + |> Async.RunImmediate if parseResults.Diagnostics.Length > 0 then parseResults.Diagnostics @@ -543,7 +543,7 @@ type CompilerAssert private () = 0, SourceText.ofString source, { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}) - |> Async.RunSynchronously + |> Async.RunImmediate match fileAnswer with | FSharpCheckFileAnswer.Aborted _ -> Assert.Fail("Type Checker Aborted"); failwith "Type Checker Aborted" @@ -565,7 +565,7 @@ type CompilerAssert private () = 0, SourceText.ofString source, { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}) - |> Async.RunSynchronously + |> Async.RunImmediate if parseResults.Diagnostics.Length > 0 then parseResults.Diagnostics @@ -669,7 +669,7 @@ type CompilerAssert private () = static member Parse (source: string) = let sourceFileName = "test.fs" let parsingOptions = { FSharpParsingOptions.Default with SourceFiles = [| sourceFileName |] } - checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunSynchronously + checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunImmediate static member ParseWithErrors (source: string) expectedParseErrors = let parseResults = CompilerAssert.Parse source diff --git a/tests/FSharp.Test.Utilities/Utilities.fs b/tests/FSharp.Test.Utilities/Utilities.fs index fa02e829b7b..2932dcdeccc 100644 --- a/tests/FSharp.Test.Utilities/Utilities.fs +++ b/tests/FSharp.Test.Utilities/Utilities.fs @@ -6,9 +6,10 @@ open System open System.IO open System.Reflection open System.Collections.Immutable +open System.Diagnostics +open System.Threading.Tasks open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.CSharp -open System.Diagnostics open FSharp.Test.Utilities open TestFramework open NUnit.Framework @@ -17,6 +18,19 @@ open NUnit.Framework module Utilities = + type Async with + static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = + let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + 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.Result + [] type TargetFramework = | NetStandard20 diff --git a/tests/benchmarks/CompilerServiceBenchmarks/Program.fs b/tests/benchmarks/CompilerServiceBenchmarks/Program.fs index 28c42defebf..ced6ad6fcd9 100644 --- a/tests/benchmarks/CompilerServiceBenchmarks/Program.fs +++ b/tests/benchmarks/CompilerServiceBenchmarks/Program.fs @@ -1,14 +1,11 @@ open System open System.IO open System.Text -open FSharp.Compiler.ErrorLogger +open System.Threading.Tasks open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Diagnostics -open FSharp.Compiler.Syntax -open FSharp.Compiler.Symbols open FSharp.Compiler.EditorServices open FSharp.Compiler.Text -open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader open Microsoft.CodeAnalysis.Text @@ -87,6 +84,19 @@ type SourceText with [] module Helpers = + type Async with + static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = + let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + 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.Result + let createProject name referencedProjects = let tmpPath = Path.GetTempPath() let file = Path.Combine(tmpPath, Path.ChangeExtension(name, ".fs")) @@ -178,10 +188,10 @@ type CompilerService() = | None -> let options, _ = checkerOpt.Value.GetProjectOptionsFromScript("decentlySizedStandAloneFile.fsx", SourceText.ofString decentlySizedStandAloneFile) - |> Async.RunSynchronously + |> Async.RunImmediate let _, checkResult = checkerOpt.Value.ParseAndCheckFileInProject("decentlySizedStandAloneFile.fsx", 0, SourceText.ofString decentlySizedStandAloneFile, options) - |> Async.RunSynchronously + |> Async.RunImmediate decentlySizedStandAloneFileCheckResultOpt <- Some checkResult | _ -> () @@ -191,7 +201,7 @@ type CompilerService() = | None, _ -> failwith "no checker" | _, None -> failwith "no source" | Some(checker), Some(source) -> - let results = checker.ParseFile("CheckExpressions.fs", source.ToFSharpSourceText(), parsingOptions) |> Async.RunSynchronously + let results = checker.ParseFile("CheckExpressions.fs", source.ToFSharpSourceText(), parsingOptions) |> Async.RunImmediate if results.ParseHadErrors then failwithf "parse had errors: %A" results.Diagnostics [] @@ -201,7 +211,7 @@ type CompilerService() = | Some(checker) -> checker.InvalidateAll() checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() - checker.ParseFile("dummy.fs", SourceText.ofString "dummy", parsingOptions) |> Async.RunSynchronously |> ignore + checker.ParseFile("dummy.fs", SourceText.ofString "dummy", parsingOptions) |> Async.RunImmediate |> ignore ClearAllILModuleReaderCache() [] @@ -272,7 +282,7 @@ type CompilerService() = | Some checker -> let parseResult, checkResult = checker.ParseAndCheckFileInProject(file, 0, SourceText.ofString (File.ReadAllText(file)), options) - |> Async.RunSynchronously + |> Async.RunImmediate if parseResult.Diagnostics.Length > 0 then failwithf "%A" parseResult.Diagnostics @@ -343,7 +353,7 @@ type CompilerService() = | FSharpCheckFileAnswer.Aborted -> failwith "checker aborted" | FSharpCheckFileAnswer.Succeeded results -> let sourceLines = decentlySizedStandAloneFile.Split ([|"\r\n"; "\n"; "\r"|], StringSplitOptions.None) - let ranges = SimplifyNames.getSimplifiableNames(results, fun lineNum -> sourceLines.[Line.toZ lineNum]) |> Async.RunSynchronously + let ranges = SimplifyNames.getSimplifiableNames(results, fun lineNum -> sourceLines.[Line.toZ lineNum]) |> Async.RunImmediate ignore ranges () | _ -> failwith "oopsie" @@ -356,7 +366,7 @@ type CompilerService() = | FSharpCheckFileAnswer.Aborted -> failwith "checker aborted" | FSharpCheckFileAnswer.Succeeded results -> let sourceLines = decentlySizedStandAloneFile.Split ([|"\r\n"; "\n"; "\r"|], StringSplitOptions.None) - let decls = UnusedOpens.getUnusedOpens(results, fun lineNum -> sourceLines.[Line.toZ lineNum]) |> Async.RunSynchronously + let decls = UnusedOpens.getUnusedOpens(results, fun lineNum -> sourceLines.[Line.toZ lineNum]) |> Async.RunImmediate ignore decls () | _ -> failwith "oopsie" @@ -368,7 +378,7 @@ type CompilerService() = match checkResult with | FSharpCheckFileAnswer.Aborted -> failwith "checker aborted" | FSharpCheckFileAnswer.Succeeded results -> - let decls = UnusedDeclarations.getUnusedDeclarations(results, true) |> Async.RunSynchronously + let decls = UnusedDeclarations.getUnusedDeclarations(results, true) |> Async.RunImmediate ignore decls // should be 16 () | _ -> failwith "oopsie" diff --git a/tests/benchmarks/MicroPerf/Benchmarks.fs b/tests/benchmarks/MicroPerf/Benchmarks.fs index cb264e065e3..910ca10736b 100644 --- a/tests/benchmarks/MicroPerf/Benchmarks.fs +++ b/tests/benchmarks/MicroPerf/Benchmarks.fs @@ -40,10 +40,29 @@ type Benchmarks() = member _.FSharp(x: int) = Code.condition_2(x) +[] +[] +[] +[] +type AsyncWhileMemoryBench() = + + [] + member val Length = 0 with get, set + + [] + member x.Run() = + async { + let mutable i = 0 + while i < x.Length do + i <- i + 1 + return i + } |> Async.StartAsTask + module Main = [] let main argv = printfn "Running benchmarks..." - let results = BenchmarkRunner.Run() + //let results = BenchmarkRunner.Run() + let results = BenchmarkRunner.Run() 0 diff --git a/tests/benchmarks/MicroPerf/CS/MicroPerfCSharp.csproj b/tests/benchmarks/MicroPerf/CS/MicroPerfCSharp.csproj index 32ae4d1b867..875fdf3236c 100644 --- a/tests/benchmarks/MicroPerf/CS/MicroPerfCSharp.csproj +++ b/tests/benchmarks/MicroPerf/CS/MicroPerfCSharp.csproj @@ -6,6 +6,12 @@ 8.0 + + + + + + diff --git a/tests/fsharp/Compiler/Service/MultiProjectTests.fs b/tests/fsharp/Compiler/Service/MultiProjectTests.fs index 9f0bc331786..88a131fad09 100644 --- a/tests/fsharp/Compiler/Service/MultiProjectTests.fs +++ b/tests/fsharp/Compiler/Service/MultiProjectTests.fs @@ -63,7 +63,7 @@ let test() = |> SourceText.ofString let _, checkAnswer = CompilerAssert.Checker.ParseAndCheckFileInProject("test.fs", 0, fsText, fsOptions) - |> Async.RunSynchronously + |> Async.RunImmediate match checkAnswer with @@ -76,7 +76,7 @@ let test() = try let result, _ = checker.Compile([|"fsc.dll";filePath;$"-o:{ outputFilePath }";"--deterministic+";"--optimize+";"--target:library"|]) - |> Async.RunSynchronously + |> Async.RunImmediate if result.Length > 0 then failwith "Compilation has errors." @@ -162,7 +162,7 @@ let x = Script1.x let checkProjectResults = checker.ParseAndCheckProject(fsOptions1) - |> Async.RunSynchronously + |> Async.RunImmediate Assert.IsEmpty(checkProjectResults.Diagnostics) @@ -176,7 +176,7 @@ let y = Script1.y let checkProjectResults = checker.ParseAndCheckProject(fsOptions1) - |> Async.RunSynchronously + |> Async.RunImmediate Assert.IsNotEmpty(checkProjectResults.Diagnostics) @@ -190,7 +190,7 @@ let y = 1 let checkProjectResults = checker.ParseAndCheckProject(fsOptions1) - |> Async.RunSynchronously + |> Async.RunImmediate Assert.IsEmpty(checkProjectResults.Diagnostics) diff --git a/tests/fsharp/core/auto-widen/preview/test.bsl b/tests/fsharp/core/auto-widen/preview/test.bsl index a323bb59aa4..6da44724119 100644 --- a/tests/fsharp/core/auto-widen/preview/test.bsl +++ b/tests/fsharp/core/auto-widen/preview/test.bsl @@ -57,33 +57,33 @@ test.fsx(128,19,128,20): typecheck error FS3386: This expression uses an implici test.fsx(128,22,128,23): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'double'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(135,18,135,19): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(135,18,135,19): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:int -> C' to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. test.fsx(140,18,140,19): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'int64'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(145,18,145,19): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'decimal'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(145,18,145,19): typecheck error FS3386: This expression uses the implicit conversion 'Decimal.op_Implicit(value: int) : decimal' to convert type 'int' to type 'decimal'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(147,18,147,19): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'decimal'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(147,18,147,19): typecheck error FS3386: This expression uses the implicit conversion 'Decimal.op_Implicit(value: int) : decimal' to convert type 'int' to type 'decimal'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(149,39,149,41): typecheck error FS3386: This expression uses an implicit conversion to convert type 'string' to type 'Xml.Linq.XNamespace'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(149,39,149,41): typecheck error FS3386: This expression uses the implicit conversion 'Xml.Linq.XNamespace.op_Implicit(namespaceName: string) : Xml.Linq.XNamespace' to convert type 'string' to type 'Xml.Linq.XNamespace'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(154,18,154,20): typecheck error FS3386: This expression uses an implicit conversion to convert type 'string' to type 'Xml.Linq.XNamespace'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(154,18,154,20): typecheck error FS3386: This expression uses the implicit conversion 'Xml.Linq.XNamespace.op_Implicit(namespaceName: string) : Xml.Linq.XNamespace' to convert type 'string' to type 'Xml.Linq.XNamespace'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(159,18,159,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'string' to type 'Xml.Linq.XName'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(159,18,159,21): typecheck error FS3386: This expression uses the implicit conversion 'Xml.Linq.XName.op_Implicit(expandedName: string) : Xml.Linq.XName' to convert type 'string' to type 'Xml.Linq.XName'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(165,18,165,19): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(165,18,165,19): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:int -> C' to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(172,18,172,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'Y' to type 'X'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(172,18,172,21): typecheck error FS3386: This expression uses the implicit conversion 'static member Y.op_Implicit : y:Y -> X' to convert type 'Y' to type 'X'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(172,18,172,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'Y' to type 'X'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(172,18,172,21): typecheck error FS3386: This expression uses the implicit conversion 'static member Y.op_Implicit : y:Y -> X' to convert type 'Y' to type 'X'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(178,20,178,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(178,20,178,21): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:'T -> C<'T>' to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(180,15,180,16): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(180,15,180,16): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:'T -> C<'T>' to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(186,27,186,28): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'Nullable'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(186,27,186,28): typecheck error FS3386: This expression uses the implicit conversion 'Nullable.op_Implicit(value: int) : Nullable' to convert type 'int' to type 'Nullable'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(188,15,188,16): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'Nullable'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(188,15,188,16): typecheck error FS3386: This expression uses the implicit conversion 'Nullable.op_Implicit(value: int) : Nullable' to convert type 'int' to type 'Nullable'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. test.fsx(313,37,313,38): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'int64'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. @@ -182,29 +182,33 @@ test.fsx(463,18,463,19): typecheck error FS0001: This expression was expected to but here has type 'int' -test.fsx(471,18,471,19): typecheck error FS3386: This expression uses an implicit conversion to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(471,18,471,19): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:int -> C' to convert type 'int' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. test.fsx(471,18,471,19): typecheck error FS0044: This construct is deprecated. nope -test.fsx(482,18,482,21): typecheck error FS3387: This expression has type 'B' and is only made compatible with type 'C' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. +test.fsx(482,18,482,21): typecheck error FS3387: This expression has type 'B' and is only made compatible with type 'C' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are: + static member B.op_Implicit : x:B -> C + static member C.op_Implicit : x:B -> C -test.fsx(482,18,482,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(482,18,482,21): typecheck error FS3386: This expression uses the implicit conversion 'static member B.op_Implicit : x:B -> C' to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(482,18,482,21): typecheck error FS3387: This expression has type 'B' and is only made compatible with type 'C' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. +test.fsx(482,18,482,21): typecheck error FS3387: This expression has type 'B' and is only made compatible with type 'C' through an ambiguous implicit conversion. Consider using an explicit call to 'op_Implicit'. The applicable implicit conversions are: + static member B.op_Implicit : x:B -> C + static member C.op_Implicit : x:B -> C -test.fsx(482,18,482,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(482,18,482,21): typecheck error FS3386: This expression uses the implicit conversion 'static member B.op_Implicit : x:B -> C' to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(507,18,507,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(507,18,507,21): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:B -> C' to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(507,18,507,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(507,18,507,21): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:B -> C' to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(519,18,519,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(519,18,519,21): typecheck error FS3386: This expression uses the implicit conversion 'static member B.op_Implicit : x:B -> C' to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(519,18,519,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(519,18,519,21): typecheck error FS3386: This expression uses the implicit conversion 'static member B.op_Implicit : x:B -> C' to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(538,18,538,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(538,18,538,21): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:B -> C' to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. -test.fsx(538,18,538,21): typecheck error FS3386: This expression uses an implicit conversion to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. +test.fsx(538,18,538,21): typecheck error FS3386: This expression uses the implicit conversion 'static member C.op_Implicit : x:B -> C' to convert type 'B' to type 'C'. Warnings are enabled for implicit conversions. Consider using an explicit conversion or disabling this warning. test.fsx(543,30,543,31): typecheck error FS0001: This expression was expected to have type 'float32' @@ -221,4 +225,4 @@ test.fsx(544,14,544,21): typecheck error FS0039: The type 'float64' is not defin float float`1 float32 - float32`1 \ No newline at end of file + float32`1 diff --git a/tests/fsharp/typecheck/sigs/neg117.bsl b/tests/fsharp/typecheck/sigs/neg117.bsl index 2c8fbee14c0..9ad81d0003f 100644 --- a/tests/fsharp/typecheck/sigs/neg117.bsl +++ b/tests/fsharp/typecheck/sigs/neg117.bsl @@ -1,5 +1,5 @@ -neg117.fs(74,51,74,121): ilxgen error FS0041: No overloads match for method 'Transform'. +neg117.fs(79,18,79,59): ilxgen error FS0041: No overloads match for method 'Transform'. Known return type: ('a -> Neg117.TargetA.M1 Microsoft.FSharp.Core.[]) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/CompareIL.cmd b/tests/fsharpqa/Source/CodeGen/EmittedIL/CompareIL.cmd index ea97cebadcb..0e3c4acf219 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/CompareIL.cmd +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/CompareIL.cmd @@ -1,17 +1,15 @@ REM == %1 --> assembly ildasm /TEXT /LINENUM /NOBAR "%~nx1" >"%~n1.il" -IF %ERRORLEVEL% NEQ 0 exit /b 1 +IF NOT ERRORLEVEL 0 exit 1 echo %~dp0..\..\..\testenv\bin\ILComparer.exe "%~n1.il.bsl" "%~n1.il" %~dp0..\..\..\testenv\bin\ILComparer.exe "%~n1.il.bsl" "%~n1.il" -IF %ERRORLEVEL% EQU 0 exit /b 0 - if /i "%TEST_UPDATE_BSL%" == "1" ( echo copy /y "%~n1.il" "%~n1.il.bsl" copy /y "%~n1.il" "%~n1.il.bsl" ) -exit /b 1 +exit /b %ERRORLEVEL% diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth.il.bsl index 9787389574a..ca9de145cae 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:7:0:0 + .ver 5:0:0:0 } .assembly DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth { - // Offset: 0x00000000 Length: 0x0000027A + // Offset: 0x00000000 Length: 0x0000028D } .mresource public FSharpOptimizationData.DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth { - // Offset: 0x00000280 Length: 0x000000BA + // Offset: 0x00000298 Length: 0x000000BA } .module DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth.exe -// MVID: {5EAD3E33-1475-D984-A745-0383333EAD5E} +// MVID: {60E47018-1475-D984-A745-03831870E460} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00B10000 +// Image base: 0x07120000 // =============== CLASS MEMBERS DECLARATION =================== @@ -58,15 +58,11 @@ .method assembly static void Invoke(object x, int32 _arg1) cil managed { - // Code size 3 (0x3) - .maxstack 5 - .locals init ([0] int32 V_0) + // Code size 1 (0x1) + .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 100001,100001 : 0,0 'C:\\dev\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\DoNotBoxStruct\\DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth.fs' - IL_0000: ldarg.1 - IL_0001: stloc.0 - .line 6,6 : 80,82 '' - IL_0002: ret + .line 6,6 : 80,82 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\DoNotBoxStruct\\DoNotBoxStruct_ArrayOfArray_FSInterface_NoExtMeth.fs' + IL_0000: ret } // end of method F@6::Invoke } // end of class F@6 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_Array_FSInterface_NoExtMeth.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_Array_FSInterface_NoExtMeth.il.bsl index d290e0a4db4..49e25d8ea32 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_Array_FSInterface_NoExtMeth.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_Array_FSInterface_NoExtMeth.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:7:0:0 + .ver 5:0:0:0 } .assembly DoNotBoxStruct_Array_FSInterface_NoExtMeth { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.DoNotBoxStruct_Array_FSInterface_NoExtMeth { - // Offset: 0x00000000 Length: 0x00000261 + // Offset: 0x00000000 Length: 0x00000273 } .mresource public FSharpOptimizationData.DoNotBoxStruct_Array_FSInterface_NoExtMeth { - // Offset: 0x00000268 Length: 0x000000AC + // Offset: 0x00000278 Length: 0x000000AC } .module DoNotBoxStruct_Array_FSInterface_NoExtMeth.exe -// MVID: {5EAD3E33-8127-3EE3-A745-0383333EAD5E} +// MVID: {60E47018-8127-3EE3-A745-03831870E460} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00AF0000 +// Image base: 0x054A0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -58,15 +58,11 @@ .method assembly static void Invoke(object x, int32 _arg1) cil managed { - // Code size 3 (0x3) - .maxstack 5 - .locals init ([0] int32 V_0) + // Code size 1 (0x1) + .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 100001,100001 : 0,0 'C:\\dev\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\DoNotBoxStruct\\DoNotBoxStruct_Array_FSInterface_NoExtMeth.fs' - IL_0000: ldarg.1 - IL_0001: stloc.0 - .line 6,6 : 74,76 '' - IL_0002: ret + .line 6,6 : 74,76 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\DoNotBoxStruct\\DoNotBoxStruct_Array_FSInterface_NoExtMeth.fs' + IL_0000: ret } // end of method F@6::Invoke } // end of class F@6 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_MDArray_FSInterface_NoExtMeth.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_MDArray_FSInterface_NoExtMeth.il.bsl index 141bc712cf0..5112dc687d5 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_MDArray_FSInterface_NoExtMeth.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_MDArray_FSInterface_NoExtMeth.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:7:0:0 + .ver 5:0:0:0 } .assembly DoNotBoxStruct_MDArray_FSInterface_NoExtMeth { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.DoNotBoxStruct_MDArray_FSInterface_NoExtMeth { - // Offset: 0x00000000 Length: 0x00000268 + // Offset: 0x00000000 Length: 0x0000027A } .mresource public FSharpOptimizationData.DoNotBoxStruct_MDArray_FSInterface_NoExtMeth { - // Offset: 0x00000270 Length: 0x000000B0 + // Offset: 0x00000280 Length: 0x000000B0 } .module DoNotBoxStruct_MDArray_FSInterface_NoExtMeth.exe -// MVID: {5EAD3E33-A67D-867A-A745-0383333EAD5E} +// MVID: {60E47018-A67D-867A-A745-03831870E460} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x06A00000 +// Image base: 0x056F0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -58,15 +58,11 @@ .method assembly static void Invoke(object x, int32 _arg1) cil managed { - // Code size 3 (0x3) - .maxstack 5 - .locals init ([0] int32 V_0) + // Code size 1 (0x1) + .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 100001,100001 : 0,0 'C:\\dev\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\DoNotBoxStruct\\DoNotBoxStruct_MDArray_FSInterface_NoExtMeth.fs' - IL_0000: ldarg.1 - IL_0001: stloc.0 - .line 6,6 : 77,79 '' - IL_0002: ret + .line 6,6 : 77,79 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\DoNotBoxStruct\\DoNotBoxStruct_MDArray_FSInterface_NoExtMeth.fs' + IL_0000: ret } // end of method F@6::Invoke } // end of class F@6 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_NoArray_FSInterface_NoExtMeth.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_NoArray_FSInterface_NoExtMeth.il.bsl index 959a5180d76..191a24a1018 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_NoArray_FSInterface_NoExtMeth.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/DoNotBoxStruct/DoNotBoxStruct_NoArray_FSInterface_NoExtMeth.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:7:0:0 + .ver 5:0:0:0 } .assembly DoNotBoxStruct_NoArray_FSInterface_NoExtMeth { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.DoNotBoxStruct_NoArray_FSInterface_NoExtMeth { - // Offset: 0x00000000 Length: 0x00000258 + // Offset: 0x00000000 Length: 0x0000026A } .mresource public FSharpOptimizationData.DoNotBoxStruct_NoArray_FSInterface_NoExtMeth { - // Offset: 0x00000260 Length: 0x000000B0 + // Offset: 0x00000270 Length: 0x000000B0 } .module DoNotBoxStruct_NoArray_FSInterface_NoExtMeth.exe -// MVID: {5EAD3E33-CD0A-F713-A745-0383333EAD5E} +// MVID: {60E47018-CD0A-F713-A745-03831870E460} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x05780000 +// Image base: 0x06A30000 // =============== CLASS MEMBERS DECLARATION =================== @@ -58,15 +58,11 @@ .method assembly static void Invoke(object x, int32 _arg1) cil managed { - // Code size 3 (0x3) - .maxstack 5 - .locals init ([0] int32 V_0) + // Code size 1 (0x1) + .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 100001,100001 : 0,0 'C:\\dev\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\DoNotBoxStruct\\DoNotBoxStruct_NoArray_FSInterface_NoExtMeth.fs' - IL_0000: ldarg.1 - IL_0001: stloc.0 - .line 6,6 : 68,70 '' - IL_0002: ret + .line 6,6 : 68,70 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\DoNotBoxStruct\\DoNotBoxStruct_NoArray_FSInterface_NoExtMeth.fs' + IL_0000: ret } // end of method F@6::Invoke } // end of class F@6 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Grouping01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Grouping01.il.bsl index 38346254e8f..e5bad87d725 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Grouping01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Grouping01.il.bsl @@ -50,13 +50,13 @@ // Offset: 0x00000408 Length: 0x00000129 } .module Linq101Grouping01.exe -// MVID: {60D46F1F-FB79-E5BF-A745-03831F6FD460} +// MVID: {60B78A59-FB79-E5BF-A745-0383598AB760} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x05800000 +// Image base: 0x06730000 // =============== CLASS MEMBERS DECLARATION =================== @@ -371,7 +371,7 @@ { // Code size 8 (0x8) .maxstack 8 - .line 25,25 : 23,28 '' + .line 25,25 : 24,25 '' IL_0000: ldarg.1 IL_0001: ldc.i4.0 IL_0002: callvirt instance char [netstandard]System.String::get_Chars(int32) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101SetOperators01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101SetOperators01.il.bsl index baba5ea96e7..02331dbae8c 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101SetOperators01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101SetOperators01.il.bsl @@ -45,13 +45,13 @@ // Offset: 0x00000390 Length: 0x0000011E } .module Linq101SetOperators01.exe -// MVID: {60D46F1F-4EE5-349F-A745-03831F6FD460} +// MVID: {60B78A59-4EE5-349F-A745-0383598AB760} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x04FA0000 +// Image base: 0x06940000 // =============== CLASS MEMBERS DECLARATION =================== @@ -846,7 +846,7 @@ IL_0057: ldfld class [mscorlib]System.Collections.Generic.IEnumerator`1 Linq101SetOperators01/productFirstChars@33::'enum' IL_005c: callvirt instance !0 class [mscorlib]System.Collections.Generic.IEnumerator`1::get_Current() IL_0061: stloc.0 - .line 33,33 : 16,33 '' + .line 33,33 : 29,30 '' IL_0062: ldarg.0 IL_0063: ldc.i4.2 IL_0064: stfld int32 Linq101SetOperators01/productFirstChars@33::pc @@ -1196,7 +1196,7 @@ IL_0057: ldfld class [mscorlib]System.Collections.Generic.IEnumerator`1 Linq101SetOperators01/customerFirstChars@39::'enum' IL_005c: callvirt instance !0 class [mscorlib]System.Collections.Generic.IEnumerator`1::get_Current() IL_0061: stloc.0 - .line 39,39 : 16,33 '' + .line 39,39 : 29,30 '' IL_0062: ldarg.0 IL_0063: ldc.i4.2 IL_0064: stfld int32 Linq101SetOperators01/customerFirstChars@39::pc diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl index e4ab112f177..bf83c61d107 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl @@ -1,1673 +1,4 @@ -// Microsoft (R) .NET Framework IL Disassembler. Version 4.8.3928.0 +// Microsoft (R) .NET Framework IL Disassembler. Version 4.6.1055.0 // Copyright (c) Microsoft Corporation. All rights reserved. - - -// Metadata version: v4.0.30319 -.assembly extern mscorlib -{ - .publickeytoken = (B7 7A 5C 56 19 34 E0 89 ) // .z\V.4.. - .ver 4:0:0:0 -} -.assembly extern FSharp.Core -{ - .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 5:0:0:0 -} -.assembly TopLevelModule -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32, - int32, - int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) - - // --- The following custom attribute is added automatically, do not uncomment ------- - // .custom instance void [mscorlib]System.Diagnostics.DebuggableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggableAttribute/DebuggingModes) = ( 01 00 01 01 00 00 00 00 ) - - .hash algorithm 0x00008004 - .ver 0:0:0:0 -} -.mresource public FSharpSignatureData.TopLevelModule -{ - // Offset: 0x00000000 Length: 0x0000113D -} -.mresource public FSharpOptimizationData.TopLevelModule -{ - // Offset: 0x00001148 Length: 0x000003FD -} -.module TopLevelModule.dll -// MVID: {60D4892F-37F5-C118-A745-03832F89D460} -.imagebase 0x00400000 -.file alignment 0x00000200 -.stackreserve 0x00100000 -.subsystem 0x0003 // WINDOWS_CUI -.corflags 0x00000001 // ILONLY -// Image base: 0x06F60000 - - -// =============== CLASS MEMBERS DECLARATION =================== - -.class public abstract auto ansi sealed ABC - extends [mscorlib]System.Object -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) - .class auto autochar serializable sealed nested public beforefieldinit Expr - extends [mscorlib]System.Object - implements class [mscorlib]System.IEquatable`1, - [mscorlib]System.Collections.IStructuralEquatable, - class [mscorlib]System.IComparable`1, - [mscorlib]System.IComparable, - [mscorlib]System.Collections.IStructuralComparable - { - .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl - 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) - .field assembly initonly int32 item - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .method public static class ABC/Expr - NewNum(int32 item) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: newobj instance void ABC/Expr::.ctor(int32) - IL_0006: ret - } // end of method Expr::NewNum - - .method assembly specialname rtspecialname - instance void .ctor(int32 item) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 ABC/Expr::item - IL_000d: ret - } // end of method Expr::.ctor - - .method public hidebysig instance int32 - get_Item() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 ABC/Expr::item - IL_0006: ret - } // end of method Expr::get_Item - - .method public hidebysig instance int32 - get_Tag() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: pop - IL_0002: ldc.i4.0 - IL_0003: ret - } // end of method Expr::get_Tag - - .method assembly hidebysig specialname - instance object __DebugDisplay() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+0.8A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::__DebugDisplay - - .method public strict virtual instance string - ToString() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class ABC/Expr>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::ToString - - .method public hidebysig virtual final - instance int32 CompareTo(class ABC/Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 64 (0x40) - .maxstack 4 - .locals init ([0] class ABC/Expr V_0, - [1] class ABC/Expr V_1, - [2] class [mscorlib]System.Collections.IComparer V_2, - [3] int32 V_3, - [4] int32 V_4) - .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 100001,100001 : 0,0 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\SerializableAttribute\\ToplevelModule.fs' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0036 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0034 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() - IL_0017: stloc.2 - IL_0018: ldloc.0 - IL_0019: ldfld int32 ABC/Expr::item - IL_001e: stloc.3 - IL_001f: ldloc.1 - IL_0020: ldfld int32 ABC/Expr::item - IL_0025: stloc.s V_4 - IL_0027: ldloc.3 - IL_0028: ldloc.s V_4 - IL_002a: bge.s IL_002e - - .line 100001,100001 : 0,0 '' - IL_002c: ldc.i4.m1 - IL_002d: ret - - .line 100001,100001 : 0,0 '' - IL_002e: ldloc.3 - IL_002f: ldloc.s V_4 - IL_0031: cgt - IL_0033: ret - - .line 100001,100001 : 0,0 '' - IL_0034: ldc.i4.1 - IL_0035: ret - - .line 100001,100001 : 0,0 '' - IL_0036: ldarg.1 - IL_0037: ldnull - IL_0038: cgt.un - IL_003a: brfalse.s IL_003e - - .line 100001,100001 : 0,0 '' - IL_003c: ldc.i4.m1 - IL_003d: ret - - .line 100001,100001 : 0,0 '' - IL_003e: ldc.i4.0 - IL_003f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 13 (0xd) - .maxstack 8 - .line 6,6 : 14,18 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: unbox.any ABC/Expr - IL_0007: callvirt instance int32 ABC/Expr::CompareTo(class ABC/Expr) - IL_000c: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj, - class [mscorlib]System.Collections.IComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 80 (0x50) - .maxstack 4 - .locals init ([0] class ABC/Expr V_0, - [1] class ABC/Expr V_1, - [2] class ABC/Expr V_2, - [3] class [mscorlib]System.Collections.IComparer V_3, - [4] int32 V_4, - [5] int32 V_5) - .line 6,6 : 14,18 '' - IL_0000: ldarg.1 - IL_0001: unbox.any ABC/Expr - IL_0006: stloc.0 - IL_0007: ldarg.0 - IL_0008: ldnull - IL_0009: cgt.un - IL_000b: brfalse.s IL_0041 - - .line 100001,100001 : 0,0 '' - IL_000d: ldarg.1 - IL_000e: unbox.any ABC/Expr - IL_0013: ldnull - IL_0014: cgt.un - IL_0016: brfalse.s IL_003f - - .line 100001,100001 : 0,0 '' - IL_0018: ldarg.0 - IL_0019: pop - .line 100001,100001 : 0,0 '' - IL_001a: ldarg.0 - IL_001b: stloc.1 - IL_001c: ldloc.0 - IL_001d: stloc.2 - IL_001e: ldarg.2 - IL_001f: stloc.3 - IL_0020: ldloc.1 - IL_0021: ldfld int32 ABC/Expr::item - IL_0026: stloc.s V_4 - IL_0028: ldloc.2 - IL_0029: ldfld int32 ABC/Expr::item - IL_002e: stloc.s V_5 - IL_0030: ldloc.s V_4 - IL_0032: ldloc.s V_5 - IL_0034: bge.s IL_0038 - - .line 100001,100001 : 0,0 '' - IL_0036: ldc.i4.m1 - IL_0037: ret - - .line 100001,100001 : 0,0 '' - IL_0038: ldloc.s V_4 - IL_003a: ldloc.s V_5 - IL_003c: cgt - IL_003e: ret - - .line 100001,100001 : 0,0 '' - IL_003f: ldc.i4.1 - IL_0040: ret - - .line 100001,100001 : 0,0 '' - IL_0041: ldarg.1 - IL_0042: unbox.any ABC/Expr - IL_0047: ldnull - IL_0048: cgt.un - IL_004a: brfalse.s IL_004e - - .line 100001,100001 : 0,0 '' - IL_004c: ldc.i4.m1 - IL_004d: ret - - .line 100001,100001 : 0,0 '' - IL_004e: ldc.i4.0 - IL_004f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 41 (0x29) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class ABC/Expr V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0027 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldarg.0 - IL_0009: pop - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: stloc.1 - IL_000c: ldc.i4.0 - IL_000d: stloc.0 - IL_000e: ldc.i4 0x9e3779b9 - IL_0013: ldarg.1 - IL_0014: stloc.2 - IL_0015: ldloc.1 - IL_0016: ldfld int32 ABC/Expr::item - IL_001b: ldloc.0 - IL_001c: ldc.i4.6 - IL_001d: shl - IL_001e: ldloc.0 - IL_001f: ldc.i4.2 - IL_0020: shr - IL_0021: add - IL_0022: add - IL_0023: add - IL_0024: stloc.0 - IL_0025: ldloc.0 - IL_0026: ret - - .line 100001,100001 : 0,0 '' - IL_0027: ldc.i4.0 - IL_0028: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance int32 GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 6,6 : 14,18 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 ABC/Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance bool Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 52 (0x34) - .maxstack 4 - .locals init ([0] class ABC/Expr V_0, - [1] class ABC/Expr V_1, - [2] class ABC/Expr V_2, - [3] class ABC/Expr V_3, - [4] class [mscorlib]System.Collections.IEqualityComparer V_4) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_002c - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst ABC/Expr - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_002a - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldarg.0 - IL_0013: pop - .line 100001,100001 : 0,0 '' - IL_0014: ldarg.0 - IL_0015: stloc.2 - IL_0016: ldloc.1 - IL_0017: stloc.3 - IL_0018: ldarg.2 - IL_0019: stloc.s V_4 - IL_001b: ldloc.2 - IL_001c: ldfld int32 ABC/Expr::item - IL_0021: ldloc.3 - IL_0022: ldfld int32 ABC/Expr::item - IL_0027: ceq - IL_0029: ret - - .line 100001,100001 : 0,0 '' - IL_002a: ldc.i4.0 - IL_002b: ret - - .line 100001,100001 : 0,0 '' - IL_002c: ldarg.1 - IL_002d: ldnull - IL_002e: cgt.un - IL_0030: ldc.i4.0 - IL_0031: ceq - IL_0033: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(class ABC/Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 43 (0x2b) - .maxstack 4 - .locals init ([0] class ABC/Expr V_0, - [1] class ABC/Expr V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0023 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0021 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: ldfld int32 ABC/Expr::item - IL_0018: ldloc.1 - IL_0019: ldfld int32 ABC/Expr::item - IL_001e: ceq - IL_0020: ret - - .line 100001,100001 : 0,0 '' - IL_0021: ldc.i4.0 - IL_0022: ret - - .line 100001,100001 : 0,0 '' - IL_0023: ldarg.1 - IL_0024: ldnull - IL_0025: cgt.un - IL_0027: ldc.i4.0 - IL_0028: ceq - IL_002a: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class ABC/Expr V_0) - .line 6,6 : 14,18 '' - IL_0000: ldarg.1 - IL_0001: isinst ABC/Expr - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool ABC/Expr::Equals(class ABC/Expr) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method Expr::Equals - - .property instance int32 Tag() - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .get instance int32 ABC/Expr::get_Tag() - } // end of property Expr::Tag - .property instance int32 Item() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .get instance int32 ABC/Expr::get_Item() - } // end of property Expr::Item - } // end of class Expr - - .class auto ansi serializable nested public beforefieldinit MyExn - extends [mscorlib]System.Exception - implements [mscorlib]System.Collections.IStructuralEquatable - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) - .field assembly int32 Data0@ - .method public specialname rtspecialname - instance void .ctor(int32 data0) cil managed - { - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 ABC/MyExn::Data0@ - IL_000d: ret - } // end of method MyExn::.ctor - - .method public specialname rtspecialname - instance void .ctor() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ret - } // end of method MyExn::.ctor - - .method family specialname rtspecialname - instance void .ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo info, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext context) cil managed - { - // Code size 9 (0x9) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: ldarg.2 - IL_0003: call instance void [mscorlib]System.Exception::.ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext) - IL_0008: ret - } // end of method MyExn::.ctor - - .method public hidebysig specialname - instance int32 get_Data0() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 ABC/MyExn::Data0@ - IL_0006: ret - } // end of method MyExn::get_Data0 - - .method public hidebysig virtual instance int32 - GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 40 (0x28) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class [mscorlib]System.Collections.IEqualityComparer V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0026 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldc.i4 0x9e3779b9 - IL_000d: ldarg.1 - IL_000e: stloc.1 - IL_000f: ldarg.0 - IL_0010: castclass ABC/MyExn - IL_0015: call instance int32 ABC/MyExn::get_Data0() - IL_001a: ldloc.0 - IL_001b: ldc.i4.6 - IL_001c: shl - IL_001d: ldloc.0 - IL_001e: ldc.i4.2 - IL_001f: shr - IL_0020: add - IL_0021: add - IL_0022: add - IL_0023: stloc.0 - IL_0024: ldloc.0 - IL_0025: ret - - .line 100001,100001 : 0,0 '' - IL_0026: ldc.i4.0 - IL_0027: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance int32 - GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 7,7 : 19,24 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 ABC/MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance bool - Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 67 (0x43) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0, - [1] class [mscorlib]System.Exception V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_003b - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst [mscorlib]System.Exception - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_0039 - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0018: brtrue.s IL_001c - - IL_001a: br.s IL_0037 - - .line 100001,100001 : 0,0 '' - IL_001c: ldarg.2 - IL_001d: stloc.2 - IL_001e: ldarg.0 - IL_001f: castclass ABC/MyExn - IL_0024: call instance int32 ABC/MyExn::get_Data0() - IL_0029: ldloc.1 - IL_002a: castclass ABC/MyExn - IL_002f: call instance int32 ABC/MyExn::get_Data0() - IL_0034: ceq - IL_0036: ret - - .line 100001,100001 : 0,0 '' - IL_0037: ldc.i4.0 - IL_0038: ret - - .line 100001,100001 : 0,0 '' - IL_0039: ldc.i4.0 - IL_003a: ret - - .line 100001,100001 : 0,0 '' - IL_003b: ldarg.1 - IL_003c: ldnull - IL_003d: cgt.un - IL_003f: ldc.i4.0 - IL_0040: ceq - IL_0042: ret - } // end of method MyExn::Equals - - .method public hidebysig instance bool - Equals(class [mscorlib]System.Exception obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 59 (0x3b) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0033 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0031 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 - IL_000d: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0012: brtrue.s IL_0016 - - IL_0014: br.s IL_002f - - .line 100001,100001 : 0,0 '' - IL_0016: ldarg.0 - IL_0017: castclass ABC/MyExn - IL_001c: call instance int32 ABC/MyExn::get_Data0() - IL_0021: ldarg.1 - IL_0022: castclass ABC/MyExn - IL_0027: call instance int32 ABC/MyExn::get_Data0() - IL_002c: ceq - IL_002e: ret - - .line 100001,100001 : 0,0 '' - IL_002f: ldc.i4.0 - IL_0030: ret - - .line 100001,100001 : 0,0 '' - IL_0031: ldc.i4.0 - IL_0032: ret - - .line 100001,100001 : 0,0 '' - IL_0033: ldarg.1 - IL_0034: ldnull - IL_0035: cgt.un - IL_0037: ldc.i4.0 - IL_0038: ceq - IL_003a: ret - } // end of method MyExn::Equals - - .method public hidebysig virtual instance bool - Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0) - .line 7,7 : 19,24 '' - IL_0000: ldarg.1 - IL_0001: isinst [mscorlib]System.Exception - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool ABC/MyExn::Equals(class [mscorlib]System.Exception) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method MyExn::Equals - - .property instance int32 Data0() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) - .get instance int32 ABC/MyExn::get_Data0() - } // end of property MyExn::Data0 - } // end of class MyExn - - .class auto ansi serializable nested public A - extends [mscorlib]System.Object - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) - .field assembly string x - .method public specialname rtspecialname - instance void .ctor(string x) cil managed - { - // Code size 16 (0x10) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: pop - .line 8,8 : 16,17 '' - IL_0008: ldarg.0 - IL_0009: ldarg.1 - IL_000a: stfld string ABC/A::x - .line 8,8 : 14,15 '' - IL_000f: ret - } // end of method A::.ctor - - .method public hidebysig specialname - instance string get_X() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - .line 8,8 : 42,43 '' - IL_0000: ldarg.0 - IL_0001: ldfld string ABC/A::x - IL_0006: ret - } // end of method A::get_X - - .property instance string X() - { - .get instance string ABC/A::get_X() - } // end of property A::X - } // end of class A - - .class abstract auto ansi sealed nested public ABC - extends [mscorlib]System.Object - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) - .class auto autochar serializable sealed nested public beforefieldinit Expr - extends [mscorlib]System.Object - implements class [mscorlib]System.IEquatable`1, - [mscorlib]System.Collections.IStructuralEquatable, - class [mscorlib]System.IComparable`1, - [mscorlib]System.IComparable, - [mscorlib]System.Collections.IStructuralComparable - { - .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl - 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) - .field assembly initonly int32 item - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .method public static class ABC/ABC/Expr - NewNum(int32 item) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: newobj instance void ABC/ABC/Expr::.ctor(int32) - IL_0006: ret - } // end of method Expr::NewNum - - .method assembly specialname rtspecialname - instance void .ctor(int32 item) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 ABC/ABC/Expr::item - IL_000d: ret - } // end of method Expr::.ctor - - .method public hidebysig instance int32 - get_Item() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 ABC/ABC/Expr::item - IL_0006: ret - } // end of method Expr::get_Item - - .method public hidebysig instance int32 - get_Tag() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: pop - IL_0002: ldc.i4.0 - IL_0003: ret - } // end of method Expr::get_Tag - - .method assembly hidebysig specialname - instance object __DebugDisplay() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+0.8A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::__DebugDisplay - - .method public strict virtual instance string - ToString() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class ABC/ABC/Expr>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::ToString - - .method public hidebysig virtual final - instance int32 CompareTo(class ABC/ABC/Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 64 (0x40) - .maxstack 4 - .locals init ([0] class ABC/ABC/Expr V_0, - [1] class ABC/ABC/Expr V_1, - [2] class [mscorlib]System.Collections.IComparer V_2, - [3] int32 V_3, - [4] int32 V_4) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0036 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0034 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() - IL_0017: stloc.2 - IL_0018: ldloc.0 - IL_0019: ldfld int32 ABC/ABC/Expr::item - IL_001e: stloc.3 - IL_001f: ldloc.1 - IL_0020: ldfld int32 ABC/ABC/Expr::item - IL_0025: stloc.s V_4 - IL_0027: ldloc.3 - IL_0028: ldloc.s V_4 - IL_002a: bge.s IL_002e - - .line 100001,100001 : 0,0 '' - IL_002c: ldc.i4.m1 - IL_002d: ret - - .line 100001,100001 : 0,0 '' - IL_002e: ldloc.3 - IL_002f: ldloc.s V_4 - IL_0031: cgt - IL_0033: ret - - .line 100001,100001 : 0,0 '' - IL_0034: ldc.i4.1 - IL_0035: ret - - .line 100001,100001 : 0,0 '' - IL_0036: ldarg.1 - IL_0037: ldnull - IL_0038: cgt.un - IL_003a: brfalse.s IL_003e - - .line 100001,100001 : 0,0 '' - IL_003c: ldc.i4.m1 - IL_003d: ret - - .line 100001,100001 : 0,0 '' - IL_003e: ldc.i4.0 - IL_003f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 13 (0xd) - .maxstack 8 - .line 16,16 : 18,22 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: unbox.any ABC/ABC/Expr - IL_0007: callvirt instance int32 ABC/ABC/Expr::CompareTo(class ABC/ABC/Expr) - IL_000c: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj, - class [mscorlib]System.Collections.IComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 80 (0x50) - .maxstack 4 - .locals init ([0] class ABC/ABC/Expr V_0, - [1] class ABC/ABC/Expr V_1, - [2] class ABC/ABC/Expr V_2, - [3] class [mscorlib]System.Collections.IComparer V_3, - [4] int32 V_4, - [5] int32 V_5) - .line 16,16 : 18,22 '' - IL_0000: ldarg.1 - IL_0001: unbox.any ABC/ABC/Expr - IL_0006: stloc.0 - IL_0007: ldarg.0 - IL_0008: ldnull - IL_0009: cgt.un - IL_000b: brfalse.s IL_0041 - - .line 100001,100001 : 0,0 '' - IL_000d: ldarg.1 - IL_000e: unbox.any ABC/ABC/Expr - IL_0013: ldnull - IL_0014: cgt.un - IL_0016: brfalse.s IL_003f - - .line 100001,100001 : 0,0 '' - IL_0018: ldarg.0 - IL_0019: pop - .line 100001,100001 : 0,0 '' - IL_001a: ldarg.0 - IL_001b: stloc.1 - IL_001c: ldloc.0 - IL_001d: stloc.2 - IL_001e: ldarg.2 - IL_001f: stloc.3 - IL_0020: ldloc.1 - IL_0021: ldfld int32 ABC/ABC/Expr::item - IL_0026: stloc.s V_4 - IL_0028: ldloc.2 - IL_0029: ldfld int32 ABC/ABC/Expr::item - IL_002e: stloc.s V_5 - IL_0030: ldloc.s V_4 - IL_0032: ldloc.s V_5 - IL_0034: bge.s IL_0038 - - .line 100001,100001 : 0,0 '' - IL_0036: ldc.i4.m1 - IL_0037: ret - - .line 100001,100001 : 0,0 '' - IL_0038: ldloc.s V_4 - IL_003a: ldloc.s V_5 - IL_003c: cgt - IL_003e: ret - - .line 100001,100001 : 0,0 '' - IL_003f: ldc.i4.1 - IL_0040: ret - - .line 100001,100001 : 0,0 '' - IL_0041: ldarg.1 - IL_0042: unbox.any ABC/ABC/Expr - IL_0047: ldnull - IL_0048: cgt.un - IL_004a: brfalse.s IL_004e - - .line 100001,100001 : 0,0 '' - IL_004c: ldc.i4.m1 - IL_004d: ret - - .line 100001,100001 : 0,0 '' - IL_004e: ldc.i4.0 - IL_004f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 41 (0x29) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class ABC/ABC/Expr V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0027 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldarg.0 - IL_0009: pop - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: stloc.1 - IL_000c: ldc.i4.0 - IL_000d: stloc.0 - IL_000e: ldc.i4 0x9e3779b9 - IL_0013: ldarg.1 - IL_0014: stloc.2 - IL_0015: ldloc.1 - IL_0016: ldfld int32 ABC/ABC/Expr::item - IL_001b: ldloc.0 - IL_001c: ldc.i4.6 - IL_001d: shl - IL_001e: ldloc.0 - IL_001f: ldc.i4.2 - IL_0020: shr - IL_0021: add - IL_0022: add - IL_0023: add - IL_0024: stloc.0 - IL_0025: ldloc.0 - IL_0026: ret - - .line 100001,100001 : 0,0 '' - IL_0027: ldc.i4.0 - IL_0028: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance int32 GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 16,16 : 18,22 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 ABC/ABC/Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance bool Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 52 (0x34) - .maxstack 4 - .locals init ([0] class ABC/ABC/Expr V_0, - [1] class ABC/ABC/Expr V_1, - [2] class ABC/ABC/Expr V_2, - [3] class ABC/ABC/Expr V_3, - [4] class [mscorlib]System.Collections.IEqualityComparer V_4) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_002c - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst ABC/ABC/Expr - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_002a - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldarg.0 - IL_0013: pop - .line 100001,100001 : 0,0 '' - IL_0014: ldarg.0 - IL_0015: stloc.2 - IL_0016: ldloc.1 - IL_0017: stloc.3 - IL_0018: ldarg.2 - IL_0019: stloc.s V_4 - IL_001b: ldloc.2 - IL_001c: ldfld int32 ABC/ABC/Expr::item - IL_0021: ldloc.3 - IL_0022: ldfld int32 ABC/ABC/Expr::item - IL_0027: ceq - IL_0029: ret - - .line 100001,100001 : 0,0 '' - IL_002a: ldc.i4.0 - IL_002b: ret - - .line 100001,100001 : 0,0 '' - IL_002c: ldarg.1 - IL_002d: ldnull - IL_002e: cgt.un - IL_0030: ldc.i4.0 - IL_0031: ceq - IL_0033: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(class ABC/ABC/Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 43 (0x2b) - .maxstack 4 - .locals init ([0] class ABC/ABC/Expr V_0, - [1] class ABC/ABC/Expr V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0023 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0021 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: ldfld int32 ABC/ABC/Expr::item - IL_0018: ldloc.1 - IL_0019: ldfld int32 ABC/ABC/Expr::item - IL_001e: ceq - IL_0020: ret - - .line 100001,100001 : 0,0 '' - IL_0021: ldc.i4.0 - IL_0022: ret - - .line 100001,100001 : 0,0 '' - IL_0023: ldarg.1 - IL_0024: ldnull - IL_0025: cgt.un - IL_0027: ldc.i4.0 - IL_0028: ceq - IL_002a: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class ABC/ABC/Expr V_0) - .line 16,16 : 18,22 '' - IL_0000: ldarg.1 - IL_0001: isinst ABC/ABC/Expr - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool ABC/ABC/Expr::Equals(class ABC/ABC/Expr) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method Expr::Equals - - .property instance int32 Tag() - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .get instance int32 ABC/ABC/Expr::get_Tag() - } // end of property Expr::Tag - .property instance int32 Item() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .get instance int32 ABC/ABC/Expr::get_Item() - } // end of property Expr::Item - } // end of class Expr - - .class auto ansi serializable nested public beforefieldinit MyExn - extends [mscorlib]System.Exception - implements [mscorlib]System.Collections.IStructuralEquatable - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) - .field assembly int32 Data0@ - .method public specialname rtspecialname - instance void .ctor(int32 data0) cil managed - { - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 ABC/ABC/MyExn::Data0@ - IL_000d: ret - } // end of method MyExn::.ctor - - .method public specialname rtspecialname - instance void .ctor() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ret - } // end of method MyExn::.ctor - - .method family specialname rtspecialname - instance void .ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo info, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext context) cil managed - { - // Code size 9 (0x9) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: ldarg.2 - IL_0003: call instance void [mscorlib]System.Exception::.ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext) - IL_0008: ret - } // end of method MyExn::.ctor - - .method public hidebysig specialname - instance int32 get_Data0() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 ABC/ABC/MyExn::Data0@ - IL_0006: ret - } // end of method MyExn::get_Data0 - - .method public hidebysig virtual instance int32 - GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 40 (0x28) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class [mscorlib]System.Collections.IEqualityComparer V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0026 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldc.i4 0x9e3779b9 - IL_000d: ldarg.1 - IL_000e: stloc.1 - IL_000f: ldarg.0 - IL_0010: castclass ABC/ABC/MyExn - IL_0015: call instance int32 ABC/ABC/MyExn::get_Data0() - IL_001a: ldloc.0 - IL_001b: ldc.i4.6 - IL_001c: shl - IL_001d: ldloc.0 - IL_001e: ldc.i4.2 - IL_001f: shr - IL_0020: add - IL_0021: add - IL_0022: add - IL_0023: stloc.0 - IL_0024: ldloc.0 - IL_0025: ret - - .line 100001,100001 : 0,0 '' - IL_0026: ldc.i4.0 - IL_0027: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance int32 - GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 17,17 : 23,28 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 ABC/ABC/MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance bool - Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 67 (0x43) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0, - [1] class [mscorlib]System.Exception V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_003b - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst [mscorlib]System.Exception - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_0039 - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0018: brtrue.s IL_001c - - IL_001a: br.s IL_0037 - - .line 100001,100001 : 0,0 '' - IL_001c: ldarg.2 - IL_001d: stloc.2 - IL_001e: ldarg.0 - IL_001f: castclass ABC/ABC/MyExn - IL_0024: call instance int32 ABC/ABC/MyExn::get_Data0() - IL_0029: ldloc.1 - IL_002a: castclass ABC/ABC/MyExn - IL_002f: call instance int32 ABC/ABC/MyExn::get_Data0() - IL_0034: ceq - IL_0036: ret - - .line 100001,100001 : 0,0 '' - IL_0037: ldc.i4.0 - IL_0038: ret - - .line 100001,100001 : 0,0 '' - IL_0039: ldc.i4.0 - IL_003a: ret - - .line 100001,100001 : 0,0 '' - IL_003b: ldarg.1 - IL_003c: ldnull - IL_003d: cgt.un - IL_003f: ldc.i4.0 - IL_0040: ceq - IL_0042: ret - } // end of method MyExn::Equals - - .method public hidebysig instance bool - Equals(class [mscorlib]System.Exception obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 59 (0x3b) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0033 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0031 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 - IL_000d: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0012: brtrue.s IL_0016 - - IL_0014: br.s IL_002f - - .line 100001,100001 : 0,0 '' - IL_0016: ldarg.0 - IL_0017: castclass ABC/ABC/MyExn - IL_001c: call instance int32 ABC/ABC/MyExn::get_Data0() - IL_0021: ldarg.1 - IL_0022: castclass ABC/ABC/MyExn - IL_0027: call instance int32 ABC/ABC/MyExn::get_Data0() - IL_002c: ceq - IL_002e: ret - - .line 100001,100001 : 0,0 '' - IL_002f: ldc.i4.0 - IL_0030: ret - - .line 100001,100001 : 0,0 '' - IL_0031: ldc.i4.0 - IL_0032: ret - - .line 100001,100001 : 0,0 '' - IL_0033: ldarg.1 - IL_0034: ldnull - IL_0035: cgt.un - IL_0037: ldc.i4.0 - IL_0038: ceq - IL_003a: ret - } // end of method MyExn::Equals - - .method public hidebysig virtual instance bool - Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0) - .line 17,17 : 23,28 '' - IL_0000: ldarg.1 - IL_0001: isinst [mscorlib]System.Exception - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool ABC/ABC/MyExn::Equals(class [mscorlib]System.Exception) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method MyExn::Equals - - .property instance int32 Data0() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) - .get instance int32 ABC/ABC/MyExn::get_Data0() - } // end of property MyExn::Data0 - } // end of class MyExn - - .class auto ansi serializable nested public A - extends [mscorlib]System.Object - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) - .field assembly string x - .method public specialname rtspecialname - instance void .ctor(string x) cil managed - { - // Code size 16 (0x10) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: pop - .line 18,18 : 20,21 '' - IL_0008: ldarg.0 - IL_0009: ldarg.1 - IL_000a: stfld string ABC/ABC/A::x - .line 18,18 : 18,19 '' - IL_000f: ret - } // end of method A::.ctor - - .method public hidebysig specialname - instance string get_X() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - .line 18,18 : 46,47 '' - IL_0000: ldarg.0 - IL_0001: ldfld string ABC/ABC/A::x - IL_0006: ret - } // end of method A::get_X - - .property instance string X() - { - .get instance string ABC/ABC/A::get_X() - } // end of property A::X - } // end of class A - - .method public static int32 'add'(int32 x, - int32 y) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - .line 21,21 : 27,32 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: add - IL_0003: ret - } // end of method ABC::'add' - - .method public specialname static string - get_greeting() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 6 (0x6) - .maxstack 8 - IL_0000: ldstr "hello" - IL_0005: ret - } // end of method ABC::get_greeting - - .property string greeting() - { - .get string ABC/ABC::get_greeting() - } // end of property ABC::greeting - } // end of class ABC - - .method public static int32 'add'(int32 x, - int32 y) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - .line 11,11 : 23,28 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: add - IL_0003: ret - } // end of method ABC::'add' - - .method public specialname static string - get_greeting() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 6 (0x6) - .maxstack 8 - IL_0000: ldstr "hello" - IL_0005: ret - } // end of method ABC::get_greeting - - .property string greeting() - { - .get string ABC::get_greeting() - } // end of property ABC::greeting -} // end of class ABC - -.class private abstract auto ansi sealed ''.$ABC - extends [mscorlib]System.Object -{ - .field static assembly int32 init@ - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .method private specialname rtspecialname static - void .cctor() cil managed - { - // Code size 13 (0xd) - .maxstack 3 - .locals init ([0] string greeting, - [1] string V_1) - .line 12,12 : 9,31 '' - IL_0000: call string ABC::get_greeting() - IL_0005: stloc.0 - .line 22,22 : 13,35 '' - IL_0006: call string ABC/ABC::get_greeting() - IL_000b: stloc.1 - IL_000c: ret - } // end of method $ABC::.cctor - -} // end of class ''.$ABC - - -// ============================================================= - -// *********** DISASSEMBLY COMPLETE *********************** diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModuleP.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModuleP.il.bsl new file mode 100644 index 00000000000..771eaa3d503 --- /dev/null +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModuleP.il.bsl @@ -0,0 +1,1737 @@ + +// Microsoft (R) .NET Framework IL Disassembler. Version 4.6.81.0 +// Copyright (c) Microsoft Corporation. All rights reserved. + + + +// Metadata version: v4.0.30319 +.assembly extern retargetable mscorlib +{ + .publickeytoken = (7C EC 85 D7 BE A7 79 8E ) // |.....y. + .ver 2:0:5:0 +} +.assembly extern FSharp.Core +{ + .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: + .ver 3:47:41:0 +} +.assembly ToplevelModuleP +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32, + int32, + int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + + // --- The following custom attribute is added automatically, do not uncomment ------- + // .custom instance void [mscorlib]System.Diagnostics.DebuggableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggableAttribute/DebuggingModes) = ( 01 00 00 01 00 00 00 00 ) + + .hash algorithm 0x00008004 + .ver 0:0:0:0 +} +.mresource public FSharpSignatureData.ToplevelModuleP +{ + // Offset: 0x00000000 Length: 0x0000114F +} +.mresource public FSharpOptimizationData.ToplevelModuleP +{ + // Offset: 0x00001158 Length: 0x000003FE +} +.module ToplevelModuleP.dll +// MVID: {576266E1-5A3A-8E4D-A745-0383E1666257} +.imagebase 0x00400000 +.file alignment 0x00000200 +.stackreserve 0x00100000 +.subsystem 0x0003 // WINDOWS_CUI +.corflags 0x00000001 // ILONLY +// Image base: 0x00A70000 + + +// =============== CLASS MEMBERS DECLARATION =================== + +.class public abstract auto ansi sealed ABC + extends [mscorlib]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto autochar sealed nested public beforefieldinit Expr + extends [mscorlib]System.Object + implements class [mscorlib]System.IEquatable`1, + [mscorlib]System.Collections.IStructuralEquatable, + class [mscorlib]System.IComparable`1, + [mscorlib]System.IComparable, + [mscorlib]System.Collections.IStructuralComparable + { + .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl + 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) + .field assembly initonly int32 item + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method public static class ABC/Expr + NewNum(int32 item) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: newobj instance void ABC/Expr::.ctor(int32) + IL_0006: ret + } // end of method Expr::NewNum + + .method assembly specialname rtspecialname + instance void .ctor(int32 item) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 ABC/Expr::item + IL_000d: ret + } // end of method Expr::.ctor + + .method public hidebysig instance int32 + get_Item() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 ABC/Expr::item + IL_0006: ret + } // end of method Expr::get_Item + + .method public hidebysig instance int32 + get_Tag() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 4 (0x4) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: pop + IL_0002: ldc.i4.0 + IL_0003: ret + } // end of method Expr::get_Tag + + .method assembly hidebysig specialname + instance object __DebugDisplay() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%+0.8A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::__DebugDisplay + + .method public strict virtual instance string + ToString() cil managed + { + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::ToString + + .method public hidebysig virtual final + instance int32 CompareTo(class ABC/Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 81 (0x51) + .maxstack 4 + .locals init (class ABC/Expr V_0, + class ABC/Expr V_1, + class [mscorlib]System.Collections.IComparer V_2, + int32 V_3, + int32 V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0043 + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_0041 + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_0020: stloc.2 + IL_0021: ldloc.0 + IL_0022: ldfld int32 ABC/Expr::item + IL_0027: stloc.3 + IL_0028: ldloc.1 + IL_0029: ldfld int32 ABC/Expr::item + IL_002e: stloc.s V_4 + IL_0030: ldloc.3 + IL_0031: ldloc.s V_4 + IL_0033: bge.s IL_0037 + + IL_0035: br.s IL_0039 + + IL_0037: br.s IL_003b + + IL_0039: ldc.i4.m1 + IL_003a: ret + + IL_003b: ldloc.3 + IL_003c: ldloc.s V_4 + IL_003e: cgt + IL_0040: ret + + IL_0041: ldc.i4.1 + IL_0042: ret + + IL_0043: ldarg.1 + IL_0044: ldnull + IL_0045: cgt.un + IL_0047: brfalse.s IL_004b + + IL_0049: br.s IL_004d + + IL_004b: br.s IL_004f + + IL_004d: ldc.i4.m1 + IL_004e: ret + + IL_004f: ldc.i4.0 + IL_0050: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' + .line 6,6 : 14,18 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\SerializableAttribute\\ToplevelModule.fs' + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: unbox.any ABC/Expr + IL_0008: callvirt instance int32 ABC/Expr::CompareTo(class ABC/Expr) + IL_000d: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj, + class [mscorlib]System.Collections.IComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 97 (0x61) + .maxstack 4 + .locals init ([0] class ABC/Expr V_0, + [1] class ABC/Expr V_1, + [2] class ABC/Expr V_2, + [3] class [mscorlib]System.Collections.IComparer V_3, + [4] int32 V_4, + [5] int32 V_5) + .line 6,6 : 14,18 + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: unbox.any ABC/Expr + IL_0007: stloc.0 + IL_0008: ldarg.0 + IL_0009: ldnull + IL_000a: cgt.un + IL_000c: brfalse.s IL_0010 + + IL_000e: br.s IL_0012 + + IL_0010: br.s IL_004e + + .line 100001,100001 : 0,0 + IL_0012: ldarg.1 + IL_0013: unbox.any ABC/Expr + IL_0018: ldnull + IL_0019: cgt.un + IL_001b: brfalse.s IL_001f + + IL_001d: br.s IL_0021 + + IL_001f: br.s IL_004c + + .line 100001,100001 : 0,0 + IL_0021: ldarg.0 + IL_0022: pop + .line 100001,100001 : 0,0 + IL_0023: ldarg.0 + IL_0024: stloc.1 + IL_0025: ldloc.0 + IL_0026: stloc.2 + IL_0027: ldarg.2 + IL_0028: stloc.3 + IL_0029: ldloc.1 + IL_002a: ldfld int32 ABC/Expr::item + IL_002f: stloc.s V_4 + IL_0031: ldloc.2 + IL_0032: ldfld int32 ABC/Expr::item + IL_0037: stloc.s V_5 + IL_0039: ldloc.s V_4 + IL_003b: ldloc.s V_5 + IL_003d: bge.s IL_0041 + + IL_003f: br.s IL_0043 + + IL_0041: br.s IL_0045 + + .line 100001,100001 : 0,0 + IL_0043: ldc.i4.m1 + IL_0044: ret + + .line 100001,100001 : 0,0 + IL_0045: ldloc.s V_4 + IL_0047: ldloc.s V_5 + IL_0049: cgt + IL_004b: ret + + .line 100001,100001 : 0,0 + IL_004c: ldc.i4.1 + IL_004d: ret + + .line 100001,100001 : 0,0 + IL_004e: ldarg.1 + IL_004f: unbox.any ABC/Expr + IL_0054: ldnull + IL_0055: cgt.un + IL_0057: brfalse.s IL_005b + + IL_0059: br.s IL_005d + + IL_005b: br.s IL_005f + + .line 100001,100001 : 0,0 + IL_005d: ldc.i4.m1 + IL_005e: ret + + .line 100001,100001 : 0,0 + IL_005f: ldc.i4.0 + IL_0060: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 46 (0x2e) + .maxstack 7 + .locals init (int32 V_0, + class ABC/Expr V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldarg.0 + IL_000e: pop + IL_000f: ldarg.0 + IL_0010: stloc.1 + IL_0011: ldc.i4.0 + IL_0012: stloc.0 + IL_0013: ldc.i4 0x9e3779b9 + IL_0018: ldarg.1 + IL_0019: stloc.2 + IL_001a: ldloc.1 + IL_001b: ldfld int32 ABC/Expr::item + IL_0020: ldloc.0 + IL_0021: ldc.i4.6 + IL_0022: shl + IL_0023: ldloc.0 + IL_0024: ldc.i4.2 + IL_0025: shr + IL_0026: add + IL_0027: add + IL_0028: add + IL_0029: stloc.0 + IL_002a: ldloc.0 + IL_002b: ret + + IL_002c: ldc.i4.0 + IL_002d: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance int32 GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 6,6 : 14,18 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 ABC/Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance bool Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 61 (0x3d) + .maxstack 4 + .locals init (class ABC/Expr V_0, + class ABC/Expr V_1, + class ABC/Expr V_2, + class ABC/Expr V_3, + class [mscorlib]System.Collections.IEqualityComparer V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0035 + + IL_000b: ldarg.1 + IL_000c: isinst ABC/Expr + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0033 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldarg.0 + IL_001c: pop + IL_001d: ldarg.0 + IL_001e: stloc.2 + IL_001f: ldloc.1 + IL_0020: stloc.3 + IL_0021: ldarg.2 + IL_0022: stloc.s V_4 + IL_0024: ldloc.2 + IL_0025: ldfld int32 ABC/Expr::item + IL_002a: ldloc.3 + IL_002b: ldfld int32 ABC/Expr::item + IL_0030: ceq + IL_0032: ret + + IL_0033: ldc.i4.0 + IL_0034: ret + + IL_0035: ldarg.1 + IL_0036: ldnull + IL_0037: cgt.un + IL_0039: ldc.i4.0 + IL_003a: ceq + IL_003c: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(class ABC/Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 52 (0x34) + .maxstack 4 + .locals init (class ABC/Expr V_0, + class ABC/Expr V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_002a + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: ldfld int32 ABC/Expr::item + IL_0021: ldloc.1 + IL_0022: ldfld int32 ABC/Expr::item + IL_0027: ceq + IL_0029: ret + + IL_002a: ldc.i4.0 + IL_002b: ret + + IL_002c: ldarg.1 + IL_002d: ldnull + IL_002e: cgt.un + IL_0030: ldc.i4.0 + IL_0031: ceq + IL_0033: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class ABC/Expr V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst ABC/Expr + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool ABC/Expr::Equals(class ABC/Expr) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method Expr::Equals + + .property instance int32 Tag() + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .get instance int32 ABC/Expr::get_Tag() + } // end of property Expr::Tag + .property instance int32 Item() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .get instance int32 ABC/Expr::get_Item() + } // end of property Expr::Item + } // end of class Expr + + .class auto ansi nested public beforefieldinit MyExn + extends [mscorlib]System.Exception + implements [mscorlib]System.Collections.IStructuralEquatable + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) + .field assembly int32 Data0@ + .method public specialname rtspecialname + instance void .ctor(int32 data0) cil managed + { + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 ABC/MyExn::Data0@ + IL_000d: ret + } // end of method MyExn::.ctor + + .method public specialname rtspecialname + instance void .ctor() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ret + } // end of method MyExn::.ctor + + .method public hidebysig specialname + instance int32 get_Data0() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 ABC/MyExn::Data0@ + IL_0006: ret + } // end of method MyExn::get_Data0 + + .method public hidebysig virtual instance int32 + GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 45 (0x2d) + .maxstack 7 + .locals init (int32 V_0, + class [mscorlib]System.Collections.IEqualityComparer V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002b + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldc.i4 0x9e3779b9 + IL_0012: ldarg.1 + IL_0013: stloc.1 + IL_0014: ldarg.0 + IL_0015: castclass ABC/MyExn + IL_001a: call instance int32 ABC/MyExn::get_Data0() + IL_001f: ldloc.0 + IL_0020: ldc.i4.6 + IL_0021: shl + IL_0022: ldloc.0 + IL_0023: ldc.i4.2 + IL_0024: shr + IL_0025: add + IL_0026: add + IL_0027: add + IL_0028: stloc.0 + IL_0029: ldloc.0 + IL_002a: ret + + IL_002b: ldc.i4.0 + IL_002c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance int32 + GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 7,7 : 19,24 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 ABC/MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance bool + Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 76 (0x4c) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0, + class [mscorlib]System.Exception V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0044 + + IL_000b: ldarg.1 + IL_000c: isinst [mscorlib]System.Exception + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0042 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_0021: brtrue.s IL_0025 + + IL_0023: br.s IL_0040 + + IL_0025: ldarg.2 + IL_0026: stloc.2 + IL_0027: ldarg.0 + IL_0028: castclass ABC/MyExn + IL_002d: call instance int32 ABC/MyExn::get_Data0() + IL_0032: ldloc.1 + IL_0033: castclass ABC/MyExn + IL_0038: call instance int32 ABC/MyExn::get_Data0() + IL_003d: ceq + IL_003f: ret + + IL_0040: ldc.i4.0 + IL_0041: ret + + IL_0042: ldc.i4.0 + IL_0043: ret + + IL_0044: ldarg.1 + IL_0045: ldnull + IL_0046: cgt.un + IL_0048: ldc.i4.0 + IL_0049: ceq + IL_004b: ret + } // end of method MyExn::Equals + + .method public hidebysig instance bool + Equals(class [mscorlib]System.Exception obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 68 (0x44) + .maxstack 4 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_003c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_003a + + IL_0015: ldarg.1 + IL_0016: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_001b: brtrue.s IL_001f + + IL_001d: br.s IL_0038 + + IL_001f: ldarg.0 + IL_0020: castclass ABC/MyExn + IL_0025: call instance int32 ABC/MyExn::get_Data0() + IL_002a: ldarg.1 + IL_002b: castclass ABC/MyExn + IL_0030: call instance int32 ABC/MyExn::get_Data0() + IL_0035: ceq + IL_0037: ret + + IL_0038: ldc.i4.0 + IL_0039: ret + + IL_003a: ldc.i4.0 + IL_003b: ret + + IL_003c: ldarg.1 + IL_003d: ldnull + IL_003e: cgt.un + IL_0040: ldc.i4.0 + IL_0041: ceq + IL_0043: ret + } // end of method MyExn::Equals + + .method public hidebysig virtual instance bool + Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst [mscorlib]System.Exception + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool ABC/MyExn::Equals(class [mscorlib]System.Exception) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method MyExn::Equals + + .property instance int32 Data0() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) + .get instance int32 ABC/MyExn::get_Data0() + } // end of property MyExn::Data0 + } // end of class MyExn + + .class auto ansi nested public A + extends [mscorlib]System.Object + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .field assembly string x + .method public specialname rtspecialname + instance void .ctor(string x) cil managed + { + // Code size 17 (0x11) + .maxstack 8 + .line 8,8 : 16,17 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: nop + IL_0009: ldarg.0 + IL_000a: ldarg.1 + IL_000b: stfld string ABC/A::x + .line 8,8 : 14,15 + IL_0010: ret + } // end of method A::.ctor + + .method public hidebysig specialname + instance string get_X() cil managed + { + // Code size 8 (0x8) + .maxstack 8 + .line 8,8 : 42,43 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldfld string ABC/A::x + IL_0007: ret + } // end of method A::get_X + + .property instance string X() + { + .get instance string ABC/A::get_X() + } // end of property A::X + } // end of class A + + .class abstract auto ansi sealed nested public ABC + extends [mscorlib]System.Object + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto autochar sealed nested public beforefieldinit Expr + extends [mscorlib]System.Object + implements class [mscorlib]System.IEquatable`1, + [mscorlib]System.Collections.IStructuralEquatable, + class [mscorlib]System.IComparable`1, + [mscorlib]System.IComparable, + [mscorlib]System.Collections.IStructuralComparable + { + .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl + 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) + .field assembly initonly int32 item + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method public static class ABC/ABC/Expr + NewNum(int32 item) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: newobj instance void ABC/ABC/Expr::.ctor(int32) + IL_0006: ret + } // end of method Expr::NewNum + + .method assembly specialname rtspecialname + instance void .ctor(int32 item) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 ABC/ABC/Expr::item + IL_000d: ret + } // end of method Expr::.ctor + + .method public hidebysig instance int32 + get_Item() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 ABC/ABC/Expr::item + IL_0006: ret + } // end of method Expr::get_Item + + .method public hidebysig instance int32 + get_Tag() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 4 (0x4) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: pop + IL_0002: ldc.i4.0 + IL_0003: ret + } // end of method Expr::get_Tag + + .method assembly hidebysig specialname + instance object __DebugDisplay() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%+0.8A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::__DebugDisplay + + .method public strict virtual instance string + ToString() cil managed + { + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::ToString + + .method public hidebysig virtual final + instance int32 CompareTo(class ABC/ABC/Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 81 (0x51) + .maxstack 4 + .locals init (class ABC/ABC/Expr V_0, + class ABC/ABC/Expr V_1, + class [mscorlib]System.Collections.IComparer V_2, + int32 V_3, + int32 V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0043 + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_0041 + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_0020: stloc.2 + IL_0021: ldloc.0 + IL_0022: ldfld int32 ABC/ABC/Expr::item + IL_0027: stloc.3 + IL_0028: ldloc.1 + IL_0029: ldfld int32 ABC/ABC/Expr::item + IL_002e: stloc.s V_4 + IL_0030: ldloc.3 + IL_0031: ldloc.s V_4 + IL_0033: bge.s IL_0037 + + IL_0035: br.s IL_0039 + + IL_0037: br.s IL_003b + + IL_0039: ldc.i4.m1 + IL_003a: ret + + IL_003b: ldloc.3 + IL_003c: ldloc.s V_4 + IL_003e: cgt + IL_0040: ret + + IL_0041: ldc.i4.1 + IL_0042: ret + + IL_0043: ldarg.1 + IL_0044: ldnull + IL_0045: cgt.un + IL_0047: brfalse.s IL_004b + + IL_0049: br.s IL_004d + + IL_004b: br.s IL_004f + + IL_004d: ldc.i4.m1 + IL_004e: ret + + IL_004f: ldc.i4.0 + IL_0050: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + .line 16,16 : 18,22 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: unbox.any ABC/ABC/Expr + IL_0008: callvirt instance int32 ABC/ABC/Expr::CompareTo(class ABC/ABC/Expr) + IL_000d: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj, + class [mscorlib]System.Collections.IComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 97 (0x61) + .maxstack 4 + .locals init ([0] class ABC/ABC/Expr V_0, + [1] class ABC/ABC/Expr V_1, + [2] class ABC/ABC/Expr V_2, + [3] class [mscorlib]System.Collections.IComparer V_3, + [4] int32 V_4, + [5] int32 V_5) + .line 16,16 : 18,22 + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: unbox.any ABC/ABC/Expr + IL_0007: stloc.0 + IL_0008: ldarg.0 + IL_0009: ldnull + IL_000a: cgt.un + IL_000c: brfalse.s IL_0010 + + IL_000e: br.s IL_0012 + + IL_0010: br.s IL_004e + + .line 100001,100001 : 0,0 + IL_0012: ldarg.1 + IL_0013: unbox.any ABC/ABC/Expr + IL_0018: ldnull + IL_0019: cgt.un + IL_001b: brfalse.s IL_001f + + IL_001d: br.s IL_0021 + + IL_001f: br.s IL_004c + + .line 100001,100001 : 0,0 + IL_0021: ldarg.0 + IL_0022: pop + .line 100001,100001 : 0,0 + IL_0023: ldarg.0 + IL_0024: stloc.1 + IL_0025: ldloc.0 + IL_0026: stloc.2 + IL_0027: ldarg.2 + IL_0028: stloc.3 + IL_0029: ldloc.1 + IL_002a: ldfld int32 ABC/ABC/Expr::item + IL_002f: stloc.s V_4 + IL_0031: ldloc.2 + IL_0032: ldfld int32 ABC/ABC/Expr::item + IL_0037: stloc.s V_5 + IL_0039: ldloc.s V_4 + IL_003b: ldloc.s V_5 + IL_003d: bge.s IL_0041 + + IL_003f: br.s IL_0043 + + IL_0041: br.s IL_0045 + + .line 100001,100001 : 0,0 + IL_0043: ldc.i4.m1 + IL_0044: ret + + .line 100001,100001 : 0,0 + IL_0045: ldloc.s V_4 + IL_0047: ldloc.s V_5 + IL_0049: cgt + IL_004b: ret + + .line 100001,100001 : 0,0 + IL_004c: ldc.i4.1 + IL_004d: ret + + .line 100001,100001 : 0,0 + IL_004e: ldarg.1 + IL_004f: unbox.any ABC/ABC/Expr + IL_0054: ldnull + IL_0055: cgt.un + IL_0057: brfalse.s IL_005b + + IL_0059: br.s IL_005d + + IL_005b: br.s IL_005f + + .line 100001,100001 : 0,0 + IL_005d: ldc.i4.m1 + IL_005e: ret + + .line 100001,100001 : 0,0 + IL_005f: ldc.i4.0 + IL_0060: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 46 (0x2e) + .maxstack 7 + .locals init (int32 V_0, + class ABC/ABC/Expr V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldarg.0 + IL_000e: pop + IL_000f: ldarg.0 + IL_0010: stloc.1 + IL_0011: ldc.i4.0 + IL_0012: stloc.0 + IL_0013: ldc.i4 0x9e3779b9 + IL_0018: ldarg.1 + IL_0019: stloc.2 + IL_001a: ldloc.1 + IL_001b: ldfld int32 ABC/ABC/Expr::item + IL_0020: ldloc.0 + IL_0021: ldc.i4.6 + IL_0022: shl + IL_0023: ldloc.0 + IL_0024: ldc.i4.2 + IL_0025: shr + IL_0026: add + IL_0027: add + IL_0028: add + IL_0029: stloc.0 + IL_002a: ldloc.0 + IL_002b: ret + + IL_002c: ldc.i4.0 + IL_002d: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance int32 GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 16,16 : 18,22 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 ABC/ABC/Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance bool Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 61 (0x3d) + .maxstack 4 + .locals init (class ABC/ABC/Expr V_0, + class ABC/ABC/Expr V_1, + class ABC/ABC/Expr V_2, + class ABC/ABC/Expr V_3, + class [mscorlib]System.Collections.IEqualityComparer V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0035 + + IL_000b: ldarg.1 + IL_000c: isinst ABC/ABC/Expr + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0033 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldarg.0 + IL_001c: pop + IL_001d: ldarg.0 + IL_001e: stloc.2 + IL_001f: ldloc.1 + IL_0020: stloc.3 + IL_0021: ldarg.2 + IL_0022: stloc.s V_4 + IL_0024: ldloc.2 + IL_0025: ldfld int32 ABC/ABC/Expr::item + IL_002a: ldloc.3 + IL_002b: ldfld int32 ABC/ABC/Expr::item + IL_0030: ceq + IL_0032: ret + + IL_0033: ldc.i4.0 + IL_0034: ret + + IL_0035: ldarg.1 + IL_0036: ldnull + IL_0037: cgt.un + IL_0039: ldc.i4.0 + IL_003a: ceq + IL_003c: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(class ABC/ABC/Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 52 (0x34) + .maxstack 4 + .locals init (class ABC/ABC/Expr V_0, + class ABC/ABC/Expr V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_002a + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: ldfld int32 ABC/ABC/Expr::item + IL_0021: ldloc.1 + IL_0022: ldfld int32 ABC/ABC/Expr::item + IL_0027: ceq + IL_0029: ret + + IL_002a: ldc.i4.0 + IL_002b: ret + + IL_002c: ldarg.1 + IL_002d: ldnull + IL_002e: cgt.un + IL_0030: ldc.i4.0 + IL_0031: ceq + IL_0033: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class ABC/ABC/Expr V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst ABC/ABC/Expr + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool ABC/ABC/Expr::Equals(class ABC/ABC/Expr) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method Expr::Equals + + .property instance int32 Tag() + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .get instance int32 ABC/ABC/Expr::get_Tag() + } // end of property Expr::Tag + .property instance int32 Item() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .get instance int32 ABC/ABC/Expr::get_Item() + } // end of property Expr::Item + } // end of class Expr + + .class auto ansi nested public beforefieldinit MyExn + extends [mscorlib]System.Exception + implements [mscorlib]System.Collections.IStructuralEquatable + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) + .field assembly int32 Data0@ + .method public specialname rtspecialname + instance void .ctor(int32 data0) cil managed + { + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 ABC/ABC/MyExn::Data0@ + IL_000d: ret + } // end of method MyExn::.ctor + + .method public specialname rtspecialname + instance void .ctor() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ret + } // end of method MyExn::.ctor + + .method public hidebysig specialname + instance int32 get_Data0() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 ABC/ABC/MyExn::Data0@ + IL_0006: ret + } // end of method MyExn::get_Data0 + + .method public hidebysig virtual instance int32 + GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 45 (0x2d) + .maxstack 7 + .locals init (int32 V_0, + class [mscorlib]System.Collections.IEqualityComparer V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002b + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldc.i4 0x9e3779b9 + IL_0012: ldarg.1 + IL_0013: stloc.1 + IL_0014: ldarg.0 + IL_0015: castclass ABC/ABC/MyExn + IL_001a: call instance int32 ABC/ABC/MyExn::get_Data0() + IL_001f: ldloc.0 + IL_0020: ldc.i4.6 + IL_0021: shl + IL_0022: ldloc.0 + IL_0023: ldc.i4.2 + IL_0024: shr + IL_0025: add + IL_0026: add + IL_0027: add + IL_0028: stloc.0 + IL_0029: ldloc.0 + IL_002a: ret + + IL_002b: ldc.i4.0 + IL_002c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance int32 + GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 17,17 : 23,28 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 ABC/ABC/MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance bool + Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 76 (0x4c) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0, + class [mscorlib]System.Exception V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0044 + + IL_000b: ldarg.1 + IL_000c: isinst [mscorlib]System.Exception + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0042 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_0021: brtrue.s IL_0025 + + IL_0023: br.s IL_0040 + + IL_0025: ldarg.2 + IL_0026: stloc.2 + IL_0027: ldarg.0 + IL_0028: castclass ABC/ABC/MyExn + IL_002d: call instance int32 ABC/ABC/MyExn::get_Data0() + IL_0032: ldloc.1 + IL_0033: castclass ABC/ABC/MyExn + IL_0038: call instance int32 ABC/ABC/MyExn::get_Data0() + IL_003d: ceq + IL_003f: ret + + IL_0040: ldc.i4.0 + IL_0041: ret + + IL_0042: ldc.i4.0 + IL_0043: ret + + IL_0044: ldarg.1 + IL_0045: ldnull + IL_0046: cgt.un + IL_0048: ldc.i4.0 + IL_0049: ceq + IL_004b: ret + } // end of method MyExn::Equals + + .method public hidebysig instance bool + Equals(class [mscorlib]System.Exception obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 68 (0x44) + .maxstack 4 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_003c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_003a + + IL_0015: ldarg.1 + IL_0016: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_001b: brtrue.s IL_001f + + IL_001d: br.s IL_0038 + + IL_001f: ldarg.0 + IL_0020: castclass ABC/ABC/MyExn + IL_0025: call instance int32 ABC/ABC/MyExn::get_Data0() + IL_002a: ldarg.1 + IL_002b: castclass ABC/ABC/MyExn + IL_0030: call instance int32 ABC/ABC/MyExn::get_Data0() + IL_0035: ceq + IL_0037: ret + + IL_0038: ldc.i4.0 + IL_0039: ret + + IL_003a: ldc.i4.0 + IL_003b: ret + + IL_003c: ldarg.1 + IL_003d: ldnull + IL_003e: cgt.un + IL_0040: ldc.i4.0 + IL_0041: ceq + IL_0043: ret + } // end of method MyExn::Equals + + .method public hidebysig virtual instance bool + Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst [mscorlib]System.Exception + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool ABC/ABC/MyExn::Equals(class [mscorlib]System.Exception) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method MyExn::Equals + + .property instance int32 Data0() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) + .get instance int32 ABC/ABC/MyExn::get_Data0() + } // end of property MyExn::Data0 + } // end of class MyExn + + .class auto ansi nested public A + extends [mscorlib]System.Object + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .field assembly string x + .method public specialname rtspecialname + instance void .ctor(string x) cil managed + { + // Code size 17 (0x11) + .maxstack 8 + .line 18,18 : 20,21 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: nop + IL_0009: ldarg.0 + IL_000a: ldarg.1 + IL_000b: stfld string ABC/ABC/A::x + .line 18,18 : 18,19 + IL_0010: ret + } // end of method A::.ctor + + .method public hidebysig specialname + instance string get_X() cil managed + { + // Code size 8 (0x8) + .maxstack 8 + .line 18,18 : 46,47 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldfld string ABC/ABC/A::x + IL_0007: ret + } // end of method A::get_X + + .property instance string X() + { + .get instance string ABC/ABC/A::get_X() + } // end of property A::X + } // end of class A + + .method public static int32 'add'(int32 x, + int32 y) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) + // Code size 5 (0x5) + .maxstack 8 + .line 21,21 : 27,32 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: add + IL_0004: ret + } // end of method ABC::'add' + + .method public specialname static string + get_greeting() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: nop + IL_0001: ldstr "hello" + IL_0006: ret + } // end of method ABC::get_greeting + + .property string greeting() + { + .get string ABC/ABC::get_greeting() + } // end of property ABC::greeting + } // end of class ABC + + .method public static int32 'add'(int32 x, + int32 y) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) + // Code size 5 (0x5) + .maxstack 8 + .line 11,11 : 23,28 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: add + IL_0004: ret + } // end of method ABC::'add' + + .method public specialname static string + get_greeting() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: nop + IL_0001: ldstr "hello" + IL_0006: ret + } // end of method ABC::get_greeting + + .property string greeting() + { + .get string ABC::get_greeting() + } // end of property ABC::greeting +} // end of class ABC + +.class private abstract auto ansi sealed ''.$ABC + extends [mscorlib]System.Object +{ + .field static assembly int32 init@ + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method private specialname rtspecialname static + void .cctor() cil managed + { + // Code size 14 (0xe) + .maxstack 3 + .locals init ([0] string greeting, + [1] string V_1) + .line 12,12 : 9,31 '' + IL_0000: nop + IL_0001: call string ABC::get_greeting() + IL_0006: stloc.0 + .line 22,22 : 13,35 '' + IL_0007: call string ABC/ABC::get_greeting() + IL_000c: stloc.1 + IL_000d: ret + } // end of method $ABC::.cctor +} // end of class ''.$ABC + + +// ============================================================= + +// *********** DISASSEMBLY COMPLETE *********************** diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl index 32f8ac85d82..bf83c61d107 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl @@ -1,2435 +1,4 @@ -// Microsoft (R) .NET Framework IL Disassembler. Version 4.8.3928.0 +// Microsoft (R) .NET Framework IL Disassembler. Version 4.6.1055.0 // Copyright (c) Microsoft Corporation. All rights reserved. - - -// Metadata version: v4.0.30319 -.assembly extern mscorlib -{ - .publickeytoken = (B7 7A 5C 56 19 34 E0 89 ) // .z\V.4.. - .ver 4:0:0:0 -} -.assembly extern FSharp.Core -{ - .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 5:0:0:0 -} -.assembly ToplevelNamespace -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32, - int32, - int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) - - // --- The following custom attribute is added automatically, do not uncomment ------- - // .custom instance void [mscorlib]System.Diagnostics.DebuggableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggableAttribute/DebuggingModes) = ( 01 00 01 01 00 00 00 00 ) - - .hash algorithm 0x00008004 - .ver 0:0:0:0 -} -.mresource public FSharpSignatureData.ToplevelNamespace -{ - // Offset: 0x00000000 Length: 0x00001848 -} -.mresource public FSharpOptimizationData.ToplevelNamespace -{ - // Offset: 0x00001850 Length: 0x0000055C -} -.module ToplevelNamespace.dll -// MVID: {60D48932-218B-729A-A745-03833289D460} -.imagebase 0x00400000 -.file alignment 0x00000200 -.stackreserve 0x00100000 -.subsystem 0x0003 // WINDOWS_CUI -.corflags 0x00000001 // ILONLY -// Image base: 0x04F20000 - - -// =============== CLASS MEMBERS DECLARATION =================== - -.class public auto autochar serializable sealed beforefieldinit XYZ.Expr - extends [mscorlib]System.Object - implements class [mscorlib]System.IEquatable`1, - [mscorlib]System.Collections.IStructuralEquatable, - class [mscorlib]System.IComparable`1, - [mscorlib]System.IComparable, - [mscorlib]System.Collections.IStructuralComparable -{ - .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl - 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) - .field assembly initonly int32 item - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .method public static class XYZ.Expr NewNum(int32 item) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: newobj instance void XYZ.Expr::.ctor(int32) - IL_0006: ret - } // end of method Expr::NewNum - - .method assembly specialname rtspecialname - instance void .ctor(int32 item) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 XYZ.Expr::item - IL_000d: ret - } // end of method Expr::.ctor - - .method public hidebysig instance int32 - get_Item() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 XYZ.Expr::item - IL_0006: ret - } // end of method Expr::get_Item - - .method public hidebysig instance int32 - get_Tag() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: pop - IL_0002: ldc.i4.0 - IL_0003: ret - } // end of method Expr::get_Tag - - .method assembly hidebysig specialname - instance object __DebugDisplay() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+0.8A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::__DebugDisplay - - .method public strict virtual instance string - ToString() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class XYZ.Expr>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::ToString - - .method public hidebysig virtual final - instance int32 CompareTo(class XYZ.Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 64 (0x40) - .maxstack 4 - .locals init ([0] class XYZ.Expr V_0, - [1] class XYZ.Expr V_1, - [2] class [mscorlib]System.Collections.IComparer V_2, - [3] int32 V_3, - [4] int32 V_4) - .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 100001,100001 : 0,0 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\SerializableAttribute\\ToplevelNamespace.fs' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0036 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0034 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() - IL_0017: stloc.2 - IL_0018: ldloc.0 - IL_0019: ldfld int32 XYZ.Expr::item - IL_001e: stloc.3 - IL_001f: ldloc.1 - IL_0020: ldfld int32 XYZ.Expr::item - IL_0025: stloc.s V_4 - IL_0027: ldloc.3 - IL_0028: ldloc.s V_4 - IL_002a: bge.s IL_002e - - .line 100001,100001 : 0,0 '' - IL_002c: ldc.i4.m1 - IL_002d: ret - - .line 100001,100001 : 0,0 '' - IL_002e: ldloc.3 - IL_002f: ldloc.s V_4 - IL_0031: cgt - IL_0033: ret - - .line 100001,100001 : 0,0 '' - IL_0034: ldc.i4.1 - IL_0035: ret - - .line 100001,100001 : 0,0 '' - IL_0036: ldarg.1 - IL_0037: ldnull - IL_0038: cgt.un - IL_003a: brfalse.s IL_003e - - .line 100001,100001 : 0,0 '' - IL_003c: ldc.i4.m1 - IL_003d: ret - - .line 100001,100001 : 0,0 '' - IL_003e: ldc.i4.0 - IL_003f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 13 (0xd) - .maxstack 8 - .line 7,7 : 10,14 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: unbox.any XYZ.Expr - IL_0007: callvirt instance int32 XYZ.Expr::CompareTo(class XYZ.Expr) - IL_000c: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj, - class [mscorlib]System.Collections.IComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 80 (0x50) - .maxstack 4 - .locals init ([0] class XYZ.Expr V_0, - [1] class XYZ.Expr V_1, - [2] class XYZ.Expr V_2, - [3] class [mscorlib]System.Collections.IComparer V_3, - [4] int32 V_4, - [5] int32 V_5) - .line 7,7 : 10,14 '' - IL_0000: ldarg.1 - IL_0001: unbox.any XYZ.Expr - IL_0006: stloc.0 - IL_0007: ldarg.0 - IL_0008: ldnull - IL_0009: cgt.un - IL_000b: brfalse.s IL_0041 - - .line 100001,100001 : 0,0 '' - IL_000d: ldarg.1 - IL_000e: unbox.any XYZ.Expr - IL_0013: ldnull - IL_0014: cgt.un - IL_0016: brfalse.s IL_003f - - .line 100001,100001 : 0,0 '' - IL_0018: ldarg.0 - IL_0019: pop - .line 100001,100001 : 0,0 '' - IL_001a: ldarg.0 - IL_001b: stloc.1 - IL_001c: ldloc.0 - IL_001d: stloc.2 - IL_001e: ldarg.2 - IL_001f: stloc.3 - IL_0020: ldloc.1 - IL_0021: ldfld int32 XYZ.Expr::item - IL_0026: stloc.s V_4 - IL_0028: ldloc.2 - IL_0029: ldfld int32 XYZ.Expr::item - IL_002e: stloc.s V_5 - IL_0030: ldloc.s V_4 - IL_0032: ldloc.s V_5 - IL_0034: bge.s IL_0038 - - .line 100001,100001 : 0,0 '' - IL_0036: ldc.i4.m1 - IL_0037: ret - - .line 100001,100001 : 0,0 '' - IL_0038: ldloc.s V_4 - IL_003a: ldloc.s V_5 - IL_003c: cgt - IL_003e: ret - - .line 100001,100001 : 0,0 '' - IL_003f: ldc.i4.1 - IL_0040: ret - - .line 100001,100001 : 0,0 '' - IL_0041: ldarg.1 - IL_0042: unbox.any XYZ.Expr - IL_0047: ldnull - IL_0048: cgt.un - IL_004a: brfalse.s IL_004e - - .line 100001,100001 : 0,0 '' - IL_004c: ldc.i4.m1 - IL_004d: ret - - .line 100001,100001 : 0,0 '' - IL_004e: ldc.i4.0 - IL_004f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 41 (0x29) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class XYZ.Expr V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0027 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldarg.0 - IL_0009: pop - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: stloc.1 - IL_000c: ldc.i4.0 - IL_000d: stloc.0 - IL_000e: ldc.i4 0x9e3779b9 - IL_0013: ldarg.1 - IL_0014: stloc.2 - IL_0015: ldloc.1 - IL_0016: ldfld int32 XYZ.Expr::item - IL_001b: ldloc.0 - IL_001c: ldc.i4.6 - IL_001d: shl - IL_001e: ldloc.0 - IL_001f: ldc.i4.2 - IL_0020: shr - IL_0021: add - IL_0022: add - IL_0023: add - IL_0024: stloc.0 - IL_0025: ldloc.0 - IL_0026: ret - - .line 100001,100001 : 0,0 '' - IL_0027: ldc.i4.0 - IL_0028: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance int32 GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 7,7 : 10,14 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 XYZ.Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance bool Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 52 (0x34) - .maxstack 4 - .locals init ([0] class XYZ.Expr V_0, - [1] class XYZ.Expr V_1, - [2] class XYZ.Expr V_2, - [3] class XYZ.Expr V_3, - [4] class [mscorlib]System.Collections.IEqualityComparer V_4) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_002c - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst XYZ.Expr - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_002a - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldarg.0 - IL_0013: pop - .line 100001,100001 : 0,0 '' - IL_0014: ldarg.0 - IL_0015: stloc.2 - IL_0016: ldloc.1 - IL_0017: stloc.3 - IL_0018: ldarg.2 - IL_0019: stloc.s V_4 - IL_001b: ldloc.2 - IL_001c: ldfld int32 XYZ.Expr::item - IL_0021: ldloc.3 - IL_0022: ldfld int32 XYZ.Expr::item - IL_0027: ceq - IL_0029: ret - - .line 100001,100001 : 0,0 '' - IL_002a: ldc.i4.0 - IL_002b: ret - - .line 100001,100001 : 0,0 '' - IL_002c: ldarg.1 - IL_002d: ldnull - IL_002e: cgt.un - IL_0030: ldc.i4.0 - IL_0031: ceq - IL_0033: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(class XYZ.Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 43 (0x2b) - .maxstack 4 - .locals init ([0] class XYZ.Expr V_0, - [1] class XYZ.Expr V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0023 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0021 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: ldfld int32 XYZ.Expr::item - IL_0018: ldloc.1 - IL_0019: ldfld int32 XYZ.Expr::item - IL_001e: ceq - IL_0020: ret - - .line 100001,100001 : 0,0 '' - IL_0021: ldc.i4.0 - IL_0022: ret - - .line 100001,100001 : 0,0 '' - IL_0023: ldarg.1 - IL_0024: ldnull - IL_0025: cgt.un - IL_0027: ldc.i4.0 - IL_0028: ceq - IL_002a: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class XYZ.Expr V_0) - .line 7,7 : 10,14 '' - IL_0000: ldarg.1 - IL_0001: isinst XYZ.Expr - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool XYZ.Expr::Equals(class XYZ.Expr) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method Expr::Equals - - .property instance int32 Tag() - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .get instance int32 XYZ.Expr::get_Tag() - } // end of property Expr::Tag - .property instance int32 Item() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .get instance int32 XYZ.Expr::get_Item() - } // end of property Expr::Item -} // end of class XYZ.Expr - -.class public auto ansi serializable beforefieldinit XYZ.MyExn - extends [mscorlib]System.Exception - implements [mscorlib]System.Collections.IStructuralEquatable -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) - .field assembly int32 Data0@ - .method public specialname rtspecialname - instance void .ctor(int32 data0) cil managed - { - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 XYZ.MyExn::Data0@ - IL_000d: ret - } // end of method MyExn::.ctor - - .method public specialname rtspecialname - instance void .ctor() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ret - } // end of method MyExn::.ctor - - .method family specialname rtspecialname - instance void .ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo info, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext context) cil managed - { - // Code size 9 (0x9) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: ldarg.2 - IL_0003: call instance void [mscorlib]System.Exception::.ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext) - IL_0008: ret - } // end of method MyExn::.ctor - - .method public hidebysig specialname instance int32 - get_Data0() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 XYZ.MyExn::Data0@ - IL_0006: ret - } // end of method MyExn::get_Data0 - - .method public hidebysig virtual instance int32 - GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 40 (0x28) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class [mscorlib]System.Collections.IEqualityComparer V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0026 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldc.i4 0x9e3779b9 - IL_000d: ldarg.1 - IL_000e: stloc.1 - IL_000f: ldarg.0 - IL_0010: castclass XYZ.MyExn - IL_0015: call instance int32 XYZ.MyExn::get_Data0() - IL_001a: ldloc.0 - IL_001b: ldc.i4.6 - IL_001c: shl - IL_001d: ldloc.0 - IL_001e: ldc.i4.2 - IL_001f: shr - IL_0020: add - IL_0021: add - IL_0022: add - IL_0023: stloc.0 - IL_0024: ldloc.0 - IL_0025: ret - - .line 100001,100001 : 0,0 '' - IL_0026: ldc.i4.0 - IL_0027: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance int32 - GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 8,8 : 15,20 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 XYZ.MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance bool - Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 67 (0x43) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0, - [1] class [mscorlib]System.Exception V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_003b - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst [mscorlib]System.Exception - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_0039 - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0018: brtrue.s IL_001c - - IL_001a: br.s IL_0037 - - .line 100001,100001 : 0,0 '' - IL_001c: ldarg.2 - IL_001d: stloc.2 - IL_001e: ldarg.0 - IL_001f: castclass XYZ.MyExn - IL_0024: call instance int32 XYZ.MyExn::get_Data0() - IL_0029: ldloc.1 - IL_002a: castclass XYZ.MyExn - IL_002f: call instance int32 XYZ.MyExn::get_Data0() - IL_0034: ceq - IL_0036: ret - - .line 100001,100001 : 0,0 '' - IL_0037: ldc.i4.0 - IL_0038: ret - - .line 100001,100001 : 0,0 '' - IL_0039: ldc.i4.0 - IL_003a: ret - - .line 100001,100001 : 0,0 '' - IL_003b: ldarg.1 - IL_003c: ldnull - IL_003d: cgt.un - IL_003f: ldc.i4.0 - IL_0040: ceq - IL_0042: ret - } // end of method MyExn::Equals - - .method public hidebysig instance bool - Equals(class [mscorlib]System.Exception obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 59 (0x3b) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0033 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0031 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 - IL_000d: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0012: brtrue.s IL_0016 - - IL_0014: br.s IL_002f - - .line 100001,100001 : 0,0 '' - IL_0016: ldarg.0 - IL_0017: castclass XYZ.MyExn - IL_001c: call instance int32 XYZ.MyExn::get_Data0() - IL_0021: ldarg.1 - IL_0022: castclass XYZ.MyExn - IL_0027: call instance int32 XYZ.MyExn::get_Data0() - IL_002c: ceq - IL_002e: ret - - .line 100001,100001 : 0,0 '' - IL_002f: ldc.i4.0 - IL_0030: ret - - .line 100001,100001 : 0,0 '' - IL_0031: ldc.i4.0 - IL_0032: ret - - .line 100001,100001 : 0,0 '' - IL_0033: ldarg.1 - IL_0034: ldnull - IL_0035: cgt.un - IL_0037: ldc.i4.0 - IL_0038: ceq - IL_003a: ret - } // end of method MyExn::Equals - - .method public hidebysig virtual instance bool - Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0) - .line 8,8 : 15,20 '' - IL_0000: ldarg.1 - IL_0001: isinst [mscorlib]System.Exception - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool XYZ.MyExn::Equals(class [mscorlib]System.Exception) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method MyExn::Equals - - .property instance int32 Data0() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) - .get instance int32 XYZ.MyExn::get_Data0() - } // end of property MyExn::Data0 -} // end of class XYZ.MyExn - -.class public auto ansi serializable XYZ.A - extends [mscorlib]System.Object -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) - .field assembly string x - .method public specialname rtspecialname - instance void .ctor(string x) cil managed - { - // Code size 16 (0x10) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: pop - .line 9,9 : 12,13 '' - IL_0008: ldarg.0 - IL_0009: ldarg.1 - IL_000a: stfld string XYZ.A::x - .line 9,9 : 10,11 '' - IL_000f: ret - } // end of method A::.ctor - - .method public hidebysig specialname instance string - get_X() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - .line 9,9 : 38,39 '' - IL_0000: ldarg.0 - IL_0001: ldfld string XYZ.A::x - IL_0006: ret - } // end of method A::get_X - - .property instance string X() - { - .get instance string XYZ.A::get_X() - } // end of property A::X -} // end of class XYZ.A - -.class public abstract auto ansi sealed XYZ.ABC - extends [mscorlib]System.Object -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) - .class auto autochar serializable sealed nested public beforefieldinit Expr - extends [mscorlib]System.Object - implements class [mscorlib]System.IEquatable`1, - [mscorlib]System.Collections.IStructuralEquatable, - class [mscorlib]System.IComparable`1, - [mscorlib]System.IComparable, - [mscorlib]System.Collections.IStructuralComparable - { - .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl - 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) - .field assembly initonly int32 item - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .method public static class XYZ.ABC/Expr - NewNum(int32 item) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: newobj instance void XYZ.ABC/Expr::.ctor(int32) - IL_0006: ret - } // end of method Expr::NewNum - - .method assembly specialname rtspecialname - instance void .ctor(int32 item) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 XYZ.ABC/Expr::item - IL_000d: ret - } // end of method Expr::.ctor - - .method public hidebysig instance int32 - get_Item() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 XYZ.ABC/Expr::item - IL_0006: ret - } // end of method Expr::get_Item - - .method public hidebysig instance int32 - get_Tag() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: pop - IL_0002: ldc.i4.0 - IL_0003: ret - } // end of method Expr::get_Tag - - .method assembly hidebysig specialname - instance object __DebugDisplay() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+0.8A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::__DebugDisplay - - .method public strict virtual instance string - ToString() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class XYZ.ABC/Expr>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::ToString - - .method public hidebysig virtual final - instance int32 CompareTo(class XYZ.ABC/Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 64 (0x40) - .maxstack 4 - .locals init ([0] class XYZ.ABC/Expr V_0, - [1] class XYZ.ABC/Expr V_1, - [2] class [mscorlib]System.Collections.IComparer V_2, - [3] int32 V_3, - [4] int32 V_4) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0036 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0034 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() - IL_0017: stloc.2 - IL_0018: ldloc.0 - IL_0019: ldfld int32 XYZ.ABC/Expr::item - IL_001e: stloc.3 - IL_001f: ldloc.1 - IL_0020: ldfld int32 XYZ.ABC/Expr::item - IL_0025: stloc.s V_4 - IL_0027: ldloc.3 - IL_0028: ldloc.s V_4 - IL_002a: bge.s IL_002e - - .line 100001,100001 : 0,0 '' - IL_002c: ldc.i4.m1 - IL_002d: ret - - .line 100001,100001 : 0,0 '' - IL_002e: ldloc.3 - IL_002f: ldloc.s V_4 - IL_0031: cgt - IL_0033: ret - - .line 100001,100001 : 0,0 '' - IL_0034: ldc.i4.1 - IL_0035: ret - - .line 100001,100001 : 0,0 '' - IL_0036: ldarg.1 - IL_0037: ldnull - IL_0038: cgt.un - IL_003a: brfalse.s IL_003e - - .line 100001,100001 : 0,0 '' - IL_003c: ldc.i4.m1 - IL_003d: ret - - .line 100001,100001 : 0,0 '' - IL_003e: ldc.i4.0 - IL_003f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 13 (0xd) - .maxstack 8 - .line 13,13 : 14,18 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: unbox.any XYZ.ABC/Expr - IL_0007: callvirt instance int32 XYZ.ABC/Expr::CompareTo(class XYZ.ABC/Expr) - IL_000c: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj, - class [mscorlib]System.Collections.IComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 80 (0x50) - .maxstack 4 - .locals init ([0] class XYZ.ABC/Expr V_0, - [1] class XYZ.ABC/Expr V_1, - [2] class XYZ.ABC/Expr V_2, - [3] class [mscorlib]System.Collections.IComparer V_3, - [4] int32 V_4, - [5] int32 V_5) - .line 13,13 : 14,18 '' - IL_0000: ldarg.1 - IL_0001: unbox.any XYZ.ABC/Expr - IL_0006: stloc.0 - IL_0007: ldarg.0 - IL_0008: ldnull - IL_0009: cgt.un - IL_000b: brfalse.s IL_0041 - - .line 100001,100001 : 0,0 '' - IL_000d: ldarg.1 - IL_000e: unbox.any XYZ.ABC/Expr - IL_0013: ldnull - IL_0014: cgt.un - IL_0016: brfalse.s IL_003f - - .line 100001,100001 : 0,0 '' - IL_0018: ldarg.0 - IL_0019: pop - .line 100001,100001 : 0,0 '' - IL_001a: ldarg.0 - IL_001b: stloc.1 - IL_001c: ldloc.0 - IL_001d: stloc.2 - IL_001e: ldarg.2 - IL_001f: stloc.3 - IL_0020: ldloc.1 - IL_0021: ldfld int32 XYZ.ABC/Expr::item - IL_0026: stloc.s V_4 - IL_0028: ldloc.2 - IL_0029: ldfld int32 XYZ.ABC/Expr::item - IL_002e: stloc.s V_5 - IL_0030: ldloc.s V_4 - IL_0032: ldloc.s V_5 - IL_0034: bge.s IL_0038 - - .line 100001,100001 : 0,0 '' - IL_0036: ldc.i4.m1 - IL_0037: ret - - .line 100001,100001 : 0,0 '' - IL_0038: ldloc.s V_4 - IL_003a: ldloc.s V_5 - IL_003c: cgt - IL_003e: ret - - .line 100001,100001 : 0,0 '' - IL_003f: ldc.i4.1 - IL_0040: ret - - .line 100001,100001 : 0,0 '' - IL_0041: ldarg.1 - IL_0042: unbox.any XYZ.ABC/Expr - IL_0047: ldnull - IL_0048: cgt.un - IL_004a: brfalse.s IL_004e - - .line 100001,100001 : 0,0 '' - IL_004c: ldc.i4.m1 - IL_004d: ret - - .line 100001,100001 : 0,0 '' - IL_004e: ldc.i4.0 - IL_004f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 41 (0x29) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class XYZ.ABC/Expr V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0027 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldarg.0 - IL_0009: pop - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: stloc.1 - IL_000c: ldc.i4.0 - IL_000d: stloc.0 - IL_000e: ldc.i4 0x9e3779b9 - IL_0013: ldarg.1 - IL_0014: stloc.2 - IL_0015: ldloc.1 - IL_0016: ldfld int32 XYZ.ABC/Expr::item - IL_001b: ldloc.0 - IL_001c: ldc.i4.6 - IL_001d: shl - IL_001e: ldloc.0 - IL_001f: ldc.i4.2 - IL_0020: shr - IL_0021: add - IL_0022: add - IL_0023: add - IL_0024: stloc.0 - IL_0025: ldloc.0 - IL_0026: ret - - .line 100001,100001 : 0,0 '' - IL_0027: ldc.i4.0 - IL_0028: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance int32 GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 13,13 : 14,18 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 XYZ.ABC/Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance bool Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 52 (0x34) - .maxstack 4 - .locals init ([0] class XYZ.ABC/Expr V_0, - [1] class XYZ.ABC/Expr V_1, - [2] class XYZ.ABC/Expr V_2, - [3] class XYZ.ABC/Expr V_3, - [4] class [mscorlib]System.Collections.IEqualityComparer V_4) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_002c - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst XYZ.ABC/Expr - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_002a - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldarg.0 - IL_0013: pop - .line 100001,100001 : 0,0 '' - IL_0014: ldarg.0 - IL_0015: stloc.2 - IL_0016: ldloc.1 - IL_0017: stloc.3 - IL_0018: ldarg.2 - IL_0019: stloc.s V_4 - IL_001b: ldloc.2 - IL_001c: ldfld int32 XYZ.ABC/Expr::item - IL_0021: ldloc.3 - IL_0022: ldfld int32 XYZ.ABC/Expr::item - IL_0027: ceq - IL_0029: ret - - .line 100001,100001 : 0,0 '' - IL_002a: ldc.i4.0 - IL_002b: ret - - .line 100001,100001 : 0,0 '' - IL_002c: ldarg.1 - IL_002d: ldnull - IL_002e: cgt.un - IL_0030: ldc.i4.0 - IL_0031: ceq - IL_0033: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(class XYZ.ABC/Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 43 (0x2b) - .maxstack 4 - .locals init ([0] class XYZ.ABC/Expr V_0, - [1] class XYZ.ABC/Expr V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0023 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0021 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: ldfld int32 XYZ.ABC/Expr::item - IL_0018: ldloc.1 - IL_0019: ldfld int32 XYZ.ABC/Expr::item - IL_001e: ceq - IL_0020: ret - - .line 100001,100001 : 0,0 '' - IL_0021: ldc.i4.0 - IL_0022: ret - - .line 100001,100001 : 0,0 '' - IL_0023: ldarg.1 - IL_0024: ldnull - IL_0025: cgt.un - IL_0027: ldc.i4.0 - IL_0028: ceq - IL_002a: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class XYZ.ABC/Expr V_0) - .line 13,13 : 14,18 '' - IL_0000: ldarg.1 - IL_0001: isinst XYZ.ABC/Expr - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool XYZ.ABC/Expr::Equals(class XYZ.ABC/Expr) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method Expr::Equals - - .property instance int32 Tag() - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .get instance int32 XYZ.ABC/Expr::get_Tag() - } // end of property Expr::Tag - .property instance int32 Item() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .get instance int32 XYZ.ABC/Expr::get_Item() - } // end of property Expr::Item - } // end of class Expr - - .class auto ansi serializable nested public beforefieldinit MyExn - extends [mscorlib]System.Exception - implements [mscorlib]System.Collections.IStructuralEquatable - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) - .field assembly int32 Data0@ - .method public specialname rtspecialname - instance void .ctor(int32 data0) cil managed - { - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 XYZ.ABC/MyExn::Data0@ - IL_000d: ret - } // end of method MyExn::.ctor - - .method public specialname rtspecialname - instance void .ctor() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ret - } // end of method MyExn::.ctor - - .method family specialname rtspecialname - instance void .ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo info, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext context) cil managed - { - // Code size 9 (0x9) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: ldarg.2 - IL_0003: call instance void [mscorlib]System.Exception::.ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext) - IL_0008: ret - } // end of method MyExn::.ctor - - .method public hidebysig specialname - instance int32 get_Data0() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 XYZ.ABC/MyExn::Data0@ - IL_0006: ret - } // end of method MyExn::get_Data0 - - .method public hidebysig virtual instance int32 - GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 40 (0x28) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class [mscorlib]System.Collections.IEqualityComparer V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0026 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldc.i4 0x9e3779b9 - IL_000d: ldarg.1 - IL_000e: stloc.1 - IL_000f: ldarg.0 - IL_0010: castclass XYZ.ABC/MyExn - IL_0015: call instance int32 XYZ.ABC/MyExn::get_Data0() - IL_001a: ldloc.0 - IL_001b: ldc.i4.6 - IL_001c: shl - IL_001d: ldloc.0 - IL_001e: ldc.i4.2 - IL_001f: shr - IL_0020: add - IL_0021: add - IL_0022: add - IL_0023: stloc.0 - IL_0024: ldloc.0 - IL_0025: ret - - .line 100001,100001 : 0,0 '' - IL_0026: ldc.i4.0 - IL_0027: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance int32 - GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 14,14 : 19,24 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 XYZ.ABC/MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance bool - Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 67 (0x43) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0, - [1] class [mscorlib]System.Exception V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_003b - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst [mscorlib]System.Exception - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_0039 - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0018: brtrue.s IL_001c - - IL_001a: br.s IL_0037 - - .line 100001,100001 : 0,0 '' - IL_001c: ldarg.2 - IL_001d: stloc.2 - IL_001e: ldarg.0 - IL_001f: castclass XYZ.ABC/MyExn - IL_0024: call instance int32 XYZ.ABC/MyExn::get_Data0() - IL_0029: ldloc.1 - IL_002a: castclass XYZ.ABC/MyExn - IL_002f: call instance int32 XYZ.ABC/MyExn::get_Data0() - IL_0034: ceq - IL_0036: ret - - .line 100001,100001 : 0,0 '' - IL_0037: ldc.i4.0 - IL_0038: ret - - .line 100001,100001 : 0,0 '' - IL_0039: ldc.i4.0 - IL_003a: ret - - .line 100001,100001 : 0,0 '' - IL_003b: ldarg.1 - IL_003c: ldnull - IL_003d: cgt.un - IL_003f: ldc.i4.0 - IL_0040: ceq - IL_0042: ret - } // end of method MyExn::Equals - - .method public hidebysig instance bool - Equals(class [mscorlib]System.Exception obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 59 (0x3b) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0033 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0031 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 - IL_000d: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0012: brtrue.s IL_0016 - - IL_0014: br.s IL_002f - - .line 100001,100001 : 0,0 '' - IL_0016: ldarg.0 - IL_0017: castclass XYZ.ABC/MyExn - IL_001c: call instance int32 XYZ.ABC/MyExn::get_Data0() - IL_0021: ldarg.1 - IL_0022: castclass XYZ.ABC/MyExn - IL_0027: call instance int32 XYZ.ABC/MyExn::get_Data0() - IL_002c: ceq - IL_002e: ret - - .line 100001,100001 : 0,0 '' - IL_002f: ldc.i4.0 - IL_0030: ret - - .line 100001,100001 : 0,0 '' - IL_0031: ldc.i4.0 - IL_0032: ret - - .line 100001,100001 : 0,0 '' - IL_0033: ldarg.1 - IL_0034: ldnull - IL_0035: cgt.un - IL_0037: ldc.i4.0 - IL_0038: ceq - IL_003a: ret - } // end of method MyExn::Equals - - .method public hidebysig virtual instance bool - Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0) - .line 14,14 : 19,24 '' - IL_0000: ldarg.1 - IL_0001: isinst [mscorlib]System.Exception - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool XYZ.ABC/MyExn::Equals(class [mscorlib]System.Exception) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method MyExn::Equals - - .property instance int32 Data0() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) - .get instance int32 XYZ.ABC/MyExn::get_Data0() - } // end of property MyExn::Data0 - } // end of class MyExn - - .class auto ansi serializable nested public A - extends [mscorlib]System.Object - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) - .field assembly string x - .method public specialname rtspecialname - instance void .ctor(string x) cil managed - { - // Code size 16 (0x10) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: pop - .line 15,15 : 16,17 '' - IL_0008: ldarg.0 - IL_0009: ldarg.1 - IL_000a: stfld string XYZ.ABC/A::x - .line 15,15 : 14,15 '' - IL_000f: ret - } // end of method A::.ctor - - .method public hidebysig specialname - instance string get_X() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - .line 15,15 : 42,43 '' - IL_0000: ldarg.0 - IL_0001: ldfld string XYZ.ABC/A::x - IL_0006: ret - } // end of method A::get_X - - .property instance string X() - { - .get instance string XYZ.ABC/A::get_X() - } // end of property A::X - } // end of class A - - .class abstract auto ansi sealed nested public ABC - extends [mscorlib]System.Object - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) - .class auto autochar serializable sealed nested public beforefieldinit Expr - extends [mscorlib]System.Object - implements class [mscorlib]System.IEquatable`1, - [mscorlib]System.Collections.IStructuralEquatable, - class [mscorlib]System.IComparable`1, - [mscorlib]System.IComparable, - [mscorlib]System.Collections.IStructuralComparable - { - .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl - 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) - .field assembly initonly int32 item - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .method public static class XYZ.ABC/ABC/Expr - NewNum(int32 item) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: newobj instance void XYZ.ABC/ABC/Expr::.ctor(int32) - IL_0006: ret - } // end of method Expr::NewNum - - .method assembly specialname rtspecialname - instance void .ctor(int32 item) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 XYZ.ABC/ABC/Expr::item - IL_000d: ret - } // end of method Expr::.ctor - - .method public hidebysig instance int32 - get_Item() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_0006: ret - } // end of method Expr::get_Item - - .method public hidebysig instance int32 - get_Tag() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: pop - IL_0002: ldc.i4.0 - IL_0003: ret - } // end of method Expr::get_Tag - - .method assembly hidebysig specialname - instance object __DebugDisplay() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+0.8A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::__DebugDisplay - - .method public strict virtual instance string - ToString() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class XYZ.ABC/ABC/Expr>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Expr::ToString - - .method public hidebysig virtual final - instance int32 CompareTo(class XYZ.ABC/ABC/Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 64 (0x40) - .maxstack 4 - .locals init ([0] class XYZ.ABC/ABC/Expr V_0, - [1] class XYZ.ABC/ABC/Expr V_1, - [2] class [mscorlib]System.Collections.IComparer V_2, - [3] int32 V_3, - [4] int32 V_4) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0036 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0034 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() - IL_0017: stloc.2 - IL_0018: ldloc.0 - IL_0019: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_001e: stloc.3 - IL_001f: ldloc.1 - IL_0020: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_0025: stloc.s V_4 - IL_0027: ldloc.3 - IL_0028: ldloc.s V_4 - IL_002a: bge.s IL_002e - - .line 100001,100001 : 0,0 '' - IL_002c: ldc.i4.m1 - IL_002d: ret - - .line 100001,100001 : 0,0 '' - IL_002e: ldloc.3 - IL_002f: ldloc.s V_4 - IL_0031: cgt - IL_0033: ret - - .line 100001,100001 : 0,0 '' - IL_0034: ldc.i4.1 - IL_0035: ret - - .line 100001,100001 : 0,0 '' - IL_0036: ldarg.1 - IL_0037: ldnull - IL_0038: cgt.un - IL_003a: brfalse.s IL_003e - - .line 100001,100001 : 0,0 '' - IL_003c: ldc.i4.m1 - IL_003d: ret - - .line 100001,100001 : 0,0 '' - IL_003e: ldc.i4.0 - IL_003f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 13 (0xd) - .maxstack 8 - .line 23,23 : 18,22 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: unbox.any XYZ.ABC/ABC/Expr - IL_0007: callvirt instance int32 XYZ.ABC/ABC/Expr::CompareTo(class XYZ.ABC/ABC/Expr) - IL_000c: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj, - class [mscorlib]System.Collections.IComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 80 (0x50) - .maxstack 4 - .locals init ([0] class XYZ.ABC/ABC/Expr V_0, - [1] class XYZ.ABC/ABC/Expr V_1, - [2] class XYZ.ABC/ABC/Expr V_2, - [3] class [mscorlib]System.Collections.IComparer V_3, - [4] int32 V_4, - [5] int32 V_5) - .line 23,23 : 18,22 '' - IL_0000: ldarg.1 - IL_0001: unbox.any XYZ.ABC/ABC/Expr - IL_0006: stloc.0 - IL_0007: ldarg.0 - IL_0008: ldnull - IL_0009: cgt.un - IL_000b: brfalse.s IL_0041 - - .line 100001,100001 : 0,0 '' - IL_000d: ldarg.1 - IL_000e: unbox.any XYZ.ABC/ABC/Expr - IL_0013: ldnull - IL_0014: cgt.un - IL_0016: brfalse.s IL_003f - - .line 100001,100001 : 0,0 '' - IL_0018: ldarg.0 - IL_0019: pop - .line 100001,100001 : 0,0 '' - IL_001a: ldarg.0 - IL_001b: stloc.1 - IL_001c: ldloc.0 - IL_001d: stloc.2 - IL_001e: ldarg.2 - IL_001f: stloc.3 - IL_0020: ldloc.1 - IL_0021: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_0026: stloc.s V_4 - IL_0028: ldloc.2 - IL_0029: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_002e: stloc.s V_5 - IL_0030: ldloc.s V_4 - IL_0032: ldloc.s V_5 - IL_0034: bge.s IL_0038 - - .line 100001,100001 : 0,0 '' - IL_0036: ldc.i4.m1 - IL_0037: ret - - .line 100001,100001 : 0,0 '' - IL_0038: ldloc.s V_4 - IL_003a: ldloc.s V_5 - IL_003c: cgt - IL_003e: ret - - .line 100001,100001 : 0,0 '' - IL_003f: ldc.i4.1 - IL_0040: ret - - .line 100001,100001 : 0,0 '' - IL_0041: ldarg.1 - IL_0042: unbox.any XYZ.ABC/ABC/Expr - IL_0047: ldnull - IL_0048: cgt.un - IL_004a: brfalse.s IL_004e - - .line 100001,100001 : 0,0 '' - IL_004c: ldc.i4.m1 - IL_004d: ret - - .line 100001,100001 : 0,0 '' - IL_004e: ldc.i4.0 - IL_004f: ret - } // end of method Expr::CompareTo - - .method public hidebysig virtual final - instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 41 (0x29) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class XYZ.ABC/ABC/Expr V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0027 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldarg.0 - IL_0009: pop - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: stloc.1 - IL_000c: ldc.i4.0 - IL_000d: stloc.0 - IL_000e: ldc.i4 0x9e3779b9 - IL_0013: ldarg.1 - IL_0014: stloc.2 - IL_0015: ldloc.1 - IL_0016: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_001b: ldloc.0 - IL_001c: ldc.i4.6 - IL_001d: shl - IL_001e: ldloc.0 - IL_001f: ldc.i4.2 - IL_0020: shr - IL_0021: add - IL_0022: add - IL_0023: add - IL_0024: stloc.0 - IL_0025: ldloc.0 - IL_0026: ret - - .line 100001,100001 : 0,0 '' - IL_0027: ldc.i4.0 - IL_0028: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance int32 GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 23,23 : 18,22 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 XYZ.ABC/ABC/Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method Expr::GetHashCode - - .method public hidebysig virtual final - instance bool Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 52 (0x34) - .maxstack 4 - .locals init ([0] class XYZ.ABC/ABC/Expr V_0, - [1] class XYZ.ABC/ABC/Expr V_1, - [2] class XYZ.ABC/ABC/Expr V_2, - [3] class XYZ.ABC/ABC/Expr V_3, - [4] class [mscorlib]System.Collections.IEqualityComparer V_4) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_002c - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst XYZ.ABC/ABC/Expr - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_002a - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldarg.0 - IL_0013: pop - .line 100001,100001 : 0,0 '' - IL_0014: ldarg.0 - IL_0015: stloc.2 - IL_0016: ldloc.1 - IL_0017: stloc.3 - IL_0018: ldarg.2 - IL_0019: stloc.s V_4 - IL_001b: ldloc.2 - IL_001c: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_0021: ldloc.3 - IL_0022: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_0027: ceq - IL_0029: ret - - .line 100001,100001 : 0,0 '' - IL_002a: ldc.i4.0 - IL_002b: ret - - .line 100001,100001 : 0,0 '' - IL_002c: ldarg.1 - IL_002d: ldnull - IL_002e: cgt.un - IL_0030: ldc.i4.0 - IL_0031: ceq - IL_0033: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(class XYZ.ABC/ABC/Expr obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 43 (0x2b) - .maxstack 4 - .locals init ([0] class XYZ.ABC/ABC/Expr V_0, - [1] class XYZ.ABC/ABC/Expr V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0023 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0021 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: pop - .line 100001,100001 : 0,0 '' - IL_000e: ldarg.0 - IL_000f: stloc.0 - IL_0010: ldarg.1 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_0018: ldloc.1 - IL_0019: ldfld int32 XYZ.ABC/ABC/Expr::item - IL_001e: ceq - IL_0020: ret - - .line 100001,100001 : 0,0 '' - IL_0021: ldc.i4.0 - IL_0022: ret - - .line 100001,100001 : 0,0 '' - IL_0023: ldarg.1 - IL_0024: ldnull - IL_0025: cgt.un - IL_0027: ldc.i4.0 - IL_0028: ceq - IL_002a: ret - } // end of method Expr::Equals - - .method public hidebysig virtual final - instance bool Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class XYZ.ABC/ABC/Expr V_0) - .line 23,23 : 18,22 '' - IL_0000: ldarg.1 - IL_0001: isinst XYZ.ABC/ABC/Expr - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool XYZ.ABC/ABC/Expr::Equals(class XYZ.ABC/ABC/Expr) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method Expr::Equals - - .property instance int32 Tag() - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .get instance int32 XYZ.ABC/ABC/Expr::get_Tag() - } // end of property Expr::Tag - .property instance int32 Item() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .get instance int32 XYZ.ABC/ABC/Expr::get_Item() - } // end of property Expr::Item - } // end of class Expr - - .class auto ansi serializable nested public beforefieldinit MyExn - extends [mscorlib]System.Exception - implements [mscorlib]System.Collections.IStructuralEquatable - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) - .field assembly int32 Data0@ - .method public specialname rtspecialname - instance void .ctor(int32 data0) cil managed - { - // Code size 14 (0xe) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 XYZ.ABC/ABC/MyExn::Data0@ - IL_000d: ret - } // end of method MyExn::.ctor - - .method public specialname rtspecialname - instance void .ctor() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Exception::.ctor() - IL_0006: ret - } // end of method MyExn::.ctor - - .method family specialname rtspecialname - instance void .ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo info, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext context) cil managed - { - // Code size 9 (0x9) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: ldarg.2 - IL_0003: call instance void [mscorlib]System.Exception::.ctor(class [mscorlib]System.Runtime.Serialization.SerializationInfo, - valuetype [mscorlib]System.Runtime.Serialization.StreamingContext) - IL_0008: ret - } // end of method MyExn::.ctor - - .method public hidebysig specialname - instance int32 get_Data0() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 XYZ.ABC/ABC/MyExn::Data0@ - IL_0006: ret - } // end of method MyExn::get_Data0 - - .method public hidebysig virtual instance int32 - GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 40 (0x28) - .maxstack 7 - .locals init ([0] int32 V_0, - [1] class [mscorlib]System.Collections.IEqualityComparer V_1) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0026 - - .line 100001,100001 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldc.i4 0x9e3779b9 - IL_000d: ldarg.1 - IL_000e: stloc.1 - IL_000f: ldarg.0 - IL_0010: castclass XYZ.ABC/ABC/MyExn - IL_0015: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() - IL_001a: ldloc.0 - IL_001b: ldc.i4.6 - IL_001c: shl - IL_001d: ldloc.0 - IL_001e: ldc.i4.2 - IL_001f: shr - IL_0020: add - IL_0021: add - IL_0022: add - IL_0023: stloc.0 - IL_0024: ldloc.0 - IL_0025: ret - - .line 100001,100001 : 0,0 '' - IL_0026: ldc.i4.0 - IL_0027: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance int32 - GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 24,24 : 23,28 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 XYZ.ABC/ABC/MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method MyExn::GetHashCode - - .method public hidebysig virtual instance bool - Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 67 (0x43) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0, - [1] class [mscorlib]System.Exception V_1, - [2] class [mscorlib]System.Collections.IEqualityComparer V_2) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_003b - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst [mscorlib]System.Exception - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_0039 - - .line 100001,100001 : 0,0 '' - IL_0010: ldloc.0 - IL_0011: stloc.1 - IL_0012: ldloc.0 - IL_0013: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0018: brtrue.s IL_001c - - IL_001a: br.s IL_0037 - - .line 100001,100001 : 0,0 '' - IL_001c: ldarg.2 - IL_001d: stloc.2 - IL_001e: ldarg.0 - IL_001f: castclass XYZ.ABC/ABC/MyExn - IL_0024: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() - IL_0029: ldloc.1 - IL_002a: castclass XYZ.ABC/ABC/MyExn - IL_002f: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() - IL_0034: ceq - IL_0036: ret - - .line 100001,100001 : 0,0 '' - IL_0037: ldc.i4.0 - IL_0038: ret - - .line 100001,100001 : 0,0 '' - IL_0039: ldc.i4.0 - IL_003a: ret - - .line 100001,100001 : 0,0 '' - IL_003b: ldarg.1 - IL_003c: ldnull - IL_003d: cgt.un - IL_003f: ldc.i4.0 - IL_0040: ceq - IL_0042: ret - } // end of method MyExn::Equals - - .method public hidebysig instance bool - Equals(class [mscorlib]System.Exception obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 59 (0x3b) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0033 - - .line 100001,100001 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0031 - - .line 100001,100001 : 0,0 '' - IL_000c: ldarg.1 - IL_000d: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) - IL_0012: brtrue.s IL_0016 - - IL_0014: br.s IL_002f - - .line 100001,100001 : 0,0 '' - IL_0016: ldarg.0 - IL_0017: castclass XYZ.ABC/ABC/MyExn - IL_001c: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() - IL_0021: ldarg.1 - IL_0022: castclass XYZ.ABC/ABC/MyExn - IL_0027: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() - IL_002c: ceq - IL_002e: ret - - .line 100001,100001 : 0,0 '' - IL_002f: ldc.i4.0 - IL_0030: ret - - .line 100001,100001 : 0,0 '' - IL_0031: ldc.i4.0 - IL_0032: ret - - .line 100001,100001 : 0,0 '' - IL_0033: ldarg.1 - IL_0034: ldnull - IL_0035: cgt.un - IL_0037: ldc.i4.0 - IL_0038: ceq - IL_003a: ret - } // end of method MyExn::Equals - - .method public hidebysig virtual instance bool - Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class [mscorlib]System.Exception V_0) - .line 24,24 : 23,28 '' - IL_0000: ldarg.1 - IL_0001: isinst [mscorlib]System.Exception - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 100001,100001 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool XYZ.ABC/ABC/MyExn::Equals(class [mscorlib]System.Exception) - IL_0011: ret - - .line 100001,100001 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method MyExn::Equals - - .property instance int32 Data0() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) - .get instance int32 XYZ.ABC/ABC/MyExn::get_Data0() - } // end of property MyExn::Data0 - } // end of class MyExn - - .class auto ansi serializable nested public A - extends [mscorlib]System.Object - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) - .field assembly string x - .method public specialname rtspecialname - instance void .ctor(string x) cil managed - { - // Code size 16 (0x10) - .maxstack 8 - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: pop - .line 25,25 : 20,21 '' - IL_0008: ldarg.0 - IL_0009: ldarg.1 - IL_000a: stfld string XYZ.ABC/ABC/A::x - .line 25,25 : 18,19 '' - IL_000f: ret - } // end of method A::.ctor - - .method public hidebysig specialname - instance string get_X() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - .line 25,25 : 46,47 '' - IL_0000: ldarg.0 - IL_0001: ldfld string XYZ.ABC/ABC/A::x - IL_0006: ret - } // end of method A::get_X - - .property instance string X() - { - .get instance string XYZ.ABC/ABC/A::get_X() - } // end of property A::X - } // end of class A - - .method public static int32 'add'(int32 x, - int32 y) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - .line 28,28 : 27,32 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: add - IL_0003: ret - } // end of method ABC::'add' - - .method public specialname static string - get_greeting() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 6 (0x6) - .maxstack 8 - IL_0000: ldstr "hello" - IL_0005: ret - } // end of method ABC::get_greeting - - .property string greeting() - { - .get string XYZ.ABC/ABC::get_greeting() - } // end of property ABC::greeting - } // end of class ABC - - .method public static int32 'add'(int32 x, - int32 y) cil managed - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) - // Code size 4 (0x4) - .maxstack 8 - .line 18,18 : 23,28 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: add - IL_0003: ret - } // end of method ABC::'add' - - .method public specialname static string - get_greeting() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 6 (0x6) - .maxstack 8 - IL_0000: ldstr "hello" - IL_0005: ret - } // end of method ABC::get_greeting - - .property string greeting() - { - .get string XYZ.ABC::get_greeting() - } // end of property ABC::greeting -} // end of class XYZ.ABC - -.class private abstract auto ansi sealed ''.$ToplevelNamespace - extends [mscorlib]System.Object -{ - .field static assembly int32 init@ - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - .method private specialname rtspecialname static - void .cctor() cil managed - { - // Code size 13 (0xd) - .maxstack 3 - .locals init ([0] string greeting, - [1] string V_1) - .line 19,19 : 9,31 '' - IL_0000: call string XYZ.ABC::get_greeting() - IL_0005: stloc.0 - .line 29,29 : 13,35 '' - IL_0006: call string XYZ.ABC/ABC::get_greeting() - IL_000b: stloc.1 - IL_000c: ret - } // end of method $ToplevelNamespace::.cctor - -} // end of class ''.$ToplevelNamespace - - -// ============================================================= - -// *********** DISASSEMBLY COMPLETE *********************** diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespaceP.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespaceP.il.bsl new file mode 100644 index 00000000000..78d8c5dba0c --- /dev/null +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespaceP.il.bsl @@ -0,0 +1,2529 @@ + +// Microsoft (R) .NET Framework IL Disassembler. Version 4.6.81.0 +// Copyright (c) Microsoft Corporation. All rights reserved. + + + +// Metadata version: v4.0.30319 +.assembly extern retargetable mscorlib +{ + .publickeytoken = (7C EC 85 D7 BE A7 79 8E ) // |.....y. + .ver 2:0:5:0 +} +.assembly extern FSharp.Core +{ + .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: + .ver 3:47:41:0 +} +.assembly ToplevelNamespaceP +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32, + int32, + int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + + // --- The following custom attribute is added automatically, do not uncomment ------- + // .custom instance void [mscorlib]System.Diagnostics.DebuggableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggableAttribute/DebuggingModes) = ( 01 00 00 01 00 00 00 00 ) + + .hash algorithm 0x00008004 + .ver 0:0:0:0 +} +.mresource public FSharpSignatureData.ToplevelNamespaceP +{ + // Offset: 0x00000000 Length: 0x0000185A +} +.mresource public FSharpOptimizationData.ToplevelNamespaceP +{ + // Offset: 0x00001860 Length: 0x0000055D +} +.module ToplevelNamespaceP.dll +// MVID: {576266E4-88D9-D7FD-A745-0383E4666257} +.imagebase 0x00400000 +.file alignment 0x00000200 +.stackreserve 0x00100000 +.subsystem 0x0003 // WINDOWS_CUI +.corflags 0x00000001 // ILONLY +// Image base: 0x01450000 + + +// =============== CLASS MEMBERS DECLARATION =================== + +.class public auto autochar sealed beforefieldinit XYZ.Expr + extends [mscorlib]System.Object + implements class [mscorlib]System.IEquatable`1, + [mscorlib]System.Collections.IStructuralEquatable, + class [mscorlib]System.IComparable`1, + [mscorlib]System.IComparable, + [mscorlib]System.Collections.IStructuralComparable +{ + .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl + 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) + .field assembly initonly int32 item + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method public static class XYZ.Expr NewNum(int32 item) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: newobj instance void XYZ.Expr::.ctor(int32) + IL_0006: ret + } // end of method Expr::NewNum + + .method assembly specialname rtspecialname + instance void .ctor(int32 item) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 XYZ.Expr::item + IL_000d: ret + } // end of method Expr::.ctor + + .method public hidebysig instance int32 + get_Item() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 XYZ.Expr::item + IL_0006: ret + } // end of method Expr::get_Item + + .method public hidebysig instance int32 + get_Tag() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 4 (0x4) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: pop + IL_0002: ldc.i4.0 + IL_0003: ret + } // end of method Expr::get_Tag + + .method assembly hidebysig specialname + instance object __DebugDisplay() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%+0.8A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::__DebugDisplay + + .method public strict virtual instance string + ToString() cil managed + { + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::ToString + + .method public hidebysig virtual final + instance int32 CompareTo(class XYZ.Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 81 (0x51) + .maxstack 4 + .locals init (class XYZ.Expr V_0, + class XYZ.Expr V_1, + class [mscorlib]System.Collections.IComparer V_2, + int32 V_3, + int32 V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0043 + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_0041 + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_0020: stloc.2 + IL_0021: ldloc.0 + IL_0022: ldfld int32 XYZ.Expr::item + IL_0027: stloc.3 + IL_0028: ldloc.1 + IL_0029: ldfld int32 XYZ.Expr::item + IL_002e: stloc.s V_4 + IL_0030: ldloc.3 + IL_0031: ldloc.s V_4 + IL_0033: bge.s IL_0037 + + IL_0035: br.s IL_0039 + + IL_0037: br.s IL_003b + + IL_0039: ldc.i4.m1 + IL_003a: ret + + IL_003b: ldloc.3 + IL_003c: ldloc.s V_4 + IL_003e: cgt + IL_0040: ret + + IL_0041: ldc.i4.1 + IL_0042: ret + + IL_0043: ldarg.1 + IL_0044: ldnull + IL_0045: cgt.un + IL_0047: brfalse.s IL_004b + + IL_0049: br.s IL_004d + + IL_004b: br.s IL_004f + + IL_004d: ldc.i4.m1 + IL_004e: ret + + IL_004f: ldc.i4.0 + IL_0050: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' + .line 7,7 : 10,14 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\SerializableAttribute\\ToplevelNamespace.fs' + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: unbox.any XYZ.Expr + IL_0008: callvirt instance int32 XYZ.Expr::CompareTo(class XYZ.Expr) + IL_000d: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj, + class [mscorlib]System.Collections.IComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 97 (0x61) + .maxstack 4 + .locals init ([0] class XYZ.Expr V_0, + [1] class XYZ.Expr V_1, + [2] class XYZ.Expr V_2, + [3] class [mscorlib]System.Collections.IComparer V_3, + [4] int32 V_4, + [5] int32 V_5) + .line 7,7 : 10,14 + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: unbox.any XYZ.Expr + IL_0007: stloc.0 + IL_0008: ldarg.0 + IL_0009: ldnull + IL_000a: cgt.un + IL_000c: brfalse.s IL_0010 + + IL_000e: br.s IL_0012 + + IL_0010: br.s IL_004e + + .line 100001,100001 : 0,0 + IL_0012: ldarg.1 + IL_0013: unbox.any XYZ.Expr + IL_0018: ldnull + IL_0019: cgt.un + IL_001b: brfalse.s IL_001f + + IL_001d: br.s IL_0021 + + IL_001f: br.s IL_004c + + .line 100001,100001 : 0,0 + IL_0021: ldarg.0 + IL_0022: pop + .line 100001,100001 : 0,0 + IL_0023: ldarg.0 + IL_0024: stloc.1 + IL_0025: ldloc.0 + IL_0026: stloc.2 + IL_0027: ldarg.2 + IL_0028: stloc.3 + IL_0029: ldloc.1 + IL_002a: ldfld int32 XYZ.Expr::item + IL_002f: stloc.s V_4 + IL_0031: ldloc.2 + IL_0032: ldfld int32 XYZ.Expr::item + IL_0037: stloc.s V_5 + IL_0039: ldloc.s V_4 + IL_003b: ldloc.s V_5 + IL_003d: bge.s IL_0041 + + IL_003f: br.s IL_0043 + + IL_0041: br.s IL_0045 + + .line 100001,100001 : 0,0 + IL_0043: ldc.i4.m1 + IL_0044: ret + + .line 100001,100001 : 0,0 + IL_0045: ldloc.s V_4 + IL_0047: ldloc.s V_5 + IL_0049: cgt + IL_004b: ret + + .line 100001,100001 : 0,0 + IL_004c: ldc.i4.1 + IL_004d: ret + + .line 100001,100001 : 0,0 + IL_004e: ldarg.1 + IL_004f: unbox.any XYZ.Expr + IL_0054: ldnull + IL_0055: cgt.un + IL_0057: brfalse.s IL_005b + + IL_0059: br.s IL_005d + + IL_005b: br.s IL_005f + + .line 100001,100001 : 0,0 + IL_005d: ldc.i4.m1 + IL_005e: ret + + .line 100001,100001 : 0,0 + IL_005f: ldc.i4.0 + IL_0060: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 46 (0x2e) + .maxstack 7 + .locals init (int32 V_0, + class XYZ.Expr V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldarg.0 + IL_000e: pop + IL_000f: ldarg.0 + IL_0010: stloc.1 + IL_0011: ldc.i4.0 + IL_0012: stloc.0 + IL_0013: ldc.i4 0x9e3779b9 + IL_0018: ldarg.1 + IL_0019: stloc.2 + IL_001a: ldloc.1 + IL_001b: ldfld int32 XYZ.Expr::item + IL_0020: ldloc.0 + IL_0021: ldc.i4.6 + IL_0022: shl + IL_0023: ldloc.0 + IL_0024: ldc.i4.2 + IL_0025: shr + IL_0026: add + IL_0027: add + IL_0028: add + IL_0029: stloc.0 + IL_002a: ldloc.0 + IL_002b: ret + + IL_002c: ldc.i4.0 + IL_002d: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance int32 GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 7,7 : 10,14 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 XYZ.Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance bool Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 61 (0x3d) + .maxstack 4 + .locals init (class XYZ.Expr V_0, + class XYZ.Expr V_1, + class XYZ.Expr V_2, + class XYZ.Expr V_3, + class [mscorlib]System.Collections.IEqualityComparer V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0035 + + IL_000b: ldarg.1 + IL_000c: isinst XYZ.Expr + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0033 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldarg.0 + IL_001c: pop + IL_001d: ldarg.0 + IL_001e: stloc.2 + IL_001f: ldloc.1 + IL_0020: stloc.3 + IL_0021: ldarg.2 + IL_0022: stloc.s V_4 + IL_0024: ldloc.2 + IL_0025: ldfld int32 XYZ.Expr::item + IL_002a: ldloc.3 + IL_002b: ldfld int32 XYZ.Expr::item + IL_0030: ceq + IL_0032: ret + + IL_0033: ldc.i4.0 + IL_0034: ret + + IL_0035: ldarg.1 + IL_0036: ldnull + IL_0037: cgt.un + IL_0039: ldc.i4.0 + IL_003a: ceq + IL_003c: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(class XYZ.Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 52 (0x34) + .maxstack 4 + .locals init (class XYZ.Expr V_0, + class XYZ.Expr V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_002a + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: ldfld int32 XYZ.Expr::item + IL_0021: ldloc.1 + IL_0022: ldfld int32 XYZ.Expr::item + IL_0027: ceq + IL_0029: ret + + IL_002a: ldc.i4.0 + IL_002b: ret + + IL_002c: ldarg.1 + IL_002d: ldnull + IL_002e: cgt.un + IL_0030: ldc.i4.0 + IL_0031: ceq + IL_0033: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class XYZ.Expr V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst XYZ.Expr + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool XYZ.Expr::Equals(class XYZ.Expr) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method Expr::Equals + + .property instance int32 Tag() + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .get instance int32 XYZ.Expr::get_Tag() + } // end of property Expr::Tag + .property instance int32 Item() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .get instance int32 XYZ.Expr::get_Item() + } // end of property Expr::Item +} // end of class XYZ.Expr + +.class public auto ansi beforefieldinit XYZ.MyExn + extends [mscorlib]System.Exception + implements [mscorlib]System.Collections.IStructuralEquatable +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) + .field assembly int32 Data0@ + .method public specialname rtspecialname + instance void .ctor(int32 data0) cil managed + { + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 XYZ.MyExn::Data0@ + IL_000d: ret + } // end of method MyExn::.ctor + + .method public specialname rtspecialname + instance void .ctor() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ret + } // end of method MyExn::.ctor + + .method public hidebysig specialname instance int32 + get_Data0() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 XYZ.MyExn::Data0@ + IL_0006: ret + } // end of method MyExn::get_Data0 + + .method public hidebysig virtual instance int32 + GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 45 (0x2d) + .maxstack 7 + .locals init (int32 V_0, + class [mscorlib]System.Collections.IEqualityComparer V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002b + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldc.i4 0x9e3779b9 + IL_0012: ldarg.1 + IL_0013: stloc.1 + IL_0014: ldarg.0 + IL_0015: castclass XYZ.MyExn + IL_001a: call instance int32 XYZ.MyExn::get_Data0() + IL_001f: ldloc.0 + IL_0020: ldc.i4.6 + IL_0021: shl + IL_0022: ldloc.0 + IL_0023: ldc.i4.2 + IL_0024: shr + IL_0025: add + IL_0026: add + IL_0027: add + IL_0028: stloc.0 + IL_0029: ldloc.0 + IL_002a: ret + + IL_002b: ldc.i4.0 + IL_002c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance int32 + GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 8,8 : 15,20 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 XYZ.MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance bool + Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 76 (0x4c) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0, + class [mscorlib]System.Exception V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0044 + + IL_000b: ldarg.1 + IL_000c: isinst [mscorlib]System.Exception + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0042 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_0021: brtrue.s IL_0025 + + IL_0023: br.s IL_0040 + + IL_0025: ldarg.2 + IL_0026: stloc.2 + IL_0027: ldarg.0 + IL_0028: castclass XYZ.MyExn + IL_002d: call instance int32 XYZ.MyExn::get_Data0() + IL_0032: ldloc.1 + IL_0033: castclass XYZ.MyExn + IL_0038: call instance int32 XYZ.MyExn::get_Data0() + IL_003d: ceq + IL_003f: ret + + IL_0040: ldc.i4.0 + IL_0041: ret + + IL_0042: ldc.i4.0 + IL_0043: ret + + IL_0044: ldarg.1 + IL_0045: ldnull + IL_0046: cgt.un + IL_0048: ldc.i4.0 + IL_0049: ceq + IL_004b: ret + } // end of method MyExn::Equals + + .method public hidebysig instance bool + Equals(class [mscorlib]System.Exception obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 68 (0x44) + .maxstack 4 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_003c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_003a + + IL_0015: ldarg.1 + IL_0016: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_001b: brtrue.s IL_001f + + IL_001d: br.s IL_0038 + + IL_001f: ldarg.0 + IL_0020: castclass XYZ.MyExn + IL_0025: call instance int32 XYZ.MyExn::get_Data0() + IL_002a: ldarg.1 + IL_002b: castclass XYZ.MyExn + IL_0030: call instance int32 XYZ.MyExn::get_Data0() + IL_0035: ceq + IL_0037: ret + + IL_0038: ldc.i4.0 + IL_0039: ret + + IL_003a: ldc.i4.0 + IL_003b: ret + + IL_003c: ldarg.1 + IL_003d: ldnull + IL_003e: cgt.un + IL_0040: ldc.i4.0 + IL_0041: ceq + IL_0043: ret + } // end of method MyExn::Equals + + .method public hidebysig virtual instance bool + Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst [mscorlib]System.Exception + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool XYZ.MyExn::Equals(class [mscorlib]System.Exception) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method MyExn::Equals + + .property instance int32 Data0() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) + .get instance int32 XYZ.MyExn::get_Data0() + } // end of property MyExn::Data0 +} // end of class XYZ.MyExn + +.class public auto ansi XYZ.A + extends [mscorlib]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .field assembly string x + .method public specialname rtspecialname + instance void .ctor(string x) cil managed + { + // Code size 17 (0x11) + .maxstack 8 + .line 9,9 : 12,13 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: nop + IL_0009: ldarg.0 + IL_000a: ldarg.1 + IL_000b: stfld string XYZ.A::x + .line 9,9 : 10,11 + IL_0010: ret + } // end of method A::.ctor + + .method public hidebysig specialname instance string + get_X() cil managed + { + // Code size 8 (0x8) + .maxstack 8 + .line 9,9 : 38,39 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldfld string XYZ.A::x + IL_0007: ret + } // end of method A::get_X + + .property instance string X() + { + .get instance string XYZ.A::get_X() + } // end of property A::X +} // end of class XYZ.A + +.class public abstract auto ansi sealed XYZ.ABC + extends [mscorlib]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto autochar sealed nested public beforefieldinit Expr + extends [mscorlib]System.Object + implements class [mscorlib]System.IEquatable`1, + [mscorlib]System.Collections.IStructuralEquatable, + class [mscorlib]System.IComparable`1, + [mscorlib]System.IComparable, + [mscorlib]System.Collections.IStructuralComparable + { + .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl + 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) + .field assembly initonly int32 item + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method public static class XYZ.ABC/Expr + NewNum(int32 item) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: newobj instance void XYZ.ABC/Expr::.ctor(int32) + IL_0006: ret + } // end of method Expr::NewNum + + .method assembly specialname rtspecialname + instance void .ctor(int32 item) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 XYZ.ABC/Expr::item + IL_000d: ret + } // end of method Expr::.ctor + + .method public hidebysig instance int32 + get_Item() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 XYZ.ABC/Expr::item + IL_0006: ret + } // end of method Expr::get_Item + + .method public hidebysig instance int32 + get_Tag() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 4 (0x4) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: pop + IL_0002: ldc.i4.0 + IL_0003: ret + } // end of method Expr::get_Tag + + .method assembly hidebysig specialname + instance object __DebugDisplay() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%+0.8A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::__DebugDisplay + + .method public strict virtual instance string + ToString() cil managed + { + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::ToString + + .method public hidebysig virtual final + instance int32 CompareTo(class XYZ.ABC/Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 81 (0x51) + .maxstack 4 + .locals init (class XYZ.ABC/Expr V_0, + class XYZ.ABC/Expr V_1, + class [mscorlib]System.Collections.IComparer V_2, + int32 V_3, + int32 V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0043 + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_0041 + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_0020: stloc.2 + IL_0021: ldloc.0 + IL_0022: ldfld int32 XYZ.ABC/Expr::item + IL_0027: stloc.3 + IL_0028: ldloc.1 + IL_0029: ldfld int32 XYZ.ABC/Expr::item + IL_002e: stloc.s V_4 + IL_0030: ldloc.3 + IL_0031: ldloc.s V_4 + IL_0033: bge.s IL_0037 + + IL_0035: br.s IL_0039 + + IL_0037: br.s IL_003b + + IL_0039: ldc.i4.m1 + IL_003a: ret + + IL_003b: ldloc.3 + IL_003c: ldloc.s V_4 + IL_003e: cgt + IL_0040: ret + + IL_0041: ldc.i4.1 + IL_0042: ret + + IL_0043: ldarg.1 + IL_0044: ldnull + IL_0045: cgt.un + IL_0047: brfalse.s IL_004b + + IL_0049: br.s IL_004d + + IL_004b: br.s IL_004f + + IL_004d: ldc.i4.m1 + IL_004e: ret + + IL_004f: ldc.i4.0 + IL_0050: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + .line 13,13 : 14,18 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: unbox.any XYZ.ABC/Expr + IL_0008: callvirt instance int32 XYZ.ABC/Expr::CompareTo(class XYZ.ABC/Expr) + IL_000d: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj, + class [mscorlib]System.Collections.IComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 97 (0x61) + .maxstack 4 + .locals init ([0] class XYZ.ABC/Expr V_0, + [1] class XYZ.ABC/Expr V_1, + [2] class XYZ.ABC/Expr V_2, + [3] class [mscorlib]System.Collections.IComparer V_3, + [4] int32 V_4, + [5] int32 V_5) + .line 13,13 : 14,18 + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: unbox.any XYZ.ABC/Expr + IL_0007: stloc.0 + IL_0008: ldarg.0 + IL_0009: ldnull + IL_000a: cgt.un + IL_000c: brfalse.s IL_0010 + + IL_000e: br.s IL_0012 + + IL_0010: br.s IL_004e + + .line 100001,100001 : 0,0 + IL_0012: ldarg.1 + IL_0013: unbox.any XYZ.ABC/Expr + IL_0018: ldnull + IL_0019: cgt.un + IL_001b: brfalse.s IL_001f + + IL_001d: br.s IL_0021 + + IL_001f: br.s IL_004c + + .line 100001,100001 : 0,0 + IL_0021: ldarg.0 + IL_0022: pop + .line 100001,100001 : 0,0 + IL_0023: ldarg.0 + IL_0024: stloc.1 + IL_0025: ldloc.0 + IL_0026: stloc.2 + IL_0027: ldarg.2 + IL_0028: stloc.3 + IL_0029: ldloc.1 + IL_002a: ldfld int32 XYZ.ABC/Expr::item + IL_002f: stloc.s V_4 + IL_0031: ldloc.2 + IL_0032: ldfld int32 XYZ.ABC/Expr::item + IL_0037: stloc.s V_5 + IL_0039: ldloc.s V_4 + IL_003b: ldloc.s V_5 + IL_003d: bge.s IL_0041 + + IL_003f: br.s IL_0043 + + IL_0041: br.s IL_0045 + + .line 100001,100001 : 0,0 + IL_0043: ldc.i4.m1 + IL_0044: ret + + .line 100001,100001 : 0,0 + IL_0045: ldloc.s V_4 + IL_0047: ldloc.s V_5 + IL_0049: cgt + IL_004b: ret + + .line 100001,100001 : 0,0 + IL_004c: ldc.i4.1 + IL_004d: ret + + .line 100001,100001 : 0,0 + IL_004e: ldarg.1 + IL_004f: unbox.any XYZ.ABC/Expr + IL_0054: ldnull + IL_0055: cgt.un + IL_0057: brfalse.s IL_005b + + IL_0059: br.s IL_005d + + IL_005b: br.s IL_005f + + .line 100001,100001 : 0,0 + IL_005d: ldc.i4.m1 + IL_005e: ret + + .line 100001,100001 : 0,0 + IL_005f: ldc.i4.0 + IL_0060: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 46 (0x2e) + .maxstack 7 + .locals init (int32 V_0, + class XYZ.ABC/Expr V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldarg.0 + IL_000e: pop + IL_000f: ldarg.0 + IL_0010: stloc.1 + IL_0011: ldc.i4.0 + IL_0012: stloc.0 + IL_0013: ldc.i4 0x9e3779b9 + IL_0018: ldarg.1 + IL_0019: stloc.2 + IL_001a: ldloc.1 + IL_001b: ldfld int32 XYZ.ABC/Expr::item + IL_0020: ldloc.0 + IL_0021: ldc.i4.6 + IL_0022: shl + IL_0023: ldloc.0 + IL_0024: ldc.i4.2 + IL_0025: shr + IL_0026: add + IL_0027: add + IL_0028: add + IL_0029: stloc.0 + IL_002a: ldloc.0 + IL_002b: ret + + IL_002c: ldc.i4.0 + IL_002d: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance int32 GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 13,13 : 14,18 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 XYZ.ABC/Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance bool Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 61 (0x3d) + .maxstack 4 + .locals init (class XYZ.ABC/Expr V_0, + class XYZ.ABC/Expr V_1, + class XYZ.ABC/Expr V_2, + class XYZ.ABC/Expr V_3, + class [mscorlib]System.Collections.IEqualityComparer V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0035 + + IL_000b: ldarg.1 + IL_000c: isinst XYZ.ABC/Expr + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0033 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldarg.0 + IL_001c: pop + IL_001d: ldarg.0 + IL_001e: stloc.2 + IL_001f: ldloc.1 + IL_0020: stloc.3 + IL_0021: ldarg.2 + IL_0022: stloc.s V_4 + IL_0024: ldloc.2 + IL_0025: ldfld int32 XYZ.ABC/Expr::item + IL_002a: ldloc.3 + IL_002b: ldfld int32 XYZ.ABC/Expr::item + IL_0030: ceq + IL_0032: ret + + IL_0033: ldc.i4.0 + IL_0034: ret + + IL_0035: ldarg.1 + IL_0036: ldnull + IL_0037: cgt.un + IL_0039: ldc.i4.0 + IL_003a: ceq + IL_003c: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(class XYZ.ABC/Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 52 (0x34) + .maxstack 4 + .locals init (class XYZ.ABC/Expr V_0, + class XYZ.ABC/Expr V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_002a + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: ldfld int32 XYZ.ABC/Expr::item + IL_0021: ldloc.1 + IL_0022: ldfld int32 XYZ.ABC/Expr::item + IL_0027: ceq + IL_0029: ret + + IL_002a: ldc.i4.0 + IL_002b: ret + + IL_002c: ldarg.1 + IL_002d: ldnull + IL_002e: cgt.un + IL_0030: ldc.i4.0 + IL_0031: ceq + IL_0033: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class XYZ.ABC/Expr V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst XYZ.ABC/Expr + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool XYZ.ABC/Expr::Equals(class XYZ.ABC/Expr) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method Expr::Equals + + .property instance int32 Tag() + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .get instance int32 XYZ.ABC/Expr::get_Tag() + } // end of property Expr::Tag + .property instance int32 Item() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .get instance int32 XYZ.ABC/Expr::get_Item() + } // end of property Expr::Item + } // end of class Expr + + .class auto ansi nested public beforefieldinit MyExn + extends [mscorlib]System.Exception + implements [mscorlib]System.Collections.IStructuralEquatable + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) + .field assembly int32 Data0@ + .method public specialname rtspecialname + instance void .ctor(int32 data0) cil managed + { + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 XYZ.ABC/MyExn::Data0@ + IL_000d: ret + } // end of method MyExn::.ctor + + .method public specialname rtspecialname + instance void .ctor() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ret + } // end of method MyExn::.ctor + + .method public hidebysig specialname + instance int32 get_Data0() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 XYZ.ABC/MyExn::Data0@ + IL_0006: ret + } // end of method MyExn::get_Data0 + + .method public hidebysig virtual instance int32 + GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 45 (0x2d) + .maxstack 7 + .locals init (int32 V_0, + class [mscorlib]System.Collections.IEqualityComparer V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002b + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldc.i4 0x9e3779b9 + IL_0012: ldarg.1 + IL_0013: stloc.1 + IL_0014: ldarg.0 + IL_0015: castclass XYZ.ABC/MyExn + IL_001a: call instance int32 XYZ.ABC/MyExn::get_Data0() + IL_001f: ldloc.0 + IL_0020: ldc.i4.6 + IL_0021: shl + IL_0022: ldloc.0 + IL_0023: ldc.i4.2 + IL_0024: shr + IL_0025: add + IL_0026: add + IL_0027: add + IL_0028: stloc.0 + IL_0029: ldloc.0 + IL_002a: ret + + IL_002b: ldc.i4.0 + IL_002c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance int32 + GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 14,14 : 19,24 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 XYZ.ABC/MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance bool + Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 76 (0x4c) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0, + class [mscorlib]System.Exception V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0044 + + IL_000b: ldarg.1 + IL_000c: isinst [mscorlib]System.Exception + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0042 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_0021: brtrue.s IL_0025 + + IL_0023: br.s IL_0040 + + IL_0025: ldarg.2 + IL_0026: stloc.2 + IL_0027: ldarg.0 + IL_0028: castclass XYZ.ABC/MyExn + IL_002d: call instance int32 XYZ.ABC/MyExn::get_Data0() + IL_0032: ldloc.1 + IL_0033: castclass XYZ.ABC/MyExn + IL_0038: call instance int32 XYZ.ABC/MyExn::get_Data0() + IL_003d: ceq + IL_003f: ret + + IL_0040: ldc.i4.0 + IL_0041: ret + + IL_0042: ldc.i4.0 + IL_0043: ret + + IL_0044: ldarg.1 + IL_0045: ldnull + IL_0046: cgt.un + IL_0048: ldc.i4.0 + IL_0049: ceq + IL_004b: ret + } // end of method MyExn::Equals + + .method public hidebysig instance bool + Equals(class [mscorlib]System.Exception obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 68 (0x44) + .maxstack 4 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_003c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_003a + + IL_0015: ldarg.1 + IL_0016: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_001b: brtrue.s IL_001f + + IL_001d: br.s IL_0038 + + IL_001f: ldarg.0 + IL_0020: castclass XYZ.ABC/MyExn + IL_0025: call instance int32 XYZ.ABC/MyExn::get_Data0() + IL_002a: ldarg.1 + IL_002b: castclass XYZ.ABC/MyExn + IL_0030: call instance int32 XYZ.ABC/MyExn::get_Data0() + IL_0035: ceq + IL_0037: ret + + IL_0038: ldc.i4.0 + IL_0039: ret + + IL_003a: ldc.i4.0 + IL_003b: ret + + IL_003c: ldarg.1 + IL_003d: ldnull + IL_003e: cgt.un + IL_0040: ldc.i4.0 + IL_0041: ceq + IL_0043: ret + } // end of method MyExn::Equals + + .method public hidebysig virtual instance bool + Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst [mscorlib]System.Exception + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool XYZ.ABC/MyExn::Equals(class [mscorlib]System.Exception) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method MyExn::Equals + + .property instance int32 Data0() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) + .get instance int32 XYZ.ABC/MyExn::get_Data0() + } // end of property MyExn::Data0 + } // end of class MyExn + + .class auto ansi nested public A + extends [mscorlib]System.Object + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .field assembly string x + .method public specialname rtspecialname + instance void .ctor(string x) cil managed + { + // Code size 17 (0x11) + .maxstack 8 + .line 15,15 : 16,17 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: nop + IL_0009: ldarg.0 + IL_000a: ldarg.1 + IL_000b: stfld string XYZ.ABC/A::x + .line 15,15 : 14,15 + IL_0010: ret + } // end of method A::.ctor + + .method public hidebysig specialname + instance string get_X() cil managed + { + // Code size 8 (0x8) + .maxstack 8 + .line 15,15 : 42,43 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldfld string XYZ.ABC/A::x + IL_0007: ret + } // end of method A::get_X + + .property instance string X() + { + .get instance string XYZ.ABC/A::get_X() + } // end of property A::X + } // end of class A + + .class abstract auto ansi sealed nested public ABC + extends [mscorlib]System.Object + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto autochar sealed nested public beforefieldinit Expr + extends [mscorlib]System.Object + implements class [mscorlib]System.IEquatable`1, + [mscorlib]System.Collections.IStructuralEquatable, + class [mscorlib]System.IComparable`1, + [mscorlib]System.IComparable, + [mscorlib]System.Collections.IStructuralComparable + { + .custom instance void [mscorlib]System.Diagnostics.DebuggerDisplayAttribute::.ctor(string) = ( 01 00 15 7B 5F 5F 44 65 62 75 67 44 69 73 70 6C // ...{__DebugDispl + 61 79 28 29 2C 6E 71 7D 00 00 ) // ay(),nq}.. + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 01 00 00 00 00 00 ) + .field assembly initonly int32 item + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method public static class XYZ.ABC/ABC/Expr + NewNum(int32 item) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 08 00 00 00 00 00 00 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: newobj instance void XYZ.ABC/ABC/Expr::.ctor(int32) + IL_0006: ret + } // end of method Expr::NewNum + + .method assembly specialname rtspecialname + instance void .ctor(int32 item) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 XYZ.ABC/ABC/Expr::item + IL_000d: ret + } // end of method Expr::.ctor + + .method public hidebysig instance int32 + get_Item() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_0006: ret + } // end of method Expr::get_Item + + .method public hidebysig instance int32 + get_Tag() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 4 (0x4) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: pop + IL_0002: ldc.i4.0 + IL_0003: ret + } // end of method Expr::get_Tag + + .method assembly hidebysig specialname + instance object __DebugDisplay() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%+0.8A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::__DebugDisplay + + .method public strict virtual instance string + ToString() cil managed + { + // Code size 22 (0x16) + .maxstack 8 + IL_0000: ldstr "%A" + IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string) + IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) + IL_000f: ldarg.0 + IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0015: ret + } // end of method Expr::ToString + + .method public hidebysig virtual final + instance int32 CompareTo(class XYZ.ABC/ABC/Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 81 (0x51) + .maxstack 4 + .locals init (class XYZ.ABC/ABC/Expr V_0, + class XYZ.ABC/ABC/Expr V_1, + class [mscorlib]System.Collections.IComparer V_2, + int32 V_3, + int32 V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0043 + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_0041 + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() + IL_0020: stloc.2 + IL_0021: ldloc.0 + IL_0022: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_0027: stloc.3 + IL_0028: ldloc.1 + IL_0029: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_002e: stloc.s V_4 + IL_0030: ldloc.3 + IL_0031: ldloc.s V_4 + IL_0033: bge.s IL_0037 + + IL_0035: br.s IL_0039 + + IL_0037: br.s IL_003b + + IL_0039: ldc.i4.m1 + IL_003a: ret + + IL_003b: ldloc.3 + IL_003c: ldloc.s V_4 + IL_003e: cgt + IL_0040: ret + + IL_0041: ldc.i4.1 + IL_0042: ret + + IL_0043: ldarg.1 + IL_0044: ldnull + IL_0045: cgt.un + IL_0047: brfalse.s IL_004b + + IL_0049: br.s IL_004d + + IL_004b: br.s IL_004f + + IL_004d: ldc.i4.m1 + IL_004e: ret + + IL_004f: ldc.i4.0 + IL_0050: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 14 (0xe) + .maxstack 8 + .line 23,23 : 18,22 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: unbox.any XYZ.ABC/ABC/Expr + IL_0008: callvirt instance int32 XYZ.ABC/ABC/Expr::CompareTo(class XYZ.ABC/ABC/Expr) + IL_000d: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 CompareTo(object obj, + class [mscorlib]System.Collections.IComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 97 (0x61) + .maxstack 4 + .locals init ([0] class XYZ.ABC/ABC/Expr V_0, + [1] class XYZ.ABC/ABC/Expr V_1, + [2] class XYZ.ABC/ABC/Expr V_2, + [3] class [mscorlib]System.Collections.IComparer V_3, + [4] int32 V_4, + [5] int32 V_5) + .line 23,23 : 18,22 + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: unbox.any XYZ.ABC/ABC/Expr + IL_0007: stloc.0 + IL_0008: ldarg.0 + IL_0009: ldnull + IL_000a: cgt.un + IL_000c: brfalse.s IL_0010 + + IL_000e: br.s IL_0012 + + IL_0010: br.s IL_004e + + .line 100001,100001 : 0,0 + IL_0012: ldarg.1 + IL_0013: unbox.any XYZ.ABC/ABC/Expr + IL_0018: ldnull + IL_0019: cgt.un + IL_001b: brfalse.s IL_001f + + IL_001d: br.s IL_0021 + + IL_001f: br.s IL_004c + + .line 100001,100001 : 0,0 + IL_0021: ldarg.0 + IL_0022: pop + .line 100001,100001 : 0,0 + IL_0023: ldarg.0 + IL_0024: stloc.1 + IL_0025: ldloc.0 + IL_0026: stloc.2 + IL_0027: ldarg.2 + IL_0028: stloc.3 + IL_0029: ldloc.1 + IL_002a: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_002f: stloc.s V_4 + IL_0031: ldloc.2 + IL_0032: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_0037: stloc.s V_5 + IL_0039: ldloc.s V_4 + IL_003b: ldloc.s V_5 + IL_003d: bge.s IL_0041 + + IL_003f: br.s IL_0043 + + IL_0041: br.s IL_0045 + + .line 100001,100001 : 0,0 + IL_0043: ldc.i4.m1 + IL_0044: ret + + .line 100001,100001 : 0,0 + IL_0045: ldloc.s V_4 + IL_0047: ldloc.s V_5 + IL_0049: cgt + IL_004b: ret + + .line 100001,100001 : 0,0 + IL_004c: ldc.i4.1 + IL_004d: ret + + .line 100001,100001 : 0,0 + IL_004e: ldarg.1 + IL_004f: unbox.any XYZ.ABC/ABC/Expr + IL_0054: ldnull + IL_0055: cgt.un + IL_0057: brfalse.s IL_005b + + IL_0059: br.s IL_005d + + IL_005b: br.s IL_005f + + .line 100001,100001 : 0,0 + IL_005d: ldc.i4.m1 + IL_005e: ret + + .line 100001,100001 : 0,0 + IL_005f: ldc.i4.0 + IL_0060: ret + } // end of method Expr::CompareTo + + .method public hidebysig virtual final + instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 46 (0x2e) + .maxstack 7 + .locals init (int32 V_0, + class XYZ.ABC/ABC/Expr V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldarg.0 + IL_000e: pop + IL_000f: ldarg.0 + IL_0010: stloc.1 + IL_0011: ldc.i4.0 + IL_0012: stloc.0 + IL_0013: ldc.i4 0x9e3779b9 + IL_0018: ldarg.1 + IL_0019: stloc.2 + IL_001a: ldloc.1 + IL_001b: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_0020: ldloc.0 + IL_0021: ldc.i4.6 + IL_0022: shl + IL_0023: ldloc.0 + IL_0024: ldc.i4.2 + IL_0025: shr + IL_0026: add + IL_0027: add + IL_0028: add + IL_0029: stloc.0 + IL_002a: ldloc.0 + IL_002b: ret + + IL_002c: ldc.i4.0 + IL_002d: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance int32 GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 23,23 : 18,22 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 XYZ.ABC/ABC/Expr::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method Expr::GetHashCode + + .method public hidebysig virtual final + instance bool Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 61 (0x3d) + .maxstack 4 + .locals init (class XYZ.ABC/ABC/Expr V_0, + class XYZ.ABC/ABC/Expr V_1, + class XYZ.ABC/ABC/Expr V_2, + class XYZ.ABC/ABC/Expr V_3, + class [mscorlib]System.Collections.IEqualityComparer V_4) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0035 + + IL_000b: ldarg.1 + IL_000c: isinst XYZ.ABC/ABC/Expr + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0033 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldarg.0 + IL_001c: pop + IL_001d: ldarg.0 + IL_001e: stloc.2 + IL_001f: ldloc.1 + IL_0020: stloc.3 + IL_0021: ldarg.2 + IL_0022: stloc.s V_4 + IL_0024: ldloc.2 + IL_0025: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_002a: ldloc.3 + IL_002b: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_0030: ceq + IL_0032: ret + + IL_0033: ldc.i4.0 + IL_0034: ret + + IL_0035: ldarg.1 + IL_0036: ldnull + IL_0037: cgt.un + IL_0039: ldc.i4.0 + IL_003a: ceq + IL_003c: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(class XYZ.ABC/ABC/Expr obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 52 (0x34) + .maxstack 4 + .locals init (class XYZ.ABC/ABC/Expr V_0, + class XYZ.ABC/ABC/Expr V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_002a + + IL_0015: ldarg.0 + IL_0016: pop + IL_0017: ldarg.0 + IL_0018: stloc.0 + IL_0019: ldarg.1 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_0021: ldloc.1 + IL_0022: ldfld int32 XYZ.ABC/ABC/Expr::item + IL_0027: ceq + IL_0029: ret + + IL_002a: ldc.i4.0 + IL_002b: ret + + IL_002c: ldarg.1 + IL_002d: ldnull + IL_002e: cgt.un + IL_0030: ldc.i4.0 + IL_0031: ceq + IL_0033: ret + } // end of method Expr::Equals + + .method public hidebysig virtual final + instance bool Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class XYZ.ABC/ABC/Expr V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst XYZ.ABC/ABC/Expr + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool XYZ.ABC/ABC/Expr::Equals(class XYZ.ABC/ABC/Expr) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method Expr::Equals + + .property instance int32 Tag() + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .get instance int32 XYZ.ABC/ABC/Expr::get_Tag() + } // end of property Expr::Tag + .property instance int32 Item() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .get instance int32 XYZ.ABC/ABC/Expr::get_Item() + } // end of property Expr::Item + } // end of class Expr + + .class auto ansi nested public beforefieldinit MyExn + extends [mscorlib]System.Exception + implements [mscorlib]System.Collections.IStructuralEquatable + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 05 00 00 00 00 00 ) + .field assembly int32 Data0@ + .method public specialname rtspecialname + instance void .ctor(int32 data0) cil managed + { + // Code size 14 (0xe) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld int32 XYZ.ABC/ABC/MyExn::Data0@ + IL_000d: ret + } // end of method MyExn::.ctor + + .method public specialname rtspecialname + instance void .ctor() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [mscorlib]System.Exception::.ctor() + IL_0006: ret + } // end of method MyExn::.ctor + + .method public hidebysig specialname + instance int32 get_Data0() cil managed + { + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 XYZ.ABC/ABC/MyExn::Data0@ + IL_0006: ret + } // end of method MyExn::get_Data0 + + .method public hidebysig virtual instance int32 + GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 45 (0x2d) + .maxstack 7 + .locals init (int32 V_0, + class [mscorlib]System.Collections.IEqualityComparer V_1) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_002b + + IL_000b: ldc.i4.0 + IL_000c: stloc.0 + IL_000d: ldc.i4 0x9e3779b9 + IL_0012: ldarg.1 + IL_0013: stloc.1 + IL_0014: ldarg.0 + IL_0015: castclass XYZ.ABC/ABC/MyExn + IL_001a: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() + IL_001f: ldloc.0 + IL_0020: ldc.i4.6 + IL_0021: shl + IL_0022: ldloc.0 + IL_0023: ldc.i4.2 + IL_0024: shr + IL_0025: add + IL_0026: add + IL_0027: add + IL_0028: stloc.0 + IL_0029: ldloc.0 + IL_002a: ret + + IL_002b: ldc.i4.0 + IL_002c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance int32 + GetHashCode() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 13 (0xd) + .maxstack 8 + .line 24,24 : 23,28 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() + IL_0007: callvirt instance int32 XYZ.ABC/ABC/MyExn::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) + IL_000c: ret + } // end of method MyExn::GetHashCode + + .method public hidebysig virtual instance bool + Equals(object obj, + class [mscorlib]System.Collections.IEqualityComparer comp) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 76 (0x4c) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0, + class [mscorlib]System.Exception V_1, + class [mscorlib]System.Collections.IEqualityComparer V_2) + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_0044 + + IL_000b: ldarg.1 + IL_000c: isinst [mscorlib]System.Exception + IL_0011: stloc.0 + IL_0012: ldloc.0 + IL_0013: brfalse.s IL_0017 + + IL_0015: br.s IL_0019 + + IL_0017: br.s IL_0042 + + IL_0019: ldloc.0 + IL_001a: stloc.1 + IL_001b: ldloc.0 + IL_001c: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_0021: brtrue.s IL_0025 + + IL_0023: br.s IL_0040 + + IL_0025: ldarg.2 + IL_0026: stloc.2 + IL_0027: ldarg.0 + IL_0028: castclass XYZ.ABC/ABC/MyExn + IL_002d: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() + IL_0032: ldloc.1 + IL_0033: castclass XYZ.ABC/ABC/MyExn + IL_0038: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() + IL_003d: ceq + IL_003f: ret + + IL_0040: ldc.i4.0 + IL_0041: ret + + IL_0042: ldc.i4.0 + IL_0043: ret + + IL_0044: ldarg.1 + IL_0045: ldnull + IL_0046: cgt.un + IL_0048: ldc.i4.0 + IL_0049: ceq + IL_004b: ret + } // end of method MyExn::Equals + + .method public hidebysig instance bool + Equals(class [mscorlib]System.Exception obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 68 (0x44) + .maxstack 4 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldnull + IL_0003: cgt.un + IL_0005: brfalse.s IL_0009 + + IL_0007: br.s IL_000b + + IL_0009: br.s IL_003c + + IL_000b: ldarg.1 + IL_000c: ldnull + IL_000d: cgt.un + IL_000f: brfalse.s IL_0013 + + IL_0011: br.s IL_0015 + + IL_0013: br.s IL_003a + + IL_0015: ldarg.1 + IL_0016: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::TypeTestGeneric(object) + IL_001b: brtrue.s IL_001f + + IL_001d: br.s IL_0038 + + IL_001f: ldarg.0 + IL_0020: castclass XYZ.ABC/ABC/MyExn + IL_0025: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() + IL_002a: ldarg.1 + IL_002b: castclass XYZ.ABC/ABC/MyExn + IL_0030: call instance int32 XYZ.ABC/ABC/MyExn::get_Data0() + IL_0035: ceq + IL_0037: ret + + IL_0038: ldc.i4.0 + IL_0039: ret + + IL_003a: ldc.i4.0 + IL_003b: ret + + IL_003c: ldarg.1 + IL_003d: ldnull + IL_003e: cgt.un + IL_0040: ldc.i4.0 + IL_0041: ceq + IL_0043: ret + } // end of method MyExn::Equals + + .method public hidebysig virtual instance bool + Equals(object obj) cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 25 (0x19) + .maxstack 4 + .locals init (class [mscorlib]System.Exception V_0) + IL_0000: nop + IL_0001: ldarg.1 + IL_0002: isinst [mscorlib]System.Exception + IL_0007: stloc.0 + IL_0008: ldloc.0 + IL_0009: brfalse.s IL_000d + + IL_000b: br.s IL_000f + + IL_000d: br.s IL_0017 + + IL_000f: ldarg.0 + IL_0010: ldloc.0 + IL_0011: callvirt instance bool XYZ.ABC/ABC/MyExn::Equals(class [mscorlib]System.Exception) + IL_0016: ret + + IL_0017: ldc.i4.0 + IL_0018: ret + } // end of method MyExn::Equals + + .property instance int32 Data0() + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, + int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) + .get instance int32 XYZ.ABC/ABC/MyExn::get_Data0() + } // end of property MyExn::Data0 + } // end of class MyExn + + .class auto ansi nested public A + extends [mscorlib]System.Object + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .field assembly string x + .method public specialname rtspecialname + instance void .ctor(string x) cil managed + { + // Code size 17 (0x11) + .maxstack 8 + .line 25,25 : 20,21 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [mscorlib]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: nop + IL_0009: ldarg.0 + IL_000a: ldarg.1 + IL_000b: stfld string XYZ.ABC/ABC/A::x + .line 25,25 : 18,19 + IL_0010: ret + } // end of method A::.ctor + + .method public hidebysig specialname + instance string get_X() cil managed + { + // Code size 8 (0x8) + .maxstack 8 + .line 25,25 : 46,47 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldfld string XYZ.ABC/ABC/A::x + IL_0007: ret + } // end of method A::get_X + + .property instance string X() + { + .get instance string XYZ.ABC/ABC/A::get_X() + } // end of property A::X + } // end of class A + + .method public static int32 'add'(int32 x, + int32 y) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) + // Code size 5 (0x5) + .maxstack 8 + .line 28,28 : 27,32 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: add + IL_0004: ret + } // end of method ABC::'add' + + .method public specialname static string + get_greeting() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: nop + IL_0001: ldstr "hello" + IL_0006: ret + } // end of method ABC::get_greeting + + .property string greeting() + { + .get string XYZ.ABC/ABC::get_greeting() + } // end of property ABC::greeting + } // end of class ABC + + .method public static int32 'add'(int32 x, + int32 y) cil managed + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationArgumentCountsAttribute::.ctor(int32[]) = ( 01 00 02 00 00 00 01 00 00 00 01 00 00 00 00 00 ) + // Code size 5 (0x5) + .maxstack 8 + .line 18,18 : 23,28 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldarg.1 + IL_0003: add + IL_0004: ret + } // end of method ABC::'add' + + .method public specialname static string + get_greeting() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: nop + IL_0001: ldstr "hello" + IL_0006: ret + } // end of method ABC::get_greeting + + .property string greeting() + { + .get string XYZ.ABC::get_greeting() + } // end of property ABC::greeting +} // end of class XYZ.ABC + +.class private abstract auto ansi sealed ''.$ToplevelNamespace + extends [mscorlib]System.Object +{ + .field static assembly int32 init@ + .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method private specialname rtspecialname static + void .cctor() cil managed + { + // Code size 14 (0xe) + .maxstack 3 + .locals init ([0] string greeting, + [1] string V_1) + .line 19,19 : 9,31 '' + IL_0000: nop + IL_0001: call string XYZ.ABC::get_greeting() + IL_0006: stloc.0 + .line 29,29 : 13,35 '' + IL_0007: call string XYZ.ABC/ABC::get_greeting() + IL_000c: stloc.1 + IL_000d: ret + } // end of method $ToplevelNamespace::.cctor +} // end of class ''.$ToplevelNamespace + + +// ============================================================= + +// *********** DISASSEMBLY COMPLETE *********************** diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/env.lst b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/env.lst index 02b9c03bb30..3a3631b97e8 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/env.lst +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/env.lst @@ -1,5 +1,5 @@ - SOURCE=ToplevelModule.fs SCFLAGS="-a -g --out:TopLevelModule.dll --test:EmitFeeFeeAs100001 --optimize-" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd ToplevelModule.dll" # ToplevelModule.fs - Desktop - SOURCE=ToplevelNamespace.fs SCFLAGS="-a -g --out:ToplevelNamespace.dll --test:EmitFeeFeeAs100001 --optimize-" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd ToplevelNamespace.dll" # ToplevelNamespace.fs - Desktop + SOURCE=ToplevelModule.fs SCFLAGS="-a -g --out:desktop\\TopLevelModule.dll --test:EmitFeeFeeAs100001 --optimize-" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd ToplevelModule.dll NetFx20 desktop" # ToplevelModule.fs - Desktop + SOURCE=ToplevelNamespace.fs SCFLAGS="-a -g --out:desktop\\ToplevelNamespace.dll --test:EmitFeeFeeAs100001 --optimize-" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd ToplevelNamespace.dll NetFx20 desktop" # ToplevelNamespace.fs - Desktop diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction24.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction24.il.bsl index 88351c96ebf..1063152863a 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction24.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction24.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000748 Length: 0x00000228 } .module TestFunction24.exe -// MVID: {60D4E6CF-A643-4587-A745-0383CFE6D460} +// MVID: {60B68B97-A643-4587-A745-0383978BB660} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x056D0000 +// Image base: 0x06EA0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -865,7 +865,7 @@ .method public static class [mscorlib]System.Tuple`2 pinString() cil managed { - // Code size 93 (0x5d) + // Code size 77 (0x4d) .maxstack 6 .locals init ([0] string str, [1] native int pChar, @@ -873,11 +873,7 @@ [3] native int V_3, [4] int32 V_4, [5] native int V_5, - [6] native int V_6, - [7] native int V_7, - [8] int32 V_8, - [9] native int V_9, - [10] native int V_10) + [6] int32 V_6) .line 28,28 : 5,28 '' IL_0000: ldstr "Hello World" IL_0005: stloc.0 @@ -913,29 +909,21 @@ IL_0022: sizeof [mscorlib]System.Char IL_0028: mul IL_0029: add - IL_002a: stloc.s V_5 - IL_002c: ldloc.s V_5 - IL_002e: stloc.s V_6 - IL_0030: ldloc.s V_6 - IL_0032: ldobj [mscorlib]System.Char - IL_0037: ldloc.1 - IL_0038: stloc.s V_7 - IL_003a: ldc.i4.1 - IL_003b: stloc.s V_8 - IL_003d: ldloc.s V_7 - IL_003f: ldloc.s V_8 - IL_0041: conv.i - IL_0042: sizeof [mscorlib]System.Char - IL_0048: mul - IL_0049: add - IL_004a: stloc.s V_9 - IL_004c: ldloc.s V_9 - IL_004e: stloc.s V_10 - IL_0050: ldloc.s V_10 - IL_0052: ldobj [mscorlib]System.Char - IL_0057: newobj instance void class [mscorlib]System.Tuple`2::.ctor(!0, + IL_002a: ldobj [mscorlib]System.Char + IL_002f: ldloc.1 + IL_0030: stloc.s V_5 + IL_0032: ldc.i4.1 + IL_0033: stloc.s V_6 + IL_0035: ldloc.s V_5 + IL_0037: ldloc.s V_6 + IL_0039: conv.i + IL_003a: sizeof [mscorlib]System.Char + IL_0040: mul + IL_0041: add + IL_0042: ldobj [mscorlib]System.Char + IL_0047: newobj instance void class [mscorlib]System.Tuple`2::.ctor(!0, !1) - IL_005c: ret + IL_004c: ret } // end of method TestFunction24::pinString } // end of class TestFunction24 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction25.fs b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction25.fs deleted file mode 100644 index eb297d2f636..00000000000 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction25.fs +++ /dev/null @@ -1,32 +0,0 @@ -open FSharp.NativeInterop -// Assume that the following class exists. - -type Point = { mutable x : int; mutable y : int } - -let pinObject() = - let point = { x = 1; y = 2 } - use p1 = fixed &point.x // note, fixed is a keyword and would be highlighted - NativePtr.get p1 0 + NativePtr.get p1 1 - -let pinRef() = - let point = ref 17 - use p1 = fixed &point.contents // note, fixed is a keyword and would be highlighted - NativePtr.read p1 + NativePtr.read p1 - -let pinArray1() = - let arr = [| 0.0; 1.5; 2.3; 3.4; 4.0; 5.9 |] - use p1 = fixed arr - NativePtr.get p1 0 + NativePtr.get p1 1 - -let pinArray2() = - let arr = [| 0.0; 1.5; 2.3; 3.4; 4.0; 5.9 |] - // You can initialize a pointer by using the address of a variable. - use p = fixed &arr.[0] - NativePtr.get p 0 + NativePtr.get p 1 - -let pinString() = - let str = "Hello World" - // The following assignment initializes p by using a string. - use pChar = fixed str - NativePtr.get pChar 0, NativePtr.get pChar 1 - diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction25.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction25.il.bsl deleted file mode 100644 index 7463c4894bc..00000000000 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction25.il.bsl +++ /dev/null @@ -1,849 +0,0 @@ - -// Microsoft (R) .NET Framework IL Disassembler. Version 4.8.3928.0 -// Copyright (c) Microsoft Corporation. All rights reserved. - - - -// Metadata version: v4.0.30319 -.assembly extern mscorlib -{ - .publickeytoken = (B7 7A 5C 56 19 34 E0 89 ) // .z\V.4.. - .ver 4:0:0:0 -} -.assembly extern FSharp.Core -{ - .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 5:0:0:0 -} -.assembly TestFunction25 -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32, - int32, - int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) - - // --- The following custom attribute is added automatically, do not uncomment ------- - // .custom instance void [mscorlib]System.Diagnostics.DebuggableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggableAttribute/DebuggingModes) = ( 01 00 01 00 00 00 00 00 ) - - .hash algorithm 0x00008004 - .ver 0:0:0:0 -} -.mresource public FSharpSignatureData.TestFunction25 -{ - // Offset: 0x00000000 Length: 0x00000742 -} -.mresource public FSharpOptimizationData.TestFunction25 -{ - // Offset: 0x00000748 Length: 0x000003D2 -} -.module TestFunction25.exe -// MVID: {60D4E82F-A643-4662-A745-03832FE8D460} -.imagebase 0x00400000 -.file alignment 0x00000200 -.stackreserve 0x00100000 -.subsystem 0x0003 // WINDOWS_CUI -.corflags 0x00000001 // ILONLY -// Image base: 0x04E60000 - - -// =============== CLASS MEMBERS DECLARATION =================== - -.class public abstract auto ansi sealed TestFunction25 - extends [mscorlib]System.Object -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) - .class auto ansi serializable sealed nested public Point - extends [mscorlib]System.Object - implements class [mscorlib]System.IEquatable`1, - [mscorlib]System.Collections.IStructuralEquatable, - class [mscorlib]System.IComparable`1, - [mscorlib]System.IComparable, - [mscorlib]System.Collections.IStructuralComparable - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 02 00 00 00 00 00 ) - .field public int32 x@ - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .field public int32 y@ - .custom instance void [mscorlib]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [mscorlib]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) - .method public hidebysig specialname - instance int32 get_x() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 TestFunction25/Point::x@ - IL_0006: ret - } // end of method Point::get_x - - .method public hidebysig specialname - instance int32 get_y() cil managed - { - // Code size 7 (0x7) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldfld int32 TestFunction25/Point::y@ - IL_0006: ret - } // end of method Point::get_y - - .method public hidebysig specialname - instance void set_x(int32 'value') cil managed - { - // Code size 8 (0x8) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: stfld int32 TestFunction25/Point::x@ - IL_0007: ret - } // end of method Point::set_x - - .method public hidebysig specialname - instance void set_y(int32 'value') cil managed - { - // Code size 8 (0x8) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: stfld int32 TestFunction25/Point::y@ - IL_0007: ret - } // end of method Point::set_y - - .method public specialname rtspecialname - instance void .ctor(int32 x, - int32 y) cil managed - { - // Code size 21 (0x15) - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void [mscorlib]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: ldarg.1 - IL_0008: stfld int32 TestFunction25/Point::x@ - IL_000d: ldarg.0 - IL_000e: ldarg.2 - IL_000f: stfld int32 TestFunction25/Point::y@ - IL_0014: ret - } // end of method Point::.ctor - - .method public strict virtual instance string - ToString() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) - .maxstack 8 - IL_0000: ldstr "%+A" - IL_0005: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class TestFunction25/Point>::.ctor(string) - IL_000a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_000f: ldarg.0 - IL_0010: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) - IL_0015: ret - } // end of method Point::ToString - - .method public hidebysig virtual final - instance int32 CompareTo(class TestFunction25/Point obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 101 (0x65) - .maxstack 4 - .locals init ([0] int32 V_0, - [1] class [mscorlib]System.Collections.IComparer V_1, - [2] int32 V_2, - [3] int32 V_3) - .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\TestFunctions\\TestFunction25.fs' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_005b - - .line 16707566,16707566 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_0059 - - .line 16707566,16707566 : 0,0 '' - IL_000c: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() - IL_0011: stloc.1 - IL_0012: ldarg.0 - IL_0013: ldfld int32 TestFunction25/Point::x@ - IL_0018: stloc.2 - IL_0019: ldarg.1 - IL_001a: ldfld int32 TestFunction25/Point::x@ - IL_001f: stloc.3 - IL_0020: ldloc.2 - IL_0021: ldloc.3 - IL_0022: bge.s IL_0028 - - .line 16707566,16707566 : 0,0 '' - IL_0024: ldc.i4.m1 - .line 16707566,16707566 : 0,0 '' - IL_0025: nop - IL_0026: br.s IL_002d - - .line 16707566,16707566 : 0,0 '' - IL_0028: ldloc.2 - IL_0029: ldloc.3 - IL_002a: cgt - .line 16707566,16707566 : 0,0 '' - IL_002c: nop - .line 16707566,16707566 : 0,0 '' - IL_002d: stloc.0 - IL_002e: ldloc.0 - IL_002f: ldc.i4.0 - IL_0030: bge.s IL_0034 - - .line 16707566,16707566 : 0,0 '' - IL_0032: ldloc.0 - IL_0033: ret - - .line 16707566,16707566 : 0,0 '' - IL_0034: ldloc.0 - IL_0035: ldc.i4.0 - IL_0036: ble.s IL_003a - - .line 16707566,16707566 : 0,0 '' - IL_0038: ldloc.0 - IL_0039: ret - - .line 16707566,16707566 : 0,0 '' - IL_003a: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() - IL_003f: stloc.1 - IL_0040: ldarg.0 - IL_0041: ldfld int32 TestFunction25/Point::y@ - IL_0046: stloc.2 - IL_0047: ldarg.1 - IL_0048: ldfld int32 TestFunction25/Point::y@ - IL_004d: stloc.3 - IL_004e: ldloc.2 - IL_004f: ldloc.3 - IL_0050: bge.s IL_0054 - - .line 16707566,16707566 : 0,0 '' - IL_0052: ldc.i4.m1 - IL_0053: ret - - .line 16707566,16707566 : 0,0 '' - IL_0054: ldloc.2 - IL_0055: ldloc.3 - IL_0056: cgt - IL_0058: ret - - .line 16707566,16707566 : 0,0 '' - IL_0059: ldc.i4.1 - IL_005a: ret - - .line 16707566,16707566 : 0,0 '' - IL_005b: ldarg.1 - IL_005c: ldnull - IL_005d: cgt.un - IL_005f: brfalse.s IL_0063 - - .line 16707566,16707566 : 0,0 '' - IL_0061: ldc.i4.m1 - IL_0062: ret - - .line 16707566,16707566 : 0,0 '' - IL_0063: ldc.i4.0 - IL_0064: ret - } // end of method Point::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 13 (0xd) - .maxstack 8 - .line 4,4 : 6,11 '' - IL_0000: ldarg.0 - IL_0001: ldarg.1 - IL_0002: unbox.any TestFunction25/Point - IL_0007: callvirt instance int32 TestFunction25/Point::CompareTo(class TestFunction25/Point) - IL_000c: ret - } // end of method Point::CompareTo - - .method public hidebysig virtual final - instance int32 CompareTo(object obj, - class [mscorlib]System.Collections.IComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 106 (0x6a) - .maxstack 4 - .locals init ([0] class TestFunction25/Point V_0, - [1] int32 V_1, - [2] int32 V_2, - [3] int32 V_3) - .line 4,4 : 6,11 '' - IL_0000: ldarg.1 - IL_0001: unbox.any TestFunction25/Point - IL_0006: stloc.0 - IL_0007: ldarg.0 - IL_0008: ldnull - IL_0009: cgt.un - IL_000b: brfalse.s IL_005b - - .line 16707566,16707566 : 0,0 '' - IL_000d: ldarg.1 - IL_000e: unbox.any TestFunction25/Point - IL_0013: ldnull - IL_0014: cgt.un - IL_0016: brfalse.s IL_0059 - - .line 16707566,16707566 : 0,0 '' - IL_0018: ldarg.0 - IL_0019: ldfld int32 TestFunction25/Point::x@ - IL_001e: stloc.2 - IL_001f: ldloc.0 - IL_0020: ldfld int32 TestFunction25/Point::x@ - IL_0025: stloc.3 - IL_0026: ldloc.2 - IL_0027: ldloc.3 - IL_0028: bge.s IL_002e - - .line 16707566,16707566 : 0,0 '' - IL_002a: ldc.i4.m1 - .line 16707566,16707566 : 0,0 '' - IL_002b: nop - IL_002c: br.s IL_0033 - - .line 16707566,16707566 : 0,0 '' - IL_002e: ldloc.2 - IL_002f: ldloc.3 - IL_0030: cgt - .line 16707566,16707566 : 0,0 '' - IL_0032: nop - .line 16707566,16707566 : 0,0 '' - IL_0033: stloc.1 - IL_0034: ldloc.1 - IL_0035: ldc.i4.0 - IL_0036: bge.s IL_003a - - .line 16707566,16707566 : 0,0 '' - IL_0038: ldloc.1 - IL_0039: ret - - .line 16707566,16707566 : 0,0 '' - IL_003a: ldloc.1 - IL_003b: ldc.i4.0 - IL_003c: ble.s IL_0040 - - .line 16707566,16707566 : 0,0 '' - IL_003e: ldloc.1 - IL_003f: ret - - .line 16707566,16707566 : 0,0 '' - IL_0040: ldarg.0 - IL_0041: ldfld int32 TestFunction25/Point::y@ - IL_0046: stloc.2 - IL_0047: ldloc.0 - IL_0048: ldfld int32 TestFunction25/Point::y@ - IL_004d: stloc.3 - IL_004e: ldloc.2 - IL_004f: ldloc.3 - IL_0050: bge.s IL_0054 - - .line 16707566,16707566 : 0,0 '' - IL_0052: ldc.i4.m1 - IL_0053: ret - - .line 16707566,16707566 : 0,0 '' - IL_0054: ldloc.2 - IL_0055: ldloc.3 - IL_0056: cgt - IL_0058: ret - - .line 16707566,16707566 : 0,0 '' - IL_0059: ldc.i4.1 - IL_005a: ret - - .line 16707566,16707566 : 0,0 '' - IL_005b: ldarg.1 - IL_005c: unbox.any TestFunction25/Point - IL_0061: ldnull - IL_0062: cgt.un - IL_0064: brfalse.s IL_0068 - - .line 16707566,16707566 : 0,0 '' - IL_0066: ldc.i4.m1 - IL_0067: ret - - .line 16707566,16707566 : 0,0 '' - IL_0068: ldc.i4.0 - IL_0069: ret - } // end of method Point::CompareTo - - .method public hidebysig virtual final - instance int32 GetHashCode(class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 54 (0x36) - .maxstack 7 - .locals init ([0] int32 V_0) - .line 16707566,16707566 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0034 - - .line 16707566,16707566 : 0,0 '' - IL_0006: ldc.i4.0 - IL_0007: stloc.0 - IL_0008: ldc.i4 0x9e3779b9 - IL_000d: ldarg.0 - IL_000e: ldfld int32 TestFunction25/Point::y@ - IL_0013: ldloc.0 - IL_0014: ldc.i4.6 - IL_0015: shl - IL_0016: ldloc.0 - IL_0017: ldc.i4.2 - IL_0018: shr - IL_0019: add - IL_001a: add - IL_001b: add - IL_001c: stloc.0 - IL_001d: ldc.i4 0x9e3779b9 - IL_0022: ldarg.0 - IL_0023: ldfld int32 TestFunction25/Point::x@ - IL_0028: ldloc.0 - IL_0029: ldc.i4.6 - IL_002a: shl - IL_002b: ldloc.0 - IL_002c: ldc.i4.2 - IL_002d: shr - IL_002e: add - IL_002f: add - IL_0030: add - IL_0031: stloc.0 - IL_0032: ldloc.0 - IL_0033: ret - - .line 16707566,16707566 : 0,0 '' - IL_0034: ldc.i4.0 - IL_0035: ret - } // end of method Point::GetHashCode - - .method public hidebysig virtual final - instance int32 GetHashCode() cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 12 (0xc) - .maxstack 8 - .line 4,4 : 6,11 '' - IL_0000: ldarg.0 - IL_0001: call class [mscorlib]System.Collections.IEqualityComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericEqualityComparer() - IL_0006: callvirt instance int32 TestFunction25/Point::GetHashCode(class [mscorlib]System.Collections.IEqualityComparer) - IL_000b: ret - } // end of method Point::GetHashCode - - .method public hidebysig virtual final - instance bool Equals(object obj, - class [mscorlib]System.Collections.IEqualityComparer comp) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 57 (0x39) - .maxstack 4 - .locals init ([0] class TestFunction25/Point V_0) - .line 16707566,16707566 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_0031 - - .line 16707566,16707566 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: isinst TestFunction25/Point - IL_000c: stloc.0 - IL_000d: ldloc.0 - IL_000e: brfalse.s IL_002f - - .line 16707566,16707566 : 0,0 '' - IL_0010: ldarg.0 - IL_0011: ldfld int32 TestFunction25/Point::x@ - IL_0016: ldloc.0 - IL_0017: ldfld int32 TestFunction25/Point::x@ - IL_001c: bne.un.s IL_002d - - .line 16707566,16707566 : 0,0 '' - IL_001e: ldarg.0 - IL_001f: ldfld int32 TestFunction25/Point::y@ - IL_0024: ldloc.0 - IL_0025: ldfld int32 TestFunction25/Point::y@ - IL_002a: ceq - IL_002c: ret - - .line 16707566,16707566 : 0,0 '' - IL_002d: ldc.i4.0 - IL_002e: ret - - .line 16707566,16707566 : 0,0 '' - IL_002f: ldc.i4.0 - IL_0030: ret - - .line 16707566,16707566 : 0,0 '' - IL_0031: ldarg.1 - IL_0032: ldnull - IL_0033: cgt.un - IL_0035: ldc.i4.0 - IL_0036: ceq - IL_0038: ret - } // end of method Point::Equals - - .method public hidebysig virtual final - instance bool Equals(class TestFunction25/Point obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 53 (0x35) - .maxstack 8 - .line 16707566,16707566 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: ldnull - IL_0002: cgt.un - IL_0004: brfalse.s IL_002d - - .line 16707566,16707566 : 0,0 '' - IL_0006: ldarg.1 - IL_0007: ldnull - IL_0008: cgt.un - IL_000a: brfalse.s IL_002b - - .line 16707566,16707566 : 0,0 '' - IL_000c: ldarg.0 - IL_000d: ldfld int32 TestFunction25/Point::x@ - IL_0012: ldarg.1 - IL_0013: ldfld int32 TestFunction25/Point::x@ - IL_0018: bne.un.s IL_0029 - - .line 16707566,16707566 : 0,0 '' - IL_001a: ldarg.0 - IL_001b: ldfld int32 TestFunction25/Point::y@ - IL_0020: ldarg.1 - IL_0021: ldfld int32 TestFunction25/Point::y@ - IL_0026: ceq - IL_0028: ret - - .line 16707566,16707566 : 0,0 '' - IL_0029: ldc.i4.0 - IL_002a: ret - - .line 16707566,16707566 : 0,0 '' - IL_002b: ldc.i4.0 - IL_002c: ret - - .line 16707566,16707566 : 0,0 '' - IL_002d: ldarg.1 - IL_002e: ldnull - IL_002f: cgt.un - IL_0031: ldc.i4.0 - IL_0032: ceq - IL_0034: ret - } // end of method Point::Equals - - .method public hidebysig virtual final - instance bool Equals(object obj) cil managed - { - .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) - .maxstack 4 - .locals init ([0] class TestFunction25/Point V_0) - .line 4,4 : 6,11 '' - IL_0000: ldarg.1 - IL_0001: isinst TestFunction25/Point - IL_0006: stloc.0 - IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 - - .line 16707566,16707566 : 0,0 '' - IL_000a: ldarg.0 - IL_000b: ldloc.0 - IL_000c: callvirt instance bool TestFunction25/Point::Equals(class TestFunction25/Point) - IL_0011: ret - - .line 16707566,16707566 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret - } // end of method Point::Equals - - .property instance int32 x() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 04 00 00 00 00 00 00 00 00 00 ) - .set instance void TestFunction25/Point::set_x(int32) - .get instance int32 TestFunction25/Point::get_x() - } // end of property Point::x - .property instance int32 y() - { - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags, - int32) = ( 01 00 04 00 00 00 01 00 00 00 00 00 ) - .set instance void TestFunction25/Point::set_y(int32) - .get instance int32 TestFunction25/Point::get_y() - } // end of property Point::y - } // end of class Point - - .method public static int32 pinObject() cil managed - { - // Code size 52 (0x34) - .maxstack 6 - .locals init ([0] class TestFunction25/Point point, - [1] native int p1, - [2] int32& pinned V_2) - .line 7,7 : 5,33 '' - IL_0000: ldc.i4.1 - IL_0001: ldc.i4.2 - IL_0002: newobj instance void TestFunction25/Point::.ctor(int32, - int32) - IL_0007: stloc.0 - .line 8,8 : 5,28 '' - IL_0008: ldloc.0 - IL_0009: ldflda int32 TestFunction25/Point::x@ - IL_000e: stloc.2 - IL_000f: ldloc.2 - IL_0010: conv.i - IL_0011: stloc.1 - .line 9,9 : 5,44 '' - IL_0012: ldloc.1 - IL_0013: ldc.i4.0 - IL_0014: conv.i - IL_0015: sizeof [mscorlib]System.Int32 - IL_001b: mul - IL_001c: add - IL_001d: ldobj [mscorlib]System.Int32 - IL_0022: ldloc.1 - IL_0023: ldc.i4.1 - IL_0024: conv.i - IL_0025: sizeof [mscorlib]System.Int32 - IL_002b: mul - IL_002c: add - IL_002d: ldobj [mscorlib]System.Int32 - IL_0032: add - IL_0033: ret - } // end of method TestFunction25::pinObject - - .method public static int32 pinRef() cil managed - { - // Code size 32 (0x20) - .maxstack 4 - .locals init ([0] class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1 point, - [1] native int p1, - [2] int32& pinned V_2) - .line 12,12 : 5,23 '' - IL_0000: ldc.i4.s 17 - IL_0002: newobj instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1::.ctor(!0) - IL_0007: stloc.0 - .line 13,13 : 5,35 '' - IL_0008: ldloc.0 - IL_0009: ldflda !0 class [FSharp.Core]Microsoft.FSharp.Core.FSharpRef`1::contents@ - IL_000e: stloc.2 - IL_000f: ldloc.2 - IL_0010: conv.i - IL_0011: stloc.1 - .line 14,14 : 5,42 '' - IL_0012: ldloc.1 - IL_0013: ldobj [mscorlib]System.Int32 - IL_0018: ldloc.1 - IL_0019: ldobj [mscorlib]System.Int32 - IL_001e: add - IL_001f: ret - } // end of method TestFunction25::pinRef - - .method public static float64 pinArray1() cil managed - { - // Code size 170 (0xaa) - .maxstack 6 - .locals init ([0] float64[] arr, - [1] native int p1, - [2] float64& pinned V_2) - .line 17,17 : 5,49 '' - IL_0000: ldc.i4.6 - IL_0001: newarr [mscorlib]System.Double - IL_0006: dup - IL_0007: ldc.i4.0 - IL_0008: ldc.r8 0.0 - IL_0011: stelem [mscorlib]System.Double - IL_0016: dup - IL_0017: ldc.i4.1 - IL_0018: ldc.r8 1.5 - IL_0021: stelem [mscorlib]System.Double - IL_0026: dup - IL_0027: ldc.i4.2 - IL_0028: ldc.r8 2.2999999999999998 - IL_0031: stelem [mscorlib]System.Double - IL_0036: dup - IL_0037: ldc.i4.3 - IL_0038: ldc.r8 3.3999999999999999 - IL_0041: stelem [mscorlib]System.Double - IL_0046: dup - IL_0047: ldc.i4.4 - IL_0048: ldc.r8 4. - IL_0051: stelem [mscorlib]System.Double - IL_0056: dup - IL_0057: ldc.i4.5 - IL_0058: ldc.r8 5.9000000000000004 - IL_0061: stelem [mscorlib]System.Double - IL_0066: stloc.0 - .line 18,18 : 5,23 '' - IL_0067: ldloc.0 - IL_0068: brfalse.s IL_0084 - - .line 16707566,16707566 : 0,0 '' - IL_006a: ldloc.0 - IL_006b: call int32 [FSharp.Core]Microsoft.FSharp.Collections.ArrayModule::Length(!!0[]) - IL_0070: brfalse.s IL_007f - - .line 16707566,16707566 : 0,0 '' - IL_0072: ldloc.0 - IL_0073: ldc.i4.0 - IL_0074: ldelema [mscorlib]System.Double - IL_0079: stloc.2 - IL_007a: ldloc.2 - IL_007b: conv.i - .line 16707566,16707566 : 0,0 '' - IL_007c: nop - IL_007d: br.s IL_0087 - - .line 16707566,16707566 : 0,0 '' - IL_007f: ldc.i4.0 - IL_0080: conv.i - .line 16707566,16707566 : 0,0 '' - IL_0081: nop - IL_0082: br.s IL_0087 - - .line 16707566,16707566 : 0,0 '' - IL_0084: ldc.i4.0 - IL_0085: conv.i - .line 16707566,16707566 : 0,0 '' - IL_0086: nop - .line 16707566,16707566 : 0,0 '' - IL_0087: stloc.1 - .line 19,19 : 5,44 '' - IL_0088: ldloc.1 - IL_0089: ldc.i4.0 - IL_008a: conv.i - IL_008b: sizeof [mscorlib]System.Double - IL_0091: mul - IL_0092: add - IL_0093: ldobj [mscorlib]System.Double - IL_0098: ldloc.1 - IL_0099: ldc.i4.1 - IL_009a: conv.i - IL_009b: sizeof [mscorlib]System.Double - IL_00a1: mul - IL_00a2: add - IL_00a3: ldobj [mscorlib]System.Double - IL_00a8: add - IL_00a9: ret - } // end of method TestFunction25::pinArray1 - - .method public static float64 pinArray2() cil managed - { - // Code size 148 (0x94) - .maxstack 6 - .locals init ([0] float64[] arr, - [1] native int p, - [2] float64& pinned V_2) - .line 22,22 : 5,49 '' - IL_0000: ldc.i4.6 - IL_0001: newarr [mscorlib]System.Double - IL_0006: dup - IL_0007: ldc.i4.0 - IL_0008: ldc.r8 0.0 - IL_0011: stelem [mscorlib]System.Double - IL_0016: dup - IL_0017: ldc.i4.1 - IL_0018: ldc.r8 1.5 - IL_0021: stelem [mscorlib]System.Double - IL_0026: dup - IL_0027: ldc.i4.2 - IL_0028: ldc.r8 2.2999999999999998 - IL_0031: stelem [mscorlib]System.Double - IL_0036: dup - IL_0037: ldc.i4.3 - IL_0038: ldc.r8 3.3999999999999999 - IL_0041: stelem [mscorlib]System.Double - IL_0046: dup - IL_0047: ldc.i4.4 - IL_0048: ldc.r8 4. - IL_0051: stelem [mscorlib]System.Double - IL_0056: dup - IL_0057: ldc.i4.5 - IL_0058: ldc.r8 5.9000000000000004 - IL_0061: stelem [mscorlib]System.Double - IL_0066: stloc.0 - .line 24,24 : 5,27 '' - IL_0067: ldloc.0 - IL_0068: ldc.i4.0 - IL_0069: ldelema [mscorlib]System.Double - IL_006e: stloc.2 - IL_006f: ldloc.2 - IL_0070: conv.i - IL_0071: stloc.1 - .line 25,25 : 5,42 '' - IL_0072: ldloc.1 - IL_0073: ldc.i4.0 - IL_0074: conv.i - IL_0075: sizeof [mscorlib]System.Double - IL_007b: mul - IL_007c: add - IL_007d: ldobj [mscorlib]System.Double - IL_0082: ldloc.1 - IL_0083: ldc.i4.1 - IL_0084: conv.i - IL_0085: sizeof [mscorlib]System.Double - IL_008b: mul - IL_008c: add - IL_008d: ldobj [mscorlib]System.Double - IL_0092: add - IL_0093: ret - } // end of method TestFunction25::pinArray2 - - .method public static class [mscorlib]System.Tuple`2 - pinString() cil managed - { - // Code size 57 (0x39) - .maxstack 6 - .locals init ([0] native int pChar, - [1] string pinned V_1) - .line 30,30 : 5,26 '' - IL_0000: ldstr "Hello World" - IL_0005: stloc.1 - IL_0006: ldstr "Hello World" - IL_000b: conv.i - IL_000c: call int32 [mscorlib]System.Runtime.CompilerServices.RuntimeHelpers::get_OffsetToStringData() - IL_0011: add - IL_0012: stloc.0 - .line 31,31 : 5,50 '' - IL_0013: ldloc.0 - IL_0014: ldc.i4.0 - IL_0015: conv.i - IL_0016: sizeof [mscorlib]System.Char - IL_001c: mul - IL_001d: add - IL_001e: ldobj [mscorlib]System.Char - IL_0023: ldloc.0 - IL_0024: ldc.i4.1 - IL_0025: conv.i - IL_0026: sizeof [mscorlib]System.Char - IL_002c: mul - IL_002d: add - IL_002e: ldobj [mscorlib]System.Char - IL_0033: newobj instance void class [mscorlib]System.Tuple`2::.ctor(!0, - !1) - IL_0038: ret - } // end of method TestFunction25::pinString - -} // end of class TestFunction25 - -.class private abstract auto ansi sealed ''.$TestFunction25 - extends [mscorlib]System.Object -{ - .method public static void main@() cil managed - { - .entrypoint - // Code size 1 (0x1) - .maxstack 8 - IL_0000: ret - } // end of method $TestFunction25::main@ - -} // end of class ''.$TestFunction25 - - -// ============================================================= - -// *********** DISASSEMBLY COMPLETE *********************** diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/env.lst b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/env.lst index e70c0627d87..6278df20bb0 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/env.lst +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/env.lst @@ -44,4 +44,3 @@ SOURCE=Testfunction22h.fs SCFLAGS="-g --test:EmitFeeFeeAs100001 --optimize-" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd TestFunction22h.exe" # TestFunction22h.fs - SOURCE=TestFunction24.fs SCFLAGS="-g --optimize-" PEVER=/Exp_Fail COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd TestFunction24.exe" # TestFunction24.fs - - SOURCE=TestFunction25.fs SCFLAGS="-g --optimize+" PEVER=/Exp_Fail COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd TestFunction25.exe" # TestFunction25.fs - diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/OptionalArg01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/OptionalArg01.il.bsl index 01eb586a73f..92b9f88d01f 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/OptionalArg01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/OptionalArg01.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000460 Length: 0x00000445 } .module OptionalArg01.exe -// MVID: {60D46F2D-4F48-B5AF-A745-03832D6FD460} +// MVID: {60B68B97-4F48-B5AF-A745-0383978BB660} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x06C40000 +// Image base: 0x05C20000 // =============== CLASS MEMBERS DECLARATION =================== @@ -205,7 +205,7 @@ { // Code size 7 (0x7) .maxstack 8 - .line 10,10 : 23,44 '' + .line 19,19 : 5,11 '' IL_0000: ldc.i4.0 IL_0001: newobj instance void class [mscorlib]System.Collections.Generic.List`1::.ctor(int32) IL_0006: ret @@ -216,20 +216,17 @@ { // Code size 22 (0x16) .maxstack 4 - .locals init ([0] class OptionalArg01/A v1, - [1] class [mscorlib]System.Collections.Generic.List`1 attribs) + .locals init ([0] class OptionalArg01/A V_0, + [1] class [mscorlib]System.Collections.Generic.List`1 V_1) .line 27,27 : 5,17 '' IL_0000: newobj instance void OptionalArg01/A::.ctor() IL_0005: stloc.0 - .line 10,10 : 9,44 '' IL_0006: ldc.i4.1 IL_0007: newobj instance void class [mscorlib]System.Collections.Generic.List`1::.ctor(int32) IL_000c: stloc.1 - .line 11,11 : 47,62 '' IL_000d: ldloc.1 IL_000e: ldloc.0 IL_000f: callvirt instance void class [mscorlib]System.Collections.Generic.List`1::Add(!0) - .line 13,13 : 9,16 '' IL_0014: ldloc.1 IL_0015: ret } // end of method OptionalArg01::test2 @@ -239,20 +236,17 @@ { // Code size 22 (0x16) .maxstack 4 - .locals init ([0] class OptionalArg01/A v2, - [1] class [mscorlib]System.Collections.Generic.List`1 attribs) + .locals init ([0] class OptionalArg01/A V_0, + [1] class [mscorlib]System.Collections.Generic.List`1 V_1) .line 35,35 : 5,17 '' IL_0000: newobj instance void OptionalArg01/A::.ctor() IL_0005: stloc.0 - .line 10,10 : 9,44 '' IL_0006: ldc.i4.1 IL_0007: newobj instance void class [mscorlib]System.Collections.Generic.List`1::.ctor(int32) IL_000c: stloc.1 - .line 12,12 : 47,62 '' IL_000d: ldloc.1 IL_000e: ldloc.0 IL_000f: callvirt instance void class [mscorlib]System.Collections.Generic.List`1::Add(!0) - .line 13,13 : 9,16 '' IL_0014: ldloc.1 IL_0015: ret } // end of method OptionalArg01::test3 @@ -262,27 +256,23 @@ { // Code size 35 (0x23) .maxstack 4 - .locals init ([0] class OptionalArg01/A v1, - [1] class OptionalArg01/A v2, - [2] class [mscorlib]System.Collections.Generic.List`1 attribs) + .locals init ([0] class OptionalArg01/A V_0, + [1] class OptionalArg01/A V_1, + [2] class [mscorlib]System.Collections.Generic.List`1 V_2) .line 45,45 : 5,25 '' IL_0000: newobj instance void OptionalArg01/A::.ctor() IL_0005: stloc.0 IL_0006: newobj instance void OptionalArg01/A::.ctor() IL_000b: stloc.1 - .line 10,10 : 9,44 '' IL_000c: ldc.i4.2 IL_000d: newobj instance void class [mscorlib]System.Collections.Generic.List`1::.ctor(int32) IL_0012: stloc.2 - .line 11,11 : 47,62 '' IL_0013: ldloc.2 IL_0014: ldloc.0 IL_0015: callvirt instance void class [mscorlib]System.Collections.Generic.List`1::Add(!0) - .line 12,12 : 47,62 '' IL_001a: ldloc.2 IL_001b: ldloc.1 IL_001c: callvirt instance void class [mscorlib]System.Collections.Generic.List`1::Add(!0) - .line 13,13 : 9,16 '' IL_0021: ldloc.2 IL_0022: ret } // end of method OptionalArg01::test4 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/TupleElimination.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/TupleElimination.il.bsl index ba2f7ee8e8e..c7180964946 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/TupleElimination.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/TupleElimination.il.bsl @@ -41,13 +41,13 @@ // Offset: 0x00000230 Length: 0x0000007B } .module TupleElimination.exe -// MVID: {60D46F2D-DFDD-92DF-A745-03832D6FD460} +// MVID: {60CB69C6-DFDD-92DF-A745-0383C669CB60} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x06A70000 +// Image base: 0x06AF0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -98,11 +98,11 @@ IL_000a: callvirt instance bool class [mscorlib]System.Collections.Generic.Dictionary`2::TryGetValue(!0, !1&) IL_000f: stloc.2 - .line 10,10 : 5,8 '' + .line 10,10 : 5,6 '' IL_0010: ldloc.2 IL_0011: call void TupleElimination::p@5(!!0) IL_0016: nop - .line 11,11 : 5,8 '' + .line 11,11 : 5,6 '' IL_0017: ldloc.1 IL_0018: call void TupleElimination::p@5(!!0) IL_001d: nop @@ -118,15 +118,15 @@ IL_002f: newobj instance void class [mscorlib]System.Tuple`2::.ctor(!0, !1) IL_0034: stloc.s t - .line 15,15 : 5,8 '' + .line 15,15 : 5,6 '' IL_0036: ldloc.s V_4 IL_0038: call void TupleElimination::p@5(!!0) IL_003d: nop - .line 16,16 : 5,8 '' + .line 16,16 : 5,6 '' IL_003e: ldloc.3 IL_003f: call void TupleElimination::p@5(!!0) IL_0044: nop - .line 21,21 : 5,9 '' + .line 21,21 : 5,6 '' IL_0045: ldloc.s t IL_0047: call void TupleElimination::p@5>(!!0) IL_004c: nop diff --git a/tests/fsharpqa/Source/Optimizations/CompareIL.cmd b/tests/fsharpqa/Source/Optimizations/CompareIL.cmd index ca278788982..3c34a493298 100644 --- a/tests/fsharpqa/Source/Optimizations/CompareIL.cmd +++ b/tests/fsharpqa/Source/Optimizations/CompareIL.cmd @@ -1,17 +1,15 @@ REM == %1 --> assembly ildasm /TEXT /LINENUM /NOBAR "%~nx1" >"%~n1.il" -IF %ERRORLEVEL% NEQ 0 exit /b 1 +IF NOT ERRORLEVEL 0 exit 1 echo ..\..\..\testenv\bin\ILComparer.exe "%~n1.il.bsl" "%~n1.il" ..\..\..\testenv\bin\ILComparer.exe "%~n1.il.bsl" "%~n1.il" -IF %ERRORLEVEL% EQU 0 exit /b 0 - if /i "%TEST_UPDATE_BSL%" == "1" ( echo copy /y "%~n1.il" "%~n1.il.bsl" copy /y "%~n1.il" "%~n1.il.bsl" ) -exit /b 1 +exit /b %ERRORLEVEL% diff --git a/tests/service/AssemblyContentProviderTests.fs b/tests/service/AssemblyContentProviderTests.fs index e3fe4d556a6..db678bf70bb 100644 --- a/tests/service/AssemblyContentProviderTests.fs +++ b/tests/service/AssemblyContentProviderTests.fs @@ -13,6 +13,7 @@ open System.Text open NUnit.Framework open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.EditorServices +open FSharp.Compiler.Service.Tests.Common let private filePath = "C:\\test.fs" @@ -43,7 +44,7 @@ let (=>) (source: string) (expected: string list) = // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak yield "" |] - let _, checkFileAnswer = checker.ParseAndCheckFileInProject(filePath, 0, FSharp.Compiler.Text.SourceText.ofString source, projectOptions) |> Async.RunSynchronously + let _, checkFileAnswer = checker.ParseAndCheckFileInProject(filePath, 0, FSharp.Compiler.Text.SourceText.ofString source, projectOptions) |> Async.RunImmediate let checkFileResults = match checkFileAnswer with diff --git a/tests/service/AssemblyReaderShim.fs b/tests/service/AssemblyReaderShim.fs index 8e8d18efe2a..551422b53b3 100644 --- a/tests/service/AssemblyReaderShim.fs +++ b/tests/service/AssemblyReaderShim.fs @@ -29,5 +29,5 @@ let x = 123 """ let fileName, options = Common.mkTestFileAndOptions source [| |] - Common.checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString source, options) |> Async.RunSynchronously |> ignore + Common.checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString source, options) |> Async.RunImmediate |> ignore gotRequest |> should be True diff --git a/tests/service/CSharpProjectAnalysis.fs b/tests/service/CSharpProjectAnalysis.fs index 27d01a80128..0e348688ff4 100644 --- a/tests/service/CSharpProjectAnalysis.fs +++ b/tests/service/CSharpProjectAnalysis.fs @@ -43,7 +43,7 @@ let internal getProjectReferences (content: string, dllFiles, libDirs, otherFlag yield "-I:"+libDir yield! otherFlags yield fileName1 |]) - let results = checker.ParseAndCheckProject(options) |> Async.RunSynchronously + let results = checker.ParseAndCheckProject(options) |> Async.RunImmediate if results.HasCriticalErrors then let builder = new System.Text.StringBuilder() for err in results.Diagnostics do diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 12f12e1c1eb..410faa45c3d 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -6,6 +6,8 @@ open System.Diagnostics open System.IO open System.Collections.Generic open System.Collections.Immutable +open System.Threading +open System.Threading.Tasks open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.IO open FSharp.Compiler.Diagnostics @@ -13,10 +15,22 @@ open FSharp.Compiler.Symbols open FSharp.Compiler.Symbols.FSharpExprPatterns open FSharp.Compiler.Syntax open FSharp.Compiler.Text -open FSharp.Compiler.Text open FsUnit open NUnit.Framework +type Async with + static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = + let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + 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.Result + #if NETCOREAPP let readRefs (folder : string) (projectFile: string) = let runProcess (workingDir: string) (exePath: string) (args: string) = @@ -65,14 +79,14 @@ type TempFile(ext, contents: string) = let getBackgroundParseResultsForScriptText (input: string) = use file = new TempFile("fsx", input) - let checkOptions, _diagnostics = checker.GetProjectOptionsFromScript(file.Name, SourceText.ofString input) |> Async.RunSynchronously - checker.GetBackgroundParseResultsForFileInProject(file.Name, checkOptions) |> Async.RunSynchronously + let checkOptions, _diagnostics = checker.GetProjectOptionsFromScript(file.Name, SourceText.ofString input) |> Async.RunImmediate + checker.GetBackgroundParseResultsForFileInProject(file.Name, checkOptions) |> Async.RunImmediate let getBackgroundCheckResultsForScriptText (input: string) = use file = new TempFile("fsx", input) - let checkOptions, _diagnostics = checker.GetProjectOptionsFromScript(file.Name, SourceText.ofString input) |> Async.RunSynchronously - checker.GetBackgroundCheckResultsForFileInProject(file.Name, checkOptions) |> Async.RunSynchronously + let checkOptions, _diagnostics = checker.GetProjectOptionsFromScript(file.Name, SourceText.ofString input) |> Async.RunImmediate + checker.GetBackgroundCheckResultsForFileInProject(file.Name, checkOptions) |> Async.RunImmediate let sysLib nm = @@ -172,7 +186,7 @@ let mkTestFileAndOptions source additionalArgs = fileName, options let parseAndCheckFile fileName source options = - match checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString source, options) |> Async.RunSynchronously with + match checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString source, options) |> Async.RunImmediate with | parseResults, FSharpCheckFileAnswer.Succeeded(checkResults) -> parseResults, checkResults | _ -> failwithf "Parsing aborted unexpectedly..." @@ -197,12 +211,12 @@ let parseAndCheckScriptWithOptions (file:string, input, opts) = Directory.Delete(path, true) #else - let projectOptions, _diagnostics = checker.GetProjectOptionsFromScript(file, SourceText.ofString input) |> Async.RunSynchronously + let projectOptions, _diagnostics = checker.GetProjectOptionsFromScript(file, SourceText.ofString input) |> Async.RunImmediate //printfn "projectOptions = %A" projectOptions #endif let projectOptions = { projectOptions with OtherOptions = Array.append opts projectOptions.OtherOptions } - let parseResult, typedRes = checker.ParseAndCheckFileInProject(file, 0, SourceText.ofString input, projectOptions) |> Async.RunSynchronously + let parseResult, typedRes = checker.ParseAndCheckFileInProject(file, 0, SourceText.ofString input, projectOptions) |> Async.RunImmediate // if parseResult.Errors.Length > 0 then // printfn "---> Parse Input = %A" input @@ -222,7 +236,7 @@ let parseSourceCode (name: string, code: string) = let dllPath = Path.Combine(location, name + ".dll") let args = mkProjectCommandLineArgs(dllPath, [filePath]) let options, errors = checker.GetParsingOptionsFromCommandLineArgs(List.ofArray args) - let parseResults = checker.ParseFile(filePath, SourceText.ofString code, options) |> Async.RunSynchronously + let parseResults = checker.ParseFile(filePath, SourceText.ofString code, options) |> Async.RunImmediate parseResults.ParseTree let matchBraces (name: string, code: string) = @@ -232,7 +246,7 @@ let matchBraces (name: string, code: string) = let dllPath = Path.Combine(location, name + ".dll") let args = mkProjectCommandLineArgs(dllPath, [filePath]) let options, errors = checker.GetParsingOptionsFromCommandLineArgs(List.ofArray args) - let braces = checker.MatchBraces(filePath, SourceText.ofString code, options) |> Async.RunSynchronously + let braces = checker.MatchBraces(filePath, SourceText.ofString code, options) |> Async.RunImmediate braces @@ -447,3 +461,4 @@ let assertRange : unit = Assert.AreEqual(Position.mkPos expectedStartLine expectedStartColumn, actualRange.Start) Assert.AreEqual(Position.mkPos expectedEndLine expectedEndColumn, actualRange.End) + diff --git a/tests/service/EditorTests.fs b/tests/service/EditorTests.fs index ab3a1f8e492..03f42af9add 100644 --- a/tests/service/EditorTests.fs +++ b/tests/service/EditorTests.fs @@ -68,7 +68,7 @@ let ``Intro test`` () = let file = "/home/user/Test.fsx" let parseResult, typeCheckResults = parseAndCheckScript(file, input) let identToken = FSharpTokenTag.IDENT -// let projectOptions = checker.GetProjectOptionsFromScript(file, input) |> Async.RunSynchronously +// let projectOptions = checker.GetProjectOptionsFromScript(file, input) |> Async.RunImmediate // So we check that the messages are the same for msg in typeCheckResults.Diagnostics do @@ -132,7 +132,7 @@ let ``Intro test`` () = // let! checkOptions, _diagnostics = checker.GetProjectOptionsFromScript(file, SourceText.ofString input) // let! parseResult, typedRes = checker.ParseAndCheckFileInProject(file, 0, SourceText.ofString input, checkOptions) // return parseResult, typedRes -// } |> Async.RunSynchronously +// } |> Async.RunImmediate // |> ignore // Assert.Fail("expected a cancellation") // with :? OperationCanceledException -> () @@ -1216,7 +1216,7 @@ let _ = RegexTypedStatic.IsMatch<"ABC" >( (*$*) ) // TEST: no assert on Ctrl-sp [] let ``Test TPProject all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(TPProject.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(TPProject.options) |> Async.RunImmediate let allSymbolUses = wholeProjectResults.GetAllUsesOfAllSymbols() let allSymbolUsesInfo = [ for s in allSymbolUses -> s.Symbol.DisplayName, tups s.Range, attribsOfSymbol s.Symbol ] //printfn "allSymbolUsesInfo = \n----\n%A\n----" allSymbolUsesInfo @@ -1254,8 +1254,8 @@ let ``Test TPProject all symbols`` () = [] let ``Test TPProject errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(TPProject.options) |> Async.RunSynchronously - let parseResult, typeCheckAnswer = checker.ParseAndCheckFileInProject(TPProject.fileName1, 0, TPProject.fileSource1, TPProject.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(TPProject.options) |> Async.RunImmediate + let parseResult, typeCheckAnswer = checker.ParseAndCheckFileInProject(TPProject.fileName1, 0, TPProject.fileSource1, TPProject.options) |> Async.RunImmediate let typeCheckResults = match typeCheckAnswer with | FSharpCheckFileAnswer.Succeeded(res) -> res @@ -1285,8 +1285,8 @@ let internal extractToolTipText (ToolTipText(els)) = [] let ``Test TPProject quick info`` () = - let wholeProjectResults = checker.ParseAndCheckProject(TPProject.options) |> Async.RunSynchronously - let parseResult, typeCheckAnswer = checker.ParseAndCheckFileInProject(TPProject.fileName1, 0, TPProject.fileSource1, TPProject.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(TPProject.options) |> Async.RunImmediate + let parseResult, typeCheckAnswer = checker.ParseAndCheckFileInProject(TPProject.fileName1, 0, TPProject.fileSource1, TPProject.options) |> Async.RunImmediate let typeCheckResults = match typeCheckAnswer with | FSharpCheckFileAnswer.Succeeded(res) -> res @@ -1319,8 +1319,8 @@ let ``Test TPProject quick info`` () = [] let ``Test TPProject param info`` () = - let wholeProjectResults = checker.ParseAndCheckProject(TPProject.options) |> Async.RunSynchronously - let parseResult, typeCheckAnswer = checker.ParseAndCheckFileInProject(TPProject.fileName1, 0, TPProject.fileSource1, TPProject.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(TPProject.options) |> Async.RunImmediate + let parseResult, typeCheckAnswer = checker.ParseAndCheckFileInProject(TPProject.fileName1, 0, TPProject.fileSource1, TPProject.options) |> Async.RunImmediate let typeCheckResults = match typeCheckAnswer with | FSharpCheckFileAnswer.Succeeded(res) -> res diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index e0f5e827b4b..e08bc44f57e 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -728,7 +728,7 @@ let ``Test Unoptimized Declarations Project1`` () = let cleanup, options = Project1.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project1 error: <<<%s>>>" e.Message @@ -863,7 +863,7 @@ let ``Test Optimized Declarations Project1`` () = let cleanup, options = Project1.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project1 error: <<<%s>>>" e.Message @@ -1014,7 +1014,7 @@ let testOperators dnName fsName excludedTests expectedUnoptimized expectedOptimi let options = checker.GetProjectOptionsFromCommandLineArgs (projFilePath, args) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate let referencedAssemblies = wholeProjectResults.ProjectContext.GetReferencedAssemblies() let currentAssemblyToken = let fsCore = referencedAssemblies |> List.tryFind (fun asm -> asm.SimpleName = "FSharp.Core") @@ -3194,7 +3194,7 @@ let ``Test expressions of declarations stress big expressions`` () = let cleanup, options = ProjectStressBigExpressions.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -3210,7 +3210,7 @@ let ``Test expressions of optimized declarations stress big expressions`` () = let cleanup, options = ProjectStressBigExpressions.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -3270,7 +3270,7 @@ let ``Test ProjectForWitnesses1`` () = let cleanup, options = ProjectForWitnesses1.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project1 error: <<<%s>>>" e.Message @@ -3314,7 +3314,7 @@ let ``Test ProjectForWitnesses1 GetWitnessPassingInfo`` () = let cleanup, options = ProjectForWitnesses1.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "ProjectForWitnesses1 error: <<<%s>>>" e.Message @@ -3394,7 +3394,7 @@ let ``Test ProjectForWitnesses2`` () = let cleanup, options = ProjectForWitnesses2.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "ProjectForWitnesses2 error: <<<%s>>>" e.Message @@ -3449,7 +3449,7 @@ let ``Test ProjectForWitnesses3`` () = let cleanup, options = createOptionsAux [ ProjectForWitnesses3.fileSource1 ] ["--langversion:preview"] use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "ProjectForWitnesses3 error: <<<%s>>>" e.Message @@ -3480,7 +3480,7 @@ let ``Test ProjectForWitnesses3 GetWitnessPassingInfo`` () = let cleanup, options = ProjectForWitnesses3.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "ProjectForWitnesses3 error: <<<%s>>>" e.Message @@ -3543,7 +3543,7 @@ let ``Test ProjectForWitnesses4 GetWitnessPassingInfo`` () = let cleanup, options = ProjectForWitnesses4.createOptions() use _holder = cleanup let exprChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "ProjectForWitnesses4 error: <<<%s>>>" e.Message diff --git a/tests/service/FileSystemTests.fs b/tests/service/FileSystemTests.fs index a6dd94fcc45..95d78b36224 100644 --- a/tests/service/FileSystemTests.fs +++ b/tests/service/FileSystemTests.fs @@ -86,7 +86,7 @@ let ``FileSystem compilation test``() = OriginalLoadReferences = [] Stamp = None } - let results = checker.ParseAndCheckProject(projectOptions) |> Async.RunSynchronously + let results = checker.ParseAndCheckProject(projectOptions) |> Async.RunImmediate results.Diagnostics.Length |> shouldEqual 0 results.AssemblySignature.Entities.Count |> shouldEqual 2 diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index 21852fa1434..65be43d5a04 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -101,3 +101,6 @@ let ``Test ranges - global namespace`` () = let res = parseAndExtractRanges input3 printfn "Test ranges - global namespace, res = %A" res res |> shouldEqual [("Sample", ((4, 9), (4, 15)))] + +open System.Threading + diff --git a/tests/service/MultiProjectAnalysisTests.fs b/tests/service/MultiProjectAnalysisTests.fs index d8d41480664..e718b47b8ca 100644 --- a/tests/service/MultiProjectAnalysisTests.fs +++ b/tests/service/MultiProjectAnalysisTests.fs @@ -132,7 +132,7 @@ let u = Case1 3 [] let ``Test multi project 1 basic`` () = - let wholeProjectResults = checker.ParseAndCheckProject(MultiProject1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(MultiProject1.options) |> Async.RunImmediate [ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual ["MultiProject1"] @@ -145,9 +145,9 @@ let ``Test multi project 1 basic`` () = [] let ``Test multi project 1 all symbols`` () = - let p1A = checker.ParseAndCheckProject(Project1A.options) |> Async.RunSynchronously - let p1B = checker.ParseAndCheckProject(Project1B.options) |> Async.RunSynchronously - let mp = checker.ParseAndCheckProject(MultiProject1.options) |> Async.RunSynchronously + let p1A = checker.ParseAndCheckProject(Project1A.options) |> Async.RunImmediate + let p1B = checker.ParseAndCheckProject(Project1B.options) |> Async.RunImmediate + let mp = checker.ParseAndCheckProject(MultiProject1.options) |> Async.RunImmediate let x1FromProject1A = [ for s in p1A.GetAllUsesOfAllSymbols() do @@ -183,9 +183,9 @@ let ``Test multi project 1 all symbols`` () = [] let ``Test multi project 1 xmldoc`` () = - let p1A = checker.ParseAndCheckProject(Project1A.options) |> Async.RunSynchronously - let p1B = checker.ParseAndCheckProject(Project1B.options) |> Async.RunSynchronously - let mp = checker.ParseAndCheckProject(MultiProject1.options) |> Async.RunSynchronously + let p1A = checker.ParseAndCheckProject(Project1A.options) |> Async.RunImmediate + let p1B = checker.ParseAndCheckProject(Project1B.options) |> Async.RunImmediate + let mp = checker.ParseAndCheckProject(MultiProject1.options) |> Async.RunImmediate let symbolFromProject1A sym = [ for s in p1A.GetAllUsesOfAllSymbols() do @@ -327,7 +327,7 @@ let ``Test ManyProjectsStressTest basic`` () = let checker = ManyProjectsStressTest.makeCheckerForStressTest true - let wholeProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunImmediate [ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual ["JointProject"] @@ -341,7 +341,7 @@ let ``Test ManyProjectsStressTest cache too small`` () = let checker = ManyProjectsStressTest.makeCheckerForStressTest false - let wholeProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunImmediate [ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual ["JointProject"] @@ -356,8 +356,8 @@ let ``Test ManyProjectsStressTest all symbols`` () = let checker = ManyProjectsStressTest.makeCheckerForStressTest true for i in 1 .. 10 do printfn "stress test iteration %d (first may be slow, rest fast)" i - let projectsResults = [ for p in ManyProjectsStressTest.projects -> p, checker.ParseAndCheckProject(p.Options) |> Async.RunSynchronously ] - let jointProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunSynchronously + let projectsResults = [ for p in ManyProjectsStressTest.projects -> p, checker.ParseAndCheckProject(p.Options) |> Async.RunImmediate ] + let jointProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunImmediate let vsFromJointProject = [ for s in jointProjectResults.GetAllUsesOfAllSymbols() do @@ -441,13 +441,13 @@ let ``Test multi project symbols should pick up changes in dependent projects`` let proj1options = MultiProjectDirty1.getOptions() - let wholeProjectResults1 = checker.ParseAndCheckProject(proj1options) |> Async.RunSynchronously + let wholeProjectResults1 = checker.ParseAndCheckProject(proj1options) |> Async.RunImmediate count.Value |> shouldEqual 1 let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options) - |> Async.RunSynchronously + |> Async.RunImmediate count.Value |> shouldEqual 1 @@ -461,11 +461,11 @@ let ``Test multi project symbols should pick up changes in dependent projects`` let proj2options = MultiProjectDirty2.getOptions() - let wholeProjectResults2 = checker.ParseAndCheckProject(proj2options) |> Async.RunSynchronously + let wholeProjectResults2 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate count.Value |> shouldEqual 2 - let _ = checker.ParseAndCheckProject(proj2options) |> Async.RunSynchronously + let _ = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate count.Value |> shouldEqual 2 // cached @@ -500,12 +500,12 @@ let ``Test multi project symbols should pick up changes in dependent projects`` printfn "Old write time: '%A', ticks = %d" wt1 wt1.Ticks printfn "New write time: '%A', ticks = %d" wt2 wt2.Ticks - let wholeProjectResults1AfterChange1 = checker.ParseAndCheckProject(proj1options) |> Async.RunSynchronously + let wholeProjectResults1AfterChange1 = checker.ParseAndCheckProject(proj1options) |> Async.RunImmediate count.Value |> shouldEqual 3 let backgroundParseResults1AfterChange1, backgroundTypedParse1AfterChange1 = checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options) - |> Async.RunSynchronously + |> Async.RunImmediate let xSymbolUseAfterChange1 = backgroundTypedParse1AfterChange1.GetSymbolUseAtLocation(4, 4, "", ["x"]) xSymbolUseAfterChange1.IsSome |> shouldEqual true @@ -514,7 +514,7 @@ let ``Test multi project symbols should pick up changes in dependent projects`` printfn "Checking project 2 after first change, options = '%A'" proj2options - let wholeProjectResults2AfterChange1 = checker.ParseAndCheckProject(proj2options) |> Async.RunSynchronously + let wholeProjectResults2AfterChange1 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate count.Value |> shouldEqual 4 @@ -549,19 +549,19 @@ let ``Test multi project symbols should pick up changes in dependent projects`` printfn "New write time: '%A', ticks = %d" wt2b wt2b.Ticks count.Value |> shouldEqual 4 - let wholeProjectResults2AfterChange2 = checker.ParseAndCheckProject(proj2options) |> Async.RunSynchronously + let wholeProjectResults2AfterChange2 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate System.Threading.Thread.Sleep(1000) count.Value |> shouldEqual 6 // note, causes two files to be type checked, one from each project - let wholeProjectResults1AfterChange2 = checker.ParseAndCheckProject(proj1options) |> Async.RunSynchronously + let wholeProjectResults1AfterChange2 = checker.ParseAndCheckProject(proj1options) |> Async.RunImmediate count.Value |> shouldEqual 6 // the project is already checked let backgroundParseResults1AfterChange2, backgroundTypedParse1AfterChange2 = checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options) - |> Async.RunSynchronously + |> Async.RunImmediate let xSymbolUseAfterChange2 = backgroundTypedParse1AfterChange2.GetSymbolUseAtLocation(4, 4, "", ["x"]) xSymbolUseAfterChange2.IsSome |> shouldEqual true @@ -668,14 +668,14 @@ let v = Project2A.C().InternalMember // access an internal symbol [] let ``Test multi project2 errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project2B.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project2B.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "multi project2 error: <<<%s>>>" e.Message wholeProjectResults .Diagnostics.Length |> shouldEqual 0 - let wholeProjectResultsC = checker.ParseAndCheckProject(Project2C.options) |> Async.RunSynchronously + let wholeProjectResultsC = checker.ParseAndCheckProject(Project2C.options) |> Async.RunImmediate wholeProjectResultsC.Diagnostics.Length |> shouldEqual 1 @@ -683,9 +683,9 @@ let ``Test multi project2 errors`` () = [] let ``Test multi project 2 all symbols`` () = - let mpA = checker.ParseAndCheckProject(Project2A.options) |> Async.RunSynchronously - let mpB = checker.ParseAndCheckProject(Project2B.options) |> Async.RunSynchronously - let mpC = checker.ParseAndCheckProject(Project2C.options) |> Async.RunSynchronously + let mpA = checker.ParseAndCheckProject(Project2A.options) |> Async.RunImmediate + let mpB = checker.ParseAndCheckProject(Project2B.options) |> Async.RunImmediate + let mpC = checker.ParseAndCheckProject(Project2C.options) |> Async.RunImmediate // These all get the symbol in A, but from three different project compilations/checks let symFromA = @@ -761,7 +761,7 @@ let fizzBuzz = function [] let ``Test multi project 3 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "multi project 3 error: <<<%s>>>" e.Message @@ -770,10 +770,10 @@ let ``Test multi project 3 whole project errors`` () = [] let ``Test active patterns' XmlDocSig declared in referenced projects`` () = - let wholeProjectResults = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(MultiProject3.fileName1, MultiProject3.options) - |> Async.RunSynchronously + |> Async.RunImmediate let divisibleBySymbolUse = backgroundTypedParse1.GetSymbolUseAtLocation(7,7,"",["DivisibleBy"]) divisibleBySymbolUse.IsSome |> shouldEqual true @@ -803,12 +803,12 @@ let ``Test max memory gets triggered`` () = let checker = FSharpChecker.Create() let reached = ref false checker.MaxMemoryReached.Add (fun () -> reached := true) - let wholeProjectResults = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunImmediate reached.Value |> shouldEqual false checker.MaxMemory <- 0 - let wholeProjectResults2 = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunSynchronously + let wholeProjectResults2 = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunImmediate reached.Value |> shouldEqual true - let wholeProjectResults3 = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunSynchronously + let wholeProjectResults3 = checker.ParseAndCheckProject(MultiProject3.options) |> Async.RunImmediate reached.Value |> shouldEqual true @@ -816,176 +816,151 @@ let ``Test max memory gets triggered`` () = [] -#if NETCOREAPP -[] +let ``In-memory cross-project references to projects using generative type provides should fallback to on-disk references`` () = + // The type provider and its dependency are compiled as part of the solution build +#if DEBUG + let csDLL = __SOURCE_DIRECTORY__ + @"/../../artifacts/bin/TestTP/Debug/netstandard2.0/CSharp_Analysis.dll" + let tpDLL = __SOURCE_DIRECTORY__ + @"/../../artifacts/bin/TestTP/Debug/netstandard2.0/TestTP.dll" +#else + let csDLL = __SOURCE_DIRECTORY__ + @"/../../artifacts/bin/TestTP/Release/netstandard2.0/CSharp_Analysis.dll" + let tpDLL = __SOURCE_DIRECTORY__ + @"/../../artifacts/bin/TestTP/Release/netstandard2.0/TestTP.dll" #endif -let ``Type provider project references should not throw exceptions`` () = - let options = - {ProjectFileName = __SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/TypeProviderConsole.fsproj"; - ProjectId = None - SourceFiles = [|__SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/Program.fs"|]; - Stamp = None - OtherOptions = - [|yield "--simpleresolution"; - yield "--noframework"; - yield "--out:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/bin/Debug/TypeProviderConsole.exe"; - yield "--doc:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/bin/Debug/TypeProviderConsole.xml"; - yield "--subsystemversion:6.00"; - yield "--highentropyva+"; - yield "--fullpaths"; - yield "--flaterrors"; - yield "--target:exe"; - yield "--define:DEBUG"; - yield "--define:TRACE"; - yield "--debug+"; - yield "--optimize-"; - yield "--tailcalls-"; - yield "--debug:full"; - yield "--platform:anycpu"; - for r in mkStandardProjectReferences () do - yield "-r:" + r - yield "-r:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/TypeProviderLibrary.dll"|]; - ReferencedProjects = - [|FSharpReferencedProject.CreateFSharp(__SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/TypeProviderLibrary.dll", - {ProjectFileName = __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/TypeProviderLibrary.fsproj"; +// These two projects should have been built before the test executes + if not (File.Exists csDLL) then + failwith $"expect {csDLL} to exist" + if not (File.Exists tpDLL) then + failwith $"expect {tpDLL} to exist" + let optionsTestProject = + { ProjectFileName = __SOURCE_DIRECTORY__ + @"/data/TestProject/TestProject.fsproj" ProjectId = None - SourceFiles = [|__SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/Library1.fs"|]; + SourceFiles = + [| __SOURCE_DIRECTORY__ + @"/data/TestProject/TestProject.fs" |] Stamp = None OtherOptions = - [|yield "--simpleresolution"; - yield "--noframework"; - yield "--out:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/TypeProviderLibrary.dll"; - yield "--doc:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/bin/Debug/TypeProviderLibrary.xml"; - yield "--subsystemversion:6.00"; - yield "--highentropyva+"; - yield "--fullpaths"; - yield "--flaterrors"; - yield "--target:library"; - yield "--define:DEBUG"; - yield "--define:TRACE"; - yield "--debug+"; - yield "--optimize-"; - yield "--tailcalls-"; - yield "--debug:full"; - yield "--platform:anycpu"; + [|yield "--simpleresolution" + yield "--noframework" + yield "--out:" + __SOURCE_DIRECTORY__ + @"/../../artifacts/bin/TestProject/Debug/netstandard2.0/TestProject.dll" + yield "--doc:" + __SOURCE_DIRECTORY__ + @"/data/TestProject/bin/Debug/TestProject.xml" + yield "--subsystemversion:6.00" + yield "--highentropyva+" + yield "--fullpaths" + yield "--flaterrors" + yield "--target:library" + yield "--define:DEBUG" + yield "--define:TRACE" + yield "--debug+" + yield "--optimize-" + yield "--tailcalls-" + yield "--debug:full" + yield "--platform:anycpu" for r in mkStandardProjectReferences () do yield "-r:" + r - |]; - ReferencedProjects = [||]; - IsIncompleteTypeCheckEnvironment = false; - UseScriptResolutionRules = false; + // Make use of the type provider and reference its dependency + yield "-r:" + csDLL + yield "-r:" + tpDLL + |] + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false LoadTime = System.DateTime.Now - UnresolvedReferences = None; - OriginalLoadReferences = [] })|]; - IsIncompleteTypeCheckEnvironment = false; - UseScriptResolutionRules = false; - LoadTime = System.DateTime.Now - UnresolvedReferences = None; - OriginalLoadReferences = [];} - - //printfn "options: %A" options - let fileName = __SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/Program.fs" - let fileSource = FileSystem.OpenFileForReadShim(fileName).ReadAllText() - let fileParseResults, fileCheckAnswer = checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString fileSource, options) |> Async.RunSynchronously - let fileCheckResults = - match fileCheckAnswer with - | FSharpCheckFileAnswer.Succeeded(res) -> res - | res -> failwithf "Parsing did not finish... (%A)" res - - printfn "Parse Errors: %A" fileParseResults.Diagnostics - printfn "Errors: %A" fileCheckResults.Diagnostics - fileCheckResults.Diagnostics |> Array.exists (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) |> shouldEqual false - -//------------------------------------------------------------------------------------ + UnresolvedReferences = None + OriginalLoadReferences = [] } -[] -#if NETCOREAPP -[] -#else -[] -#endif -let ``Projects creating generated types should not utilize cross-project-references but should still analyze oK once project is built`` () = - let options = - {ProjectFileName = - __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TestConsole/TestConsole.fsproj"; + let optionsTestProject2 testProjectOutput = + {ProjectFileName = __SOURCE_DIRECTORY__ + @"/data/TestProject2/TestProject2.fsproj" ProjectId = None - SourceFiles = - [|__SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TestConsole/AssemblyInfo.fs"; - __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TestConsole/Program.fs"|]; + SourceFiles = [|__SOURCE_DIRECTORY__ + @"/data/TestProject2/TestProject2.fs"|] + Stamp = None OtherOptions = - [|yield "--simpleresolution"; - yield "--noframework"; - yield "--out:" + __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TestConsole/bin/Debug/TestConsole.exe"; - yield "--doc:" + __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TestConsole/bin/Debug/TestConsole.XML"; - yield "--subsystemversion:6.00"; - yield "--highentropyva+"; - yield "--fullpaths"; - yield "--flaterrors"; - yield "--target:exe"; - yield "--define:DEBUG"; - yield "--define:TRACE"; - yield "--debug+"; - yield "--optimize-"; - yield "--tailcalls-"; - yield "--debug:full"; - yield "--platform:anycpu"; - yield "-r:" + __SOURCE_DIRECTORY__ + @"/../../packages/FSharp.Configuration.1.3.0/lib/net45/FSharp.Configuration.dll"; + [|yield "--simpleresolution" + yield "--noframework" + yield "--out:" + __SOURCE_DIRECTORY__ + @"/data/TestProject2/bin/Debug/TestProject2.dll" + yield "--doc:" + __SOURCE_DIRECTORY__ + @"/data/TestProject2/bin/Debug/TestProject2.xml" + yield "--subsystemversion:6.00" + yield "--highentropyva+" + yield "--fullpaths" + yield "--flaterrors" + yield "--target:library" + yield "--define:DEBUG" + yield "--define:TRACE" + yield "--debug+" + yield "--optimize-" + yield "--tailcalls-" + yield "--debug:full" + yield "--platform:anycpu" for r in mkStandardProjectReferences () do yield "-r:" + r - yield "-r:" + __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll"|]; + // Make use of the type provider and reference its dependency + yield "-r:" + csDLL + yield "-r:" + tpDLL + // Make an in-memory reference to TestProject, which itself makes use of a type provider + // NOTE TestProject may not actually have been compiled + yield "-r:" + testProjectOutput|] ReferencedProjects = - [|FSharpReferencedProject.CreateFSharp(__SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll", - {ProjectFileName = - __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TypeProvidersBug/TypeProvidersBug.fsproj"; - ProjectId = None - SourceFiles = - [|__SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TypeProvidersBug/AssemblyInfo.fs"; - __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TypeProvidersBug/Library1.fs"|]; - OtherOptions = - [|yield "--simpleresolution"; - yield "--noframework"; - yield "--out:" + __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll"; - yield "--doc:" + __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.XML"; - yield "--subsystemversion:6.00"; - yield "--highentropyva+"; - yield "--fullpaths"; - yield "--flaterrors"; - yield "--target:library"; - yield "--define:DEBUG"; - yield "--define:TRACE"; - yield "--debug+"; - yield "--optimize-"; - yield "--tailcalls-"; - yield "--debug:full"; - yield "--platform:anycpu"; - yield "-r:" + __SOURCE_DIRECTORY__ + @"/../../packages/FSharp.Configuration.1.3.0/lib/net45/FSharp.Configuration.dll"; - for r in mkStandardProjectReferences () do - yield "-r:" + r |]; - ReferencedProjects = [||]; - IsIncompleteTypeCheckEnvironment = false; - UseScriptResolutionRules = false; - LoadTime = System.DateTime.Now - UnresolvedReferences = None; - OriginalLoadReferences = []; - Stamp = None})|]; - IsIncompleteTypeCheckEnvironment = false; - UseScriptResolutionRules = false; + [|FSharpReferencedProject.CreateFSharp(testProjectOutput, optionsTestProject )|] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false LoadTime = System.DateTime.Now - UnresolvedReferences = None; - Stamp = None; - OriginalLoadReferences = [] } - //printfn "options: %A" options - let fileName = __SOURCE_DIRECTORY__ + @"/data/TypeProvidersBug/TestConsole/Program.fs" - let fileSource = FileSystem.OpenFileForReadShim(fileName).ReadAllText() + UnresolvedReferences = None + OriginalLoadReferences = []} - let fileParseResults, fileCheckAnswer = checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString fileSource, options) |> Async.RunSynchronously - let fileCheckResults = - match fileCheckAnswer with - | FSharpCheckFileAnswer.Succeeded(res) -> res - | res -> failwithf "Parsing did not finish... (%A)" res - - printfn "Parse Errors: %A" fileParseResults.Diagnostics - printfn "Errors: %A" fileCheckResults.Diagnostics - fileCheckResults.Diagnostics |> Array.exists (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) |> shouldEqual false + //printfn "options: %A" options + begin + let fileName = __SOURCE_DIRECTORY__ + @"/data/TestProject/TestProject.fs" + let fileSource = FileSystem.OpenFileForReadShim(fileName).ReadAllText() + let fileParseResults, fileCheckAnswer = checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString fileSource, optionsTestProject) |> Async.RunImmediate + let fileCheckResults = + match fileCheckAnswer with + | FSharpCheckFileAnswer.Succeeded(res) -> res + | res -> failwithf "Parsing did not finish... (%A)" res + + printfn "Parse Diagnostics (TestProject): %A" fileParseResults.Diagnostics + printfn "Check Diagnostics (TestProject): %A" fileCheckResults.Diagnostics + fileCheckResults.Diagnostics |> Array.exists (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) |> shouldEqual false + end + + // Set up a TestProject2 using an in-memory reference to TestProject but where TestProject has not + // compiled to be on-disk. In this case, we expect an error, because TestProject uses a generative + // type provider, and in-memory cross-references to projects using generative type providers are + // not yet supported. + begin + let testProjectNotCompiledSimulatedOutput = __SOURCE_DIRECTORY__ + @"/DUMMY/TestProject.dll" + let options = optionsTestProject2 testProjectNotCompiledSimulatedOutput + let fileName = __SOURCE_DIRECTORY__ + @"/data/TestProject2/TestProject2.fs" + let fileSource = FileSystem.OpenFileForReadShim(fileName).ReadAllText() + let fileParseResults, fileCheckAnswer = checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString fileSource, options) |> Async.RunImmediate + let fileCheckResults = + match fileCheckAnswer with + | FSharpCheckFileAnswer.Succeeded(res) -> res + | res -> failwithf "Parsing did not finish... (%A)" res + + printfn "Parse Diagnostics (TestProject2 without compiled TestProject): %A" fileParseResults.Diagnostics + printfn "Check Diagnostics (TestProject2 without compiled TestProject): %A" fileCheckResults.Diagnostics + fileCheckResults.Diagnostics + |> Array.exists (fun diag -> + diag.Severity = FSharpDiagnosticSeverity.Error && + diag.Message.Contains("TestProject.dll")) + |> shouldEqual true + end + + // Do the same check with an in-memory reference to TestProject where TestProject exists + // compiled to disk. In this case, we expect no error, because even though TestProject uses a generative + // type provider, the in-memory cross-reference is ignored and an on-disk reference is used instead. + begin + let testProjectCompiledOutput = __SOURCE_DIRECTORY__ + @"/data/TestProject/netstandard2.0/TestProject.dll" + if not (File.Exists testProjectCompiledOutput) then + failwith $"expect {testProjectCompiledOutput} to exist" + let options = optionsTestProject2 testProjectCompiledOutput + let fileName = __SOURCE_DIRECTORY__ + @"/data/TestProject2/TestProject2.fs" + let fileSource = FileSystem.OpenFileForReadShim(fileName).ReadAllText() + let fileParseResults, fileCheckAnswer = checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString fileSource, options) |> Async.RunImmediate + let fileCheckResults = + match fileCheckAnswer with + | FSharpCheckFileAnswer.Succeeded(res) -> res + | res -> failwithf "Parsing did not finish... (%A)" res + + printfn "Parse Diagnostics (TestProject2 with compiled TestProject): %A" fileParseResults.Diagnostics + printfn "Check Diagnostics (TestProject2 with compiled TestProject): %A" fileCheckResults.Diagnostics + fileCheckResults.Diagnostics.Length |> shouldEqual 0 + end -//------------------------------------------------------------------------------------ diff --git a/tests/service/PerfTests.fs b/tests/service/PerfTests.fs index b947555dbb6..8e110624967 100644 --- a/tests/service/PerfTests.fs +++ b/tests/service/PerfTests.fs @@ -49,7 +49,7 @@ let ``Test request for parse and check doesn't check whole project`` () = let pB, tB = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "ParseFile()..." - let parseResults1 = checker.ParseFile(Project1.fileNames.[5], Project1.fileSources2.[5], Project1.parsingOptions) |> Async.RunSynchronously + let parseResults1 = checker.ParseFile(Project1.fileNames.[5], Project1.fileSources2.[5], Project1.parsingOptions) |> Async.RunImmediate let pC, tC = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount (pC - pB) |> shouldEqual 1 (tC - tB) |> shouldEqual 0 @@ -59,7 +59,7 @@ let ``Test request for parse and check doesn't check whole project`` () = backgroundCheckCount.Value |> shouldEqual 0 printfn "CheckFileInProject()..." - let checkResults1 = checker.CheckFileInProject(parseResults1, Project1.fileNames.[5], 0, Project1.fileSources2.[5], Project1.options) |> Async.RunSynchronously + let checkResults1 = checker.CheckFileInProject(parseResults1, Project1.fileNames.[5], 0, Project1.fileSources2.[5], Project1.options) |> Async.RunImmediate let pD, tD = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking background parsing happened...., backgroundParseCount.Value = %d" backgroundParseCount.Value @@ -78,7 +78,7 @@ let ``Test request for parse and check doesn't check whole project`` () = (tD - tC) |> shouldEqual 1 printfn "CheckFileInProject()..." - let checkResults2 = checker.CheckFileInProject(parseResults1, Project1.fileNames.[7], 0, Project1.fileSources2.[7], Project1.options) |> Async.RunSynchronously + let checkResults2 = checker.CheckFileInProject(parseResults1, Project1.fileNames.[7], 0, Project1.fileSources2.[7], Project1.options) |> Async.RunImmediate let pE, tE = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking no extra foreground parsing...., (pE - pD) = %d" (pE - pD) (pE - pD) |> shouldEqual 0 @@ -91,7 +91,7 @@ let ``Test request for parse and check doesn't check whole project`` () = printfn "ParseAndCheckFileInProject()..." // A subsequent ParseAndCheck of identical source code doesn't do any more anything - let checkResults2 = checker.ParseAndCheckFileInProject(Project1.fileNames.[7], 0, Project1.fileSources2.[7], Project1.options) |> Async.RunSynchronously + let checkResults2 = checker.ParseAndCheckFileInProject(Project1.fileNames.[7], 0, Project1.fileSources2.[7], Project1.options) |> Async.RunImmediate let pF, tF = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking no extra foreground parsing...." (pF - pE) |> shouldEqual 0 // note, no new parse of the file diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 4e6503797c6..05c75ff548b 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -97,7 +97,7 @@ let mmmm2 : M.CAbbrev = new M.CAbbrev() // note, these don't count as uses of C [] let ``Test project1 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate wholeProjectResults .Diagnostics.Length |> shouldEqual 2 wholeProjectResults.Diagnostics.[1].Message.Contains("Incomplete pattern matches on this expression") |> shouldEqual true // yes it does wholeProjectResults.Diagnostics.[1].ErrorNumber |> shouldEqual 25 @@ -111,7 +111,7 @@ let ``Test project1 whole project errors`` () = let ``Test project1 and make sure TcImports gets cleaned up`` () = let test () = - let (_, checkFileAnswer) = checker.ParseAndCheckFileInProject(Project1.fileName1, 0, Project1.fileSource1, Project1.options) |> Async.RunSynchronously + let (_, checkFileAnswer) = checker.ParseAndCheckFileInProject(Project1.fileName1, 0, Project1.fileSource1, Project1.options) |> Async.RunImmediate match checkFileAnswer with | FSharpCheckFileAnswer.Aborted -> failwith "should not be aborted" | FSharpCheckFileAnswer.Succeeded checkFileResults -> @@ -130,7 +130,7 @@ let ``Test project1 and make sure TcImports gets cleaned up`` () = [] let ``Test Project1 should have protected FullName and TryFullName return same results`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate let rec getFullNameComparisons (entity: FSharpEntity) = #if !NO_EXTENSIONTYPING seq { if not entity.IsProvided && entity.Accessibility.IsPublic then @@ -149,7 +149,7 @@ let ``Test Project1 should have protected FullName and TryFullName return same r [] [] let ``Test project1 should not throw exceptions on entities from referenced assemblies`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate let rec getAllBaseTypes (entity: FSharpEntity) = seq { if not entity.IsProvided && entity.Accessibility.IsPublic then if not entity.IsUnresolved then yield entity.BaseType @@ -166,7 +166,7 @@ let ``Test project1 should not throw exceptions on entities from referenced asse let ``Test project1 basic`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate set [ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual (set ["N"; "M"]) @@ -180,7 +180,7 @@ let ``Test project1 basic`` () = [] let ``Test project1 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities true wholeProjectResults.AssemblySignature.Entities for s in allSymbols do s.DeclarationLocation.IsSome |> shouldEqual true @@ -306,7 +306,7 @@ let ``Test project1 all symbols`` () = [] let ``Test project1 all symbols excluding compiler generated`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate let allSymbolsNoCompGen = allSymbolsInEntities false wholeProjectResults.AssemblySignature.Entities [ for x in allSymbolsNoCompGen -> x.ToString() ] |> shouldEqual @@ -323,10 +323,10 @@ let ``Test project1 all symbols excluding compiler generated`` () = let ``Test project1 xxx symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project1.fileName1, Project1.options) - |> Async.RunSynchronously + |> Async.RunImmediate let xSymbolUseOpt = backgroundTypedParse1.GetSymbolUseAtLocation(9,9,"",["xxx"]) let xSymbolUse = xSymbolUseOpt.Value @@ -347,7 +347,7 @@ let ``Test project1 xxx symbols`` () = [] let ``Test project1 all uses of all signature symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities true wholeProjectResults.AssemblySignature.Entities let allUsesOfAllSymbols = [ for s in allSymbols do @@ -415,7 +415,7 @@ let ``Test project1 all uses of all signature symbols`` () = [] let ``Test project1 all uses of all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate let allUsesOfAllSymbols = [ for s in wholeProjectResults.GetAllUsesOfAllSymbols() -> s.Symbol.DisplayName, s.Symbol.FullName, Project1.cleanFileName s.FileName, tupsZ s.Range, attribsOfSymbol s.Symbol ] @@ -554,18 +554,18 @@ let ``Test project1 all uses of all symbols`` () = let ``Test file explicit parse symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously - let parseResults1 = checker.ParseFile(Project1.fileName1, Project1.fileSource1, Project1.parsingOptions) |> Async.RunSynchronously - let parseResults2 = checker.ParseFile(Project1.fileName2, Project1.fileSource2, Project1.parsingOptions) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate + let parseResults1 = checker.ParseFile(Project1.fileName1, Project1.fileSource1, Project1.parsingOptions) |> Async.RunImmediate + let parseResults2 = checker.ParseFile(Project1.fileName2, Project1.fileSource2, Project1.parsingOptions) |> Async.RunImmediate let checkResults1 = checker.CheckFileInProject(parseResults1, Project1.fileName1, 0, Project1.fileSource1, Project1.options) - |> Async.RunSynchronously + |> Async.RunImmediate |> function FSharpCheckFileAnswer.Succeeded x -> x | _ -> failwith "unexpected aborted" let checkResults2 = checker.CheckFileInProject(parseResults2, Project1.fileName2, 0, Project1.fileSource2, Project1.options) - |> Async.RunSynchronously + |> Async.RunImmediate |> function FSharpCheckFileAnswer.Succeeded x -> x | _ -> failwith "unexpected aborted" let xSymbolUse2Opt = checkResults1.GetSymbolUseAtLocation(9,9,"",["xxx"]) @@ -600,18 +600,18 @@ let ``Test file explicit parse symbols`` () = let ``Test file explicit parse all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously - let parseResults1 = checker.ParseFile(Project1.fileName1, Project1.fileSource1, Project1.parsingOptions) |> Async.RunSynchronously - let parseResults2 = checker.ParseFile(Project1.fileName2, Project1.fileSource2, Project1.parsingOptions) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunImmediate + let parseResults1 = checker.ParseFile(Project1.fileName1, Project1.fileSource1, Project1.parsingOptions) |> Async.RunImmediate + let parseResults2 = checker.ParseFile(Project1.fileName2, Project1.fileSource2, Project1.parsingOptions) |> Async.RunImmediate let checkResults1 = checker.CheckFileInProject(parseResults1, Project1.fileName1, 0, Project1.fileSource1, Project1.options) - |> Async.RunSynchronously + |> Async.RunImmediate |> function FSharpCheckFileAnswer.Succeeded x -> x | _ -> failwith "unexpected aborted" let checkResults2 = checker.CheckFileInProject(parseResults2, Project1.fileName2, 0, Project1.fileSource2, Project1.options) - |> Async.RunSynchronously + |> Async.RunImmediate |> function FSharpCheckFileAnswer.Succeeded x -> x | _ -> failwith "unexpected aborted" let usesOfSymbols = checkResults1.GetAllUsesOfAllSymbolsInFile() @@ -684,7 +684,7 @@ let _ = GenericFunction(3, 4) [] let ``Test project2 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunImmediate wholeProjectResults .Diagnostics.Length |> shouldEqual 0 @@ -692,7 +692,7 @@ let ``Test project2 whole project errors`` () = let ``Test project2 basic`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunImmediate set [ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual (set ["M"]) @@ -704,7 +704,7 @@ let ``Test project2 basic`` () = [] let ``Test project2 all symbols in signature`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities true wholeProjectResults.AssemblySignature.Entities [ for x in allSymbols -> x.ToString() ] |> shouldEqual @@ -717,7 +717,7 @@ let ``Test project2 all symbols in signature`` () = [] let ``Test project2 all uses of all signature symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities true wholeProjectResults.AssemblySignature.Entities let allUsesOfAllSymbols = [ for s in allSymbols do @@ -757,7 +757,7 @@ let ``Test project2 all uses of all signature symbols`` () = [] let ``Test project2 all uses of all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project2.options) |> Async.RunImmediate let allUsesOfAllSymbols = [ for s in wholeProjectResults.GetAllUsesOfAllSymbols() -> s.Symbol.DisplayName, (if s.FileName = Project2.fileName1 then "file1" else "???"), tupsZ s.Range, attribsOfSymbol s.Symbol ] @@ -926,7 +926,7 @@ let getM (foo: IFoo) = foo.InterfaceMethod("d") [] let ``Test project3 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project3.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project3.options) |> Async.RunImmediate wholeProjectResults .Diagnostics.Length |> shouldEqual 0 @@ -934,7 +934,7 @@ let ``Test project3 whole project errors`` () = let ``Test project3 basic`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project3.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project3.options) |> Async.RunImmediate set [ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual (set ["M"]) @@ -947,7 +947,7 @@ let ``Test project3 basic`` () = [] let ``Test project3 all symbols in signature`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project3.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project3.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities false wholeProjectResults.AssemblySignature.Entities let results = [ for x in allSymbols -> x.ToString(), attribsOfSymbol x ] [("M", ["module"]); @@ -1031,7 +1031,7 @@ let ``Test project3 all symbols in signature`` () = [] let ``Test project3 all uses of all signature symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project3.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project3.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities false wholeProjectResults.AssemblySignature.Entities let allUsesOfAllSymbols = @@ -1294,13 +1294,13 @@ let inline twice(x : ^U, y : ^U) = x + y [] let ``Test project4 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunImmediate wholeProjectResults .Diagnostics.Length |> shouldEqual 0 [] let ``Test project4 basic`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunImmediate set [ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual (set ["M"]) @@ -1313,7 +1313,7 @@ let ``Test project4 basic`` () = [] let ``Test project4 all symbols in signature`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities false wholeProjectResults.AssemblySignature.Entities [ for x in allSymbols -> x.ToString() ] |> shouldEqual @@ -1323,7 +1323,7 @@ let ``Test project4 all symbols in signature`` () = [] let ``Test project4 all uses of all signature symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities false wholeProjectResults.AssemblySignature.Entities let allUsesOfAllSymbols = [ for s in allSymbols do @@ -1348,10 +1348,10 @@ let ``Test project4 all uses of all signature symbols`` () = [] let ``Test project4 T symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project4.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project4.fileName1, Project4.options) - |> Async.RunSynchronously + |> Async.RunImmediate let tSymbolUse2 = backgroundTypedParse1.GetSymbolUseAtLocation(4,19,"",["T"]) tSymbolUse2.IsSome |> shouldEqual true @@ -1467,7 +1467,7 @@ let parseNumeric str = [] let ``Test project5 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project5.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project5.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project5 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -1476,7 +1476,7 @@ let ``Test project5 whole project errors`` () = [] let ``Test project 5 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project5.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project5.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -1543,10 +1543,10 @@ let ``Test project 5 all symbols`` () = [] let ``Test complete active patterns' exact ranges from uses of symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project5.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project5.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project5.fileName1, Project5.options) - |> Async.RunSynchronously + |> Async.RunImmediate let oddSymbolUse = backgroundTypedParse1.GetSymbolUseAtLocation(11,8,"",["Odd"]) oddSymbolUse.IsSome |> shouldEqual true @@ -1610,10 +1610,10 @@ let ``Test complete active patterns' exact ranges from uses of symbols`` () = [] let ``Test partial active patterns' exact ranges from uses of symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project5.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project5.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project5.fileName1, Project5.options) - |> Async.RunSynchronously + |> Async.RunImmediate let floatSymbolUse = backgroundTypedParse1.GetSymbolUseAtLocation(22,10,"",["Float"]) floatSymbolUse.IsSome |> shouldEqual true @@ -1678,7 +1678,7 @@ let f () = [] let ``Test project6 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project6.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project6.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project6 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -1687,7 +1687,7 @@ let ``Test project6 whole project errors`` () = [] let ``Test project 6 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project6.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project6.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -1734,7 +1734,7 @@ let x2 = C.M(arg1 = 3, arg2 = 4, ?arg3 = Some 5) [] let ``Test project7 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project7.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project7.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project7 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -1743,7 +1743,7 @@ let ``Test project7 whole project errors`` () = [] let ``Test project 7 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project7.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project7.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -1795,7 +1795,7 @@ let x = [] let ``Test project8 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project8.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project8.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project8 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -1804,7 +1804,7 @@ let ``Test project8 whole project errors`` () = [] let ``Test project 8 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project8.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project8.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -1875,7 +1875,7 @@ let inline check< ^T when ^T : (static member IsInfinity : ^T -> bool)> (num: ^T [] let ``Test project9 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project9.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project9.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project9 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -1884,7 +1884,7 @@ let ``Test project9 whole project errors`` () = [] let ``Test project 9 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project9.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project9.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -1954,7 +1954,7 @@ C.M("http://goo", query = 1) [] let ``Test Project10 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project10.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project10.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project10 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -1963,7 +1963,7 @@ let ``Test Project10 whole project errors`` () = [] let ``Test Project10 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project10.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project10.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -1988,7 +1988,7 @@ let ``Test Project10 all symbols`` () = let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project10.fileName1, Project10.options) - |> Async.RunSynchronously + |> Async.RunImmediate let querySymbolUseOpt = backgroundTypedParse1.GetSymbolUseAtLocation(7,23,"",["query"]) @@ -2034,7 +2034,7 @@ let fff (x:System.Collections.Generic.Dictionary.Enumerator) = () [] let ``Test Project11 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project11.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project11.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project11 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2043,7 +2043,7 @@ let ``Test Project11 whole project errors`` () = [] let ``Test Project11 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project11.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project11.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2103,7 +2103,7 @@ let x2 = query { for i in 0 .. 100 do [] let ``Test Project12 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project12.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project12.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project12 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2112,7 +2112,7 @@ let ``Test Project12 whole project errors`` () = [] let ``Test Project12 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project12.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project12.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2170,7 +2170,7 @@ let x3 = new System.DateTime() [] let ``Test Project13 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project13.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project13.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project13 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2179,7 +2179,7 @@ let ``Test Project13 whole project errors`` () = [] let ``Test Project13 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project13.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project13.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2321,7 +2321,7 @@ let x2 = S(3) [] let ``Test Project14 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project14.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project14.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project14 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2330,7 +2330,7 @@ let ``Test Project14 whole project errors`` () = [] let ``Test Project14 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project14.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project14.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2389,7 +2389,7 @@ let f x = [] let ``Test Project15 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project15.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project15.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project15 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2398,7 +2398,7 @@ let ``Test Project15 whole project errors`` () = [] let ``Test Project15 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project15.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project15.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2476,7 +2476,7 @@ and G = Case1 | Case2 of int [] let ``Test Project16 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project16.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project16.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project16 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2485,7 +2485,7 @@ let ``Test Project16 whole project errors`` () = [] let ``Test Project16 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project16.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project16.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2582,13 +2582,13 @@ let ``Test Project16 all symbols`` () = let ``Test Project16 sig symbols are equal to impl symbols`` () = let checkResultsSig = - checker.ParseAndCheckFileInProject(Project16.sigFileName1, 0, Project16.sigFileSource1, Project16.options) |> Async.RunSynchronously + checker.ParseAndCheckFileInProject(Project16.sigFileName1, 0, Project16.sigFileSource1, Project16.options) |> Async.RunImmediate |> function | _, FSharpCheckFileAnswer.Succeeded(res) -> res | _ -> failwithf "Parsing aborted unexpectedly..." let checkResultsImpl = - checker.ParseAndCheckFileInProject(Project16.fileName1, 0, Project16.fileSource1, Project16.options) |> Async.RunSynchronously + checker.ParseAndCheckFileInProject(Project16.fileName1, 0, Project16.fileSource1, Project16.options) |> Async.RunImmediate |> function | _, FSharpCheckFileAnswer.Succeeded(res) -> res | _ -> failwithf "Parsing aborted unexpectedly..." @@ -2631,7 +2631,7 @@ let ``Test Project16 sig symbols are equal to impl symbols`` () = [] let ``Test Project16 sym locations`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project16.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project16.options) |> Async.RunImmediate let fmtLoc (mOpt: range option) = match mOpt with @@ -2693,7 +2693,7 @@ let ``Test Project16 sym locations`` () = let ``Test project16 DeclaringEntity`` () = let wholeProjectResults = checker.ParseAndCheckProject(Project16.options) - |> Async.RunSynchronously + |> Async.RunImmediate let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() for sym in allSymbolsUses do match sym.Symbol with @@ -2746,7 +2746,7 @@ let f3 (x: System.Exception) = x.HelpLink <- "" // check use of .NET setter prop [] let ``Test Project17 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project17.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project17.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project17 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2755,7 +2755,7 @@ let ``Test Project17 whole project errors`` () = [] let ``Test Project17 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project17.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project17.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2832,7 +2832,7 @@ let _ = list<_>.Empty [] let ``Test Project18 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project18.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project18.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project18 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2841,7 +2841,7 @@ let ``Test Project18 whole project errors`` () = [] let ``Test Project18 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project18.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project18.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2888,7 +2888,7 @@ let s = System.DayOfWeek.Monday [] let ``Test Project19 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project19.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project19.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project19 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2897,7 +2897,7 @@ let ``Test Project19 whole project errors`` () = [] let ``Test Project19 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project19.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project19.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -2962,7 +2962,7 @@ type A<'T>() = [] let ``Test Project20 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project20.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project20.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project20 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -2971,7 +2971,7 @@ let ``Test Project20 whole project errors`` () = [] let ``Test Project20 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project20.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project20.options) |> Async.RunImmediate let tSymbolUse = wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.find (fun su -> su.Range.StartLine = 5 && su.Symbol.ToString() = "generic parameter T") let tSymbol = tSymbolUse.Symbol @@ -3023,7 +3023,7 @@ let _ = { new IMyInterface with [] let ``Test Project21 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project21.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project21.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project21 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 2 @@ -3032,7 +3032,7 @@ let ``Test Project21 whole project errors`` () = [] let ``Test Project21 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project21.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project21.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -3098,7 +3098,7 @@ let f5 (x: int[,,]) = () // test a multi-dimensional array [] let ``Test Project22 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project22.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project22.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project22 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -3107,7 +3107,7 @@ let ``Test Project22 whole project errors`` () = [] let ``Test Project22 IList contents`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project22.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project22.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -3189,7 +3189,7 @@ let ``Test Project22 IList contents`` () = [] let ``Test Project22 IList properties`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project22.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project22.options) |> Async.RunImmediate let ilistTypeUse = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -3243,7 +3243,7 @@ module Setter = [] let ``Test Project23 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project23.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project23.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project23 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -3251,7 +3251,7 @@ let ``Test Project23 whole project errors`` () = [] let ``Test Project23 property`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project23.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project23.options) |> Async.RunImmediate let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() let classTypeUse = allSymbolsUses |> Array.find (fun su -> su.Symbol.DisplayName = "Class") @@ -3312,13 +3312,12 @@ let ``Test Project23 property`` () = ("Value", ["member"; "prop"; "extmem"]); ("set_Value", ["member"; "extmem"; "setter"]); ("x", []); - ("_arg1", ["compgen"]); ("Value", ["member"; "prop"; "extmem"])] [] let ``Test Project23 extension properties' getters/setters should refer to the correct declaring entities`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project23.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project23.options) |> Async.RunImmediate let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() let extensionMembers = allSymbolsUses |> Array.rev |> Array.filter (fun su -> su.Symbol.DisplayName = "Value") @@ -3414,17 +3413,17 @@ TypeWithProperties.StaticAutoPropGetSet <- 3 [] let ``Test Project24 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project24.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project24.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project24 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 [] let ``Test Project24 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project24.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project24.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project24.fileName1, Project24.options) - |> Async.RunSynchronously + |> Async.RunImmediate let allUses = backgroundTypedParse1.GetAllUsesOfAllSymbolsInFile() @@ -3528,10 +3527,10 @@ let ``Test Project24 all symbols`` () = [] let ``Test symbol uses of properties with both getters and setters`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project24.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project24.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project24.fileName1, Project24.options) - |> Async.RunSynchronously + |> Async.RunImmediate let getAllSymbolUses = backgroundTypedParse1.GetAllUsesOfAllSymbolsInFile() @@ -3666,7 +3665,7 @@ let _ = XmlProvider<"13">.GetSample() [] #endif let ``Test Project25 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project25.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project25.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project25 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -3676,10 +3675,10 @@ let ``Test Project25 whole project errors`` () = [] #endif let ``Test Project25 symbol uses of type-provided members`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project25.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project25.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project25.fileName1, Project25.options) - |> Async.RunSynchronously + |> Async.RunImmediate let allUses = backgroundTypedParse1.GetAllUsesOfAllSymbolsInFile() @@ -3735,10 +3734,10 @@ let ``Test Project25 symbol uses of type-provided members`` () = [] #endif let ``Test symbol uses of type-provided types`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project25.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project25.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project25.fileName1, Project25.options) - |> Async.RunSynchronously + |> Async.RunImmediate let getSampleSymbolUseOpt = backgroundTypedParse1.GetSymbolUseAtLocation(4,26,"",["XmlProvider"]) @@ -3755,10 +3754,10 @@ let ``Test symbol uses of type-provided types`` () = [] let ``Test symbol uses of fully-qualified records`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project25.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project25.options) |> Async.RunImmediate let backgroundParseResults1, backgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project25.fileName1, Project25.options) - |> Async.RunSynchronously + |> Async.RunImmediate let getSampleSymbolUseOpt = backgroundTypedParse1.GetSymbolUseAtLocation(7,11,"",["Record"]) @@ -3802,7 +3801,7 @@ type Class() = [] let ``Test Project26 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project26.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project26.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project26 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -3810,7 +3809,7 @@ let ``Test Project26 whole project errors`` () = [] let ``Test Project26 parameter symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project26.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project26.options) |> Async.RunImmediate let allUsesOfAllSymbols = wholeProjectResults.GetAllUsesOfAllSymbols() @@ -3891,13 +3890,13 @@ type CFooImpl() = [] let ``Test project27 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project27.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project27.options) |> Async.RunImmediate wholeProjectResults .Diagnostics.Length |> shouldEqual 0 [] let ``Test project27 all symbols in signature`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project27.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project27.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities true wholeProjectResults.AssemblySignature.Entities [ for x in allSymbols -> x.ToString(), attribsOfSymbol x ] |> shouldEqual @@ -3955,7 +3954,7 @@ type Use() = #if !NO_EXTENSIONTYPING [] let ``Test project28 all symbols in signature`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project28.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project28.options) |> Async.RunImmediate let allSymbols = allSymbolsInEntities true wholeProjectResults.AssemblySignature.Entities let xmlDocSigs = allSymbols @@ -4035,7 +4034,7 @@ let f (x: INotifyPropertyChanged) = failwith "" [] let ``Test project29 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project29.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project29.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project29 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -4043,7 +4042,7 @@ let ``Test project29 whole project errors`` () = [] let ``Test project29 event symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project29.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project29.options) |> Async.RunImmediate let objSymbol = wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.find (fun su -> su.Symbol.DisplayName = "INotifyPropertyChanged") let objEntity = objSymbol.Symbol :?> FSharpEntity @@ -4092,7 +4091,7 @@ type T() = let ``Test project30 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project30.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project30.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project30 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -4100,7 +4099,7 @@ let ``Test project30 whole project errors`` () = [] let ``Test project30 Format attributes`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project30.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project30.options) |> Async.RunImmediate let moduleSymbol = wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.find (fun su -> su.Symbol.DisplayName = "Module") let moduleEntity = moduleSymbol.Symbol :?> FSharpEntity @@ -4152,7 +4151,7 @@ let g = Console.ReadKey() let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) let ``Test project31 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project31 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -4163,7 +4162,7 @@ let ``Test project31 whole project errors`` () = #endif let ``Test project31 C# type attributes`` () = if not runningOnMono then - let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunImmediate let objSymbol = wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.find (fun su -> su.Symbol.DisplayName = "List") let objEntity = objSymbol.Symbol :?> FSharpEntity @@ -4185,7 +4184,7 @@ let ``Test project31 C# type attributes`` () = [] let ``Test project31 C# method attributes`` () = if not runningOnMono then - let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunImmediate let objSymbol = wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.find (fun su -> su.Symbol.DisplayName = "Console") let objEntity = objSymbol.Symbol :?> FSharpEntity @@ -4212,7 +4211,7 @@ let ``Test project31 C# method attributes`` () = #endif let ``Test project31 Format C# type attributes`` () = if not runningOnMono then - let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunImmediate let objSymbol = wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.find (fun su -> su.Symbol.DisplayName = "List") let objEntity = objSymbol.Symbol :?> FSharpEntity @@ -4229,7 +4228,7 @@ let ``Test project31 Format C# type attributes`` () = [] let ``Test project31 Format C# method attributes`` () = if not runningOnMono then - let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project31.options) |> Async.RunImmediate let objSymbol = wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.find (fun su -> su.Symbol.DisplayName = "Console") let objEntity = objSymbol.Symbol :?> FSharpEntity @@ -4276,7 +4275,7 @@ val func : int -> int [] let ``Test Project32 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project32.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project32.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project32 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -4284,10 +4283,10 @@ let ``Test Project32 whole project errors`` () = [] let ``Test Project32 should be able to find sig symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project32.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project32.options) |> Async.RunImmediate let _sigBackgroundParseResults1, sigBackgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project32.sigFileName1, Project32.options) - |> Async.RunSynchronously + |> Async.RunImmediate let sigSymbolUseOpt = sigBackgroundTypedParse1.GetSymbolUseAtLocation(4,5,"",["func"]) let sigSymbol = sigSymbolUseOpt.Value.Symbol @@ -4303,10 +4302,10 @@ let ``Test Project32 should be able to find sig symbols`` () = [] let ``Test Project32 should be able to find impl symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project32.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project32.options) |> Async.RunImmediate let _implBackgroundParseResults1, implBackgroundTypedParse1 = checker.GetBackgroundCheckResultsForFileInProject(Project32.fileName1, Project32.options) - |> Async.RunSynchronously + |> Async.RunImmediate let implSymbolUseOpt = implBackgroundTypedParse1.GetSymbolUseAtLocation(3,5,"",["func"]) let implSymbol = implSymbolUseOpt.Value.Symbol @@ -4343,7 +4342,7 @@ type System.Int32 with [] let ``Test Project33 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project33.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project33.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project33 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -4351,7 +4350,7 @@ let ``Test Project33 whole project errors`` () = [] let ``Test Project33 extension methods`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project33.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project33.options) |> Async.RunImmediate let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() let implModuleUse = allSymbolsUses |> Array.find (fun su -> su.Symbol.DisplayName = "Impl") @@ -4388,7 +4387,7 @@ module Dummy [] let ``Test Project34 whole project errors`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project34.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project34.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "Project34 error: <<<%s>>>" e.Message wholeProjectResults.Diagnostics.Length |> shouldEqual 0 @@ -4398,7 +4397,7 @@ let ``Test Project34 whole project errors`` () = [] #endif let ``Test project34 should report correct accessibility for System.Data.Listeners`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project34.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project34.options) |> Async.RunImmediate let rec getNestedEntities (entity: FSharpEntity) = seq { yield entity for e in entity.NestedEntities do @@ -4451,7 +4450,7 @@ type Test = [] let ``Test project35 CurriedParameterGroups should be available for nested functions`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project35.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project35.options) |> Async.RunImmediate let allSymbolUses = wholeProjectResults.GetAllUsesOfAllSymbols() let findByDisplayName name = Array.find (fun (su:FSharpSymbolUse) -> su.Symbol.DisplayName = name) @@ -4524,13 +4523,13 @@ module internal Project35b = let args2 = Array.append args [| "-r:notexist.dll" |] let options = checker.GetProjectOptionsFromCommandLineArgs (projPath, args2) #else - let options = checker.GetProjectOptionsFromScript(fileName1, fileSource1) |> Async.RunSynchronously |> fst + let options = checker.GetProjectOptionsFromScript(fileName1, fileSource1) |> Async.RunImmediate |> fst #endif [] let ``Test project35b Dependency files for ParseAndCheckFileInProject`` () = let checkFileResults = - checker.ParseAndCheckFileInProject(Project35b.fileName1, 0, Project35b.fileSource1, Project35b.options) |> Async.RunSynchronously + checker.ParseAndCheckFileInProject(Project35b.fileName1, 0, Project35b.fileSource1, Project35b.options) |> Async.RunImmediate |> function | _, FSharpCheckFileAnswer.Succeeded(res) -> res | _ -> failwithf "Parsing aborted unexpectedly..." @@ -4542,7 +4541,7 @@ let ``Test project35b Dependency files for ParseAndCheckFileInProject`` () = [] let ``Test project35b Dependency files for GetBackgroundCheckResultsForFileInProject`` () = - let _,checkFileResults = checker.GetBackgroundCheckResultsForFileInProject(Project35b.fileName1, Project35b.options) |> Async.RunSynchronously + let _,checkFileResults = checker.GetBackgroundCheckResultsForFileInProject(Project35b.fileName1, Project35b.options) |> Async.RunImmediate for d in checkFileResults.DependencyFiles do printfn "GetBackgroundCheckResultsForFileInProject dependency: %s" d checkFileResults.DependencyFiles |> Array.exists (fun s -> s.Contains "notexist.dll") |> shouldEqual true @@ -4551,7 +4550,7 @@ let ``Test project35b Dependency files for GetBackgroundCheckResultsForFileInPro [] let ``Test project35b Dependency files for check of project`` () = - let checkResults = checker.ParseAndCheckProject(Project35b.options) |> Async.RunSynchronously + let checkResults = checker.ParseAndCheckProject(Project35b.options) |> Async.RunImmediate for d in checkResults.DependencyFiles do printfn "ParseAndCheckProject dependency: %s" d checkResults.DependencyFiles |> Array.exists (fun s -> s.Contains "notexist.dll") |> shouldEqual true @@ -4592,7 +4591,7 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` () = let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) - |> Async.RunSynchronously + |> Async.RunImmediate wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.pick (fun (su:FSharpSymbolUse) -> @@ -4605,7 +4604,7 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` () = let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMemberThisValue`` () = let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) - let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunImmediate let declarations = let checkedFile = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] match checkedFile.Declarations.[0] with @@ -4642,7 +4641,7 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMe let ``Test project36 FSharpMemberOrFunctionOrValue.LiteralValue`` () = let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) - let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunImmediate let project36Module = wholeProjectResults.AssemblySignature.Entities.[0] let lit = project36Module.MembersFunctionsAndValues.[0] shouldEqual true (lit.LiteralValue.Value |> unbox |> (=) 1.) @@ -4710,7 +4709,7 @@ do () let ``Test project37 typeof and arrays in attribute constructor arguments`` () = let wholeProjectResults = checker.ParseAndCheckProject(Project37.options) - |> Async.RunSynchronously + |> Async.RunImmediate let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() for su in allSymbolsUses do match su.Symbol with @@ -4764,7 +4763,7 @@ let ``Test project37 typeof and arrays in attribute constructor arguments`` () = let ``Test project37 DeclaringEntity`` () = let wholeProjectResults = checker.ParseAndCheckProject(Project37.options) - |> Async.RunSynchronously + |> Async.RunImmediate let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() for sym in allSymbolsUses do match sym.Symbol with @@ -4852,7 +4851,7 @@ type A<'XX, 'YY>() = let ``Test project38 abstract slot information`` () = let wholeProjectResults = checker.ParseAndCheckProject(Project38.options) - |> Async.RunSynchronously + |> Async.RunImmediate let printAbstractSignature (s: FSharpAbstractSignature) = let printType (t: FSharpType) = hash t |> ignore // smoke test to check hash code doesn't loop @@ -4938,7 +4937,7 @@ let uses () = [] let ``Test project39 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project39.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project39.options) |> Async.RunImmediate let allSymbolUses = wholeProjectResults.GetAllUsesOfAllSymbols() let typeTextOfAllSymbolUses = [ for s in allSymbolUses do @@ -5013,7 +5012,7 @@ let g (x: C) = x.IsItAnA,x.IsItAnAMethod() [] let ``Test Project40 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project40.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project40.options) |> Async.RunImmediate let allSymbolUses = wholeProjectResults.GetAllUsesOfAllSymbols() let allSymbolUsesInfo = [ for s in allSymbolUses -> s.Symbol.DisplayName, tups s.Range, attribsOfSymbol s.Symbol ] allSymbolUsesInfo |> shouldEqual @@ -5083,7 +5082,7 @@ module M [] let ``Test project41 all symbols`` () = - let wholeProjectResults = checker.ParseAndCheckProject(Project41.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(Project41.options) |> Async.RunImmediate let allSymbolUses = wholeProjectResults.GetAllUsesOfAllSymbols() let allSymbolUsesInfo = [ for s in allSymbolUses do @@ -5169,13 +5168,13 @@ let test2() = test() [] let ``Test project42 to ensure cached checked results are invalidated`` () = let text2 = SourceText.ofString(FileSystem.OpenFileForReadShim(Project42.fileName2).ReadAllText()) - let checkedFile2 = checker.ParseAndCheckFileInProject(Project42.fileName2, text2.GetHashCode(), text2, Project42.options) |> Async.RunSynchronously + let checkedFile2 = checker.ParseAndCheckFileInProject(Project42.fileName2, text2.GetHashCode(), text2, Project42.options) |> Async.RunImmediate match checkedFile2 with | _, FSharpCheckFileAnswer.Succeeded(checkedFile2Results) -> Assert.IsEmpty(checkedFile2Results.Diagnostics) FileSystem.OpenFileForWriteShim(Project42.fileName1).Write("""module File1""") try - let checkedFile2Again = checker.ParseAndCheckFileInProject(Project42.fileName2, text2.GetHashCode(), text2, Project42.options) |> Async.RunSynchronously + let checkedFile2Again = checker.ParseAndCheckFileInProject(Project42.fileName2, text2.GetHashCode(), text2, Project42.options) |> Async.RunImmediate match checkedFile2Again with | _, FSharpCheckFileAnswer.Succeeded(checkedFile2AgainResults) -> Assert.IsNotEmpty(checkedFile2AgainResults.Diagnostics) // this should contain errors as File1 does not contain the function `test()` @@ -5212,7 +5211,7 @@ let ``add files with same name from different folders`` () = let projFileName = __SOURCE_DIRECTORY__ + "/data/samename/tempet.fsproj" let args = mkProjectCommandLineArgs ("test.dll", fileNames) let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) - let wholeProjectResults = checker.ParseAndCheckProject(options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(options) |> Async.RunImmediate let errors = wholeProjectResults.Diagnostics |> Array.filter (fun x -> x.Severity = FSharpDiagnosticSeverity.Error) @@ -5251,7 +5250,7 @@ let foo (a: Foo): bool = [] let ``Test typed AST for struct unions`` () = // See https://github.com/fsharp/FSharp.Compiler.Service/issues/756 let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) - let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(ProjectStructUnions.options) |> Async.RunSynchronously + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(ProjectStructUnions.options) |> Async.RunImmediate let declarations = let checkedFile = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] match checkedFile.Declarations.[0] with @@ -5291,7 +5290,7 @@ let x = (1 = 3.0) let ``Test line directives in foreground analysis`` () = // see https://github.com/Microsoft/visualfsharp/issues/3317 // In background analysis and normal compiler checking, the errors are reported w.r.t. the line directives - let wholeProjectResults = checker.ParseAndCheckProject(ProjectLineDirectives.options) |> Async.RunSynchronously + let wholeProjectResults = checker.ParseAndCheckProject(ProjectLineDirectives.options) |> Async.RunImmediate for e in wholeProjectResults.Diagnostics do printfn "ProjectLineDirectives wholeProjectResults error file: <<<%s>>>" e.Range.FileName @@ -5301,7 +5300,7 @@ let ``Test line directives in foreground analysis`` () = // see https://github.c // file, which is assumed to be in the editor, not the other files referred to by line directives. let checkResults1 = checker.ParseAndCheckFileInProject(ProjectLineDirectives.fileName1, 0, ProjectLineDirectives.fileSource1, ProjectLineDirectives.options) - |> Async.RunSynchronously + |> Async.RunImmediate |> function (_,FSharpCheckFileAnswer.Succeeded x) -> x | _ -> failwith "unexpected aborted" for e in checkResults1.Diagnostics do @@ -5331,7 +5330,7 @@ type A(i:int) = let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) let fileCheckResults = - keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunSynchronously + keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunImmediate |> function | _, FSharpCheckFileAnswer.Succeeded(res) -> res | _ -> failwithf "Parsing aborted unexpectedly..." @@ -5422,17 +5421,17 @@ type UseTheThings(i:int) = let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) let fileCheckResults = - keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunSynchronously + keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunImmediate |> function | _, FSharpCheckFileAnswer.Succeeded(res) -> res | _ -> failwithf "Parsing aborted unexpectedly..." - //let symbolUses = fileCheckResults.GetAllUsesOfAllSymbolsInFile() |> Async.RunSynchronously |> Array.indexed + //let symbolUses = fileCheckResults.GetAllUsesOfAllSymbolsInFile() |> Async.RunImmediate |> Array.indexed // Fragments used to check hash codes: //(snd symbolUses.[42]).Symbol.IsEffectivelySameAs((snd symbolUses.[37]).Symbol) //(snd symbolUses.[42]).Symbol.GetEffectivelySameAsHash() //(snd symbolUses.[37]).Symbol.GetEffectivelySameAsHash() let lines = FileSystem.OpenFileForReadShim(fileName1).ReadAllLines() - let unusedOpens = UnusedOpens.getUnusedOpens (fileCheckResults, (fun i -> lines.[i-1])) |> Async.RunSynchronously + let unusedOpens = UnusedOpens.getUnusedOpens (fileCheckResults, (fun i -> lines.[i-1])) |> Async.RunImmediate let unusedOpensData = [ for uo in unusedOpens -> tups uo, lines.[uo.StartLine-1] ] let expected = [(((4, 5), (4, 23)), "open System.Collections // unused"); @@ -5495,17 +5494,17 @@ type UseTheThings(i:int) = let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) let fileCheckResults = - keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunSynchronously + keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunImmediate |> function | _, FSharpCheckFileAnswer.Succeeded(res) -> res | _ -> failwithf "Parsing aborted unexpectedly..." - //let symbolUses = fileCheckResults.GetAllUsesOfAllSymbolsInFile() |> Async.RunSynchronously |> Array.indexed + //let symbolUses = fileCheckResults.GetAllUsesOfAllSymbolsInFile() |> Async.RunImmediate |> Array.indexed // Fragments used to check hash codes: //(snd symbolUses.[42]).Symbol.IsEffectivelySameAs((snd symbolUses.[37]).Symbol) //(snd symbolUses.[42]).Symbol.GetEffectivelySameAsHash() //(snd symbolUses.[37]).Symbol.GetEffectivelySameAsHash() let lines = FileSystem.OpenFileForReadShim(fileName1).ReadAllLines() - let unusedOpens = UnusedOpens.getUnusedOpens (fileCheckResults, (fun i -> lines.[i-1])) |> Async.RunSynchronously + let unusedOpens = UnusedOpens.getUnusedOpens (fileCheckResults, (fun i -> lines.[i-1])) |> Async.RunImmediate let unusedOpensData = [ for uo in unusedOpens -> tups uo, lines.[uo.StartLine-1] ] let expected = [(((4, 5), (4, 23)), "open System.Collections // unused"); @@ -5576,12 +5575,12 @@ module M2 = let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) let fileCheckResults = - keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunSynchronously + keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunImmediate |> function | _, FSharpCheckFileAnswer.Succeeded(res) -> res | _ -> failwithf "Parsing aborted unexpectedly..." let lines = FileSystem.OpenFileForReadShim(fileName1).ReadAllLines() - let unusedOpens = UnusedOpens.getUnusedOpens (fileCheckResults, (fun i -> lines.[i-1])) |> Async.RunSynchronously + let unusedOpens = UnusedOpens.getUnusedOpens (fileCheckResults, (fun i -> lines.[i-1])) |> Async.RunImmediate let unusedOpensData = [ for uo in unusedOpens -> tups uo, lines.[uo.StartLine-1] ] let expected = [(((2, 5), (2, 23)), "open System.Collections // unused"); @@ -5653,10 +5652,10 @@ let checkContentAsScript content = let tempDir = Path.GetTempPath() let scriptFullPath = Path.Combine(tempDir, scriptName) let sourceText = SourceText.ofString content - let projectOptions, _ = checker.GetProjectOptionsFromScript(scriptFullPath, sourceText, useSdkRefs = true, assumeDotNetFramework = false) |> Async.RunSynchronously + let projectOptions, _ = checker.GetProjectOptionsFromScript(scriptFullPath, sourceText, useSdkRefs = true, assumeDotNetFramework = false) |> Async.RunImmediate let parseOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions - let parseResults = checker.ParseFile(scriptFullPath, sourceText, parseOptions) |> Async.RunSynchronously - let checkResults = checker.CheckFileInProject(parseResults, scriptFullPath, 0, sourceText, projectOptions) |> Async.RunSynchronously + let parseResults = checker.ParseFile(scriptFullPath, sourceText, parseOptions) |> Async.RunImmediate + let checkResults = checker.CheckFileInProject(parseResults, scriptFullPath, 0, sourceText, projectOptions) |> Async.RunImmediate match checkResults with | FSharpCheckFileAnswer.Aborted -> failwith "no check results" | FSharpCheckFileAnswer.Succeeded r -> r diff --git a/tests/service/ScriptOptionsTests.fs b/tests/service/ScriptOptionsTests.fs index 96205ab5734..6e096319404 100644 --- a/tests/service/ScriptOptionsTests.fs +++ b/tests/service/ScriptOptionsTests.fs @@ -31,7 +31,7 @@ let ``can generate options for different frameworks regardless of execution envi let tempFile = Path.Combine(path, file) let (_, errors) = checker.GetProjectOptionsFromScript(tempFile, SourceText.ofString scriptSource, assumeDotNetFramework = assumeNetFx, useSdkRefs = useSdk, otherFlags = flags) - |> Async.RunSynchronously + |> Async.RunImmediate match errors with | [] -> () | errors -> failwithf "Error while parsing script with assumeDotNetFramework:%b, useSdkRefs:%b, and otherFlags:%A:\n%A" assumeNetFx useSdk flags errors @@ -43,7 +43,7 @@ let ``all default assembly references are system assemblies``(assumeNetFx, useSd let tempFile = Path.GetTempFileName() + ".fsx" let (options, errors) = checker.GetProjectOptionsFromScript(tempFile, SourceText.ofString scriptSource, assumeDotNetFramework = assumeNetFx, useSdkRefs = useSdkRefs, otherFlags = flags) - |> Async.RunSynchronously + |> Async.RunImmediate match errors with | [] -> () | errors -> failwithf "Error while parsing script with assumeNetFx:%b, useSdkRefs:%b, and otherFlags:%A:\n%A" assumeNetFx useSdkRefs flags errors @@ -76,7 +76,7 @@ let ``sdk dir with dodgy global json gives warning``() = FileSystem.OpenFileForWriteShim(globalJsonPath).Write("""{ "sdk": { "version": "666.666.666" } }""") let (options, errors) = checker.GetProjectOptionsFromScript(tempFile, SourceText.ofString scriptSource, assumeDotNetFramework = false, useSdkRefs = true, otherFlags = [| |]) - |> Async.RunSynchronously + |> Async.RunImmediate FileSystem.FileDeleteShim(globalJsonPath) match errors with | [] -> diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 6bffb542035..763155401a6 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -1225,4 +1225,65 @@ module ParsedHashDirective = ]) ])) -> Assert.AreEqual("40", v) assertRange (1, 8) (1, 16) m + | _ -> Assert.Fail "Could not get valid AST" + +module Lambdas = + [] + let ``Lambda with two parameters gives correct body`` () = + let parseResults = + getParseResults + "fun a b -> x" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.DoExpr( + expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Named _], SynExpr.Ident(ident))) + ) + ]) ])) -> + Assert.AreEqual("x", ident.idText) + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``Lambda with wild card parameter gives correct body`` () = + let parseResults = + getParseResults + "fun a _ b -> x" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.DoExpr( + expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Wild _; SynPat.Named _], SynExpr.Ident(ident))) + ) + ]) ])) -> + Assert.AreEqual("x", ident.idText) + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``Lambda with tuple parameter with wild card gives correct body`` () = + let parseResults = + getParseResults + "fun a (b, _) c -> x" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.DoExpr( + expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Paren(SynPat.Tuple _,_); SynPat.Named _], SynExpr.Ident(ident))) + ) + ]) ])) -> + Assert.AreEqual("x", ident.idText) + | _ -> Assert.Fail "Could not get valid AST" + + [] + let ``Lambda with wild card that returns a lambda gives correct body`` () = + let parseResults = + getParseResults + "fun _ -> fun _ -> x" + + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + SynModuleDecl.DoExpr( + expr = SynExpr.Lambda(parsedData = Some([SynPat.Wild _], SynExpr.Lambda(parsedData = Some([SynPat.Wild _], SynExpr.Ident(ident))))) + ) + ]) ])) -> + Assert.AreEqual("x", ident.idText) | _ -> Assert.Fail "Could not get valid AST" \ No newline at end of file diff --git a/tests/service/data/TestProject/Library.fs b/tests/service/data/TestProject/TestProject.fs similarity index 95% rename from tests/service/data/TestProject/Library.fs rename to tests/service/data/TestProject/TestProject.fs index b4d48c00f14..ebf81723cb0 100644 --- a/tests/service/data/TestProject/Library.fs +++ b/tests/service/data/TestProject/TestProject.fs @@ -44,3 +44,8 @@ type Class1() = member this.X41 = T().ClassProperty() member this.X42 = T().ClassAutoProperty() member this.X43 = T().ClassStaticAutoProperty() + +type T2 = GeneratedWithConstructor.Provided.GenerativeProvider<3> + +type Class2() = + member this.X1 = T2() diff --git a/tests/service/data/TestProject/TestProject.fsproj b/tests/service/data/TestProject/TestProject.fsproj index b58304907f3..3a7fc90b94c 100644 --- a/tests/service/data/TestProject/TestProject.fsproj +++ b/tests/service/data/TestProject/TestProject.fsproj @@ -1,71 +1,23 @@  - - - - Debug - AnyCPU - 2.0 - ed64425e-b549-439a-b105-6c921a81f31a - Library - TestProject - TestProject - v4.5 - true - TestProject - - - true - full - false - false - bin\Debug\ - DEBUG;TRACE - 3 - bin\Debug\TestProject.xml - - - pdbonly - true - true - bin\Release\ - TRACE - 3 - bin\Release\TestProject.xml - - - - - ..\..\..\..\packages\Microsoft.Portable.FSharp.Core.10.1.0\lib\profiles\net40\FSharp.Core.dll - false - - - ..\TestTP\TestTP.dll - - - - - - - - - - - - CSharp_Analysis - {887630a3-4b1d-40ea-b8b3-2d842e9c40db} - True - - - - - - - - ..\..\..\..\packages\NUnit\lib\nunit.framework.dll - True - True - - - - - \ No newline at end of file + + + + netstandard2.0 + true + $(OtherFlags) --nowarn:3390 --nowarn:3218 + .\ + + + + + + + + + + + ..\..\..\..\artifacts\bin\TestTP\$(Configuration)\netstandard2.0\TestTP.dll + + + + diff --git a/tests/service/data/TestProject/netstandard2.0/README.md b/tests/service/data/TestProject/netstandard2.0/README.md new file mode 100644 index 00000000000..682cea0b9c1 --- /dev/null +++ b/tests/service/data/TestProject/netstandard2.0/README.md @@ -0,0 +1,10 @@ + + +The file in this directory is a checked-in copy of the output of + + msbuild VisualFSharp.sln + msbuild C:\GitHub\dsyme\fsharp\tests\service\data\TestProject + +Note "TestProject" is not part of VisualFSharp.sln to prevent problems where the type provider DLL gets locked when +using VisualFSharp.sln. + diff --git a/tests/service/data/TestProject/netstandard2.0/TestProject.dll b/tests/service/data/TestProject/netstandard2.0/TestProject.dll new file mode 100644 index 00000000000..388a9cb27a2 Binary files /dev/null and b/tests/service/data/TestProject/netstandard2.0/TestProject.dll differ diff --git a/tests/service/data/TypeProvidersBug/TestConsole/AssemblyInfo.fs b/tests/service/data/TestProject2/AssemblyInfo.fs similarity index 83% rename from tests/service/data/TypeProvidersBug/TestConsole/AssemblyInfo.fs rename to tests/service/data/TestProject2/AssemblyInfo.fs index 7f520374db6..5c62ae5770c 100644 --- a/tests/service/data/TypeProvidersBug/TestConsole/AssemblyInfo.fs +++ b/tests/service/data/TestProject2/AssemblyInfo.fs @@ -1,4 +1,4 @@ -namespace TestConsole.AssemblyInfo +namespace TestProject.AssemblyInfo open System.Reflection open System.Runtime.CompilerServices @@ -7,12 +7,12 @@ open System.Runtime.InteropServices // General Information about an assembly is controlled through the following // set of attributes. Change these attribute values to modify the information // associated with an assembly. -[] +[] [] [] [] -[] -[] +[] +[] [] [] @@ -22,7 +22,7 @@ open System.Runtime.InteropServices [] // The following GUID is for the ID of the typelib if this project is exposed to COM -[] +[] // Version information for an assembly consists of the following four values: // diff --git a/tests/service/data/TestProject2/TestProject2.fs b/tests/service/data/TestProject2/TestProject2.fs new file mode 100644 index 00000000000..b1e2fb49a91 --- /dev/null +++ b/tests/service/data/TestProject2/TestProject2.fs @@ -0,0 +1,7 @@ +namespace TestProject2 + +// This is code in one project making use of another project that uses a generative type provider + +type Class1() = + member this.X1 = TestProject.T() + member this.X2 = TestProject.T2() diff --git a/tests/service/data/TestProject2/TestProject2.fsproj b/tests/service/data/TestProject2/TestProject2.fsproj new file mode 100644 index 00000000000..0d01be5217b --- /dev/null +++ b/tests/service/data/TestProject2/TestProject2.fsproj @@ -0,0 +1,23 @@ + + + + + netstandard2.0 + true + $(OtherFlags) --nowarn:3390 --nowarn:3218 + + + + + + + + + + + + ..\..\..\..\artifacts\bin\TestTP\$(Configuration)\netstandard2.0\TestTP.dll + + + + diff --git a/tests/service/data/TestTP/ProvidedTypes.fs b/tests/service/data/TestTP/ProvidedTypes.fs index 943ef8ea567..a4fc1908ef0 100644 --- a/tests/service/data/TestTP/ProvidedTypes.fs +++ b/tests/service/data/TestTP/ProvidedTypes.fs @@ -1,2736 +1,15993 @@ -#nowarn "40" -#nowarn "52" -// Based on code for the F# 3.0 Developer Preview release of September 2011, -// Copyright (c) Microsoft Corporation 2005-2012. -// This sample code is provided "as is" without warranty of any kind. -// We disclaim all warranties, either express or implied, including the -// warranties of merchantability and fitness for a particular purpose. - -// This file contains a set of helper types and methods for providing types in an implementation -// of ITypeProvider. - -// This code has been modified and is appropriate for use in conjunction with the F# 3.0, F# 3.1, and F# 3.1.1 releases +// Copyright (c) Microsoft Corporation, Tomas Petricek, Gustavo Guerra, and other contributors +// +// Licensed under the MIT License see LICENSE.md in this project namespace ProviderImplementation.ProvidedTypes +#nowarn "1182" + +// This file contains a set of helper types and methods for providing types in an implementation +// of ITypeProvider. +// +// This code has been modified and is appropriate for use in conjunction with the F# 4.x releases + open System -open System.Text -open System.IO open System.Reflection -open System.Reflection.Emit -open System.Linq.Expressions open System.Collections.Generic +open System.Diagnostics + +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns open Microsoft.FSharp.Core.CompilerServices -type E = Quotations.Expr -module P = Quotations.Patterns -module ES = Quotations.ExprShape -module DP = Quotations.DerivedPatterns +[] +module Utils = + let K x = (fun () -> x) + let isNull x = match x with null -> true | _ -> false + let isNil x = match x with [] -> true | _ -> false + let isEmpty x = match x with [| |] -> true | _ -> false + + module Option = + let toObj x = match x with None -> null | Some x -> x + let ofObj x = match x with null -> None | _ -> Some x + + [] + type StructOption<'T> (hasValue: bool, value: 'T) = + member __.IsNone = not hasValue + member __.HasValue = hasValue + member __.Value = value + override __.ToString() = if hasValue then match box value with null -> "null" | x -> x.ToString() else "" + + type uoption<'T> = StructOption<'T> + + let UNone<'T> = uoption<'T>(false, Unchecked.defaultof<'T>) + let USome v = uoption<'T>(true, v) + let (|UNone|USome|) (x:uoption<'T>) = if x.HasValue then USome x.Value else UNone + + module StructOption = + let toObj x = match x with UNone -> null | USome x -> x + let ofObj x = match x with null -> UNone | x -> USome x + + + let tryFindMulti k map = match Map.tryFind k map with Some res -> res | None -> [| |] + + let splitNameAt (nm:string) idx = + if idx < 0 then failwith "splitNameAt: idx < 0"; + let last = nm.Length - 1 + if idx > last then failwith "splitNameAt: idx > last"; + (nm.Substring(0, idx)), + (if idx < last then nm.Substring (idx+1, last - idx) else "") + + let splitILTypeName (nm:string) = + match nm.LastIndexOf '.' with + | -1 -> UNone, nm + | idx -> let a, b = splitNameAt nm idx in USome a, b + + let joinILTypeName (nspace: string uoption) (nm:string) = + match nspace with + | UNone -> nm + | USome ns -> ns + "." + nm + + let lengthsEqAndForall2 (arr1: 'T1[]) (arr2: 'T2[]) f = + (arr1.Length = arr2.Length) && + (arr1, arr2) ||> Array.forall2 f + + /// General implementation of .Equals(Type) logic for System.Type over symbol types. You can use this with other types too. + let rec eqTypes (ty1: Type) (ty2: Type) = + if Object.ReferenceEquals(ty1, ty2) then true + elif ty1.IsGenericTypeDefinition then ty2.IsGenericTypeDefinition && ty1.Equals(ty2) + elif ty1.IsGenericType then ty2.IsGenericType && not ty2.IsGenericTypeDefinition && eqTypes (ty1.GetGenericTypeDefinition()) (ty2.GetGenericTypeDefinition()) && lengthsEqAndForall2 (ty1.GetGenericArguments()) (ty2.GetGenericArguments()) eqTypes + elif ty1.IsArray then ty2.IsArray && ty1.GetArrayRank() = ty2.GetArrayRank() && eqTypes (ty1.GetElementType()) (ty2.GetElementType()) + elif ty1.IsPointer then ty2.IsPointer && eqTypes (ty1.GetElementType()) (ty2.GetElementType()) + elif ty1.IsByRef then ty2.IsByRef && eqTypes (ty1.GetElementType()) (ty2.GetElementType()) + else ty1.Equals(box ty2) + + /// General implementation of .Equals(obj) logic for System.Type over symbol types. You can use this with other types too. + let eqTypeObj (this: Type) (other: obj) = + match other with + | :? Type as otherTy -> eqTypes this otherTy + | _ -> false -type internal ExpectedStackState = - | Empty = 1 - | Address = 2 - | Value = 3 + /// General implementation of .IsAssignableFrom logic for System.Type, regardless of specific implementation + let isAssignableFrom (ty: Type) (otherTy: Type) = + eqTypes ty otherTy || (match otherTy.BaseType with null -> false | bt -> ty.IsAssignableFrom(bt)) + + /// General implementation of .IsSubclassOf logic for System.Type, regardless of specific implementation, with + /// an added hack to make the types usable with the FSharp.Core quotations implementation + let isSubclassOf (this: Type) (otherTy: Type) = + (this.IsClass && otherTy.IsClass && this.IsAssignableFrom(otherTy) && not (eqTypes this otherTy)) + // The FSharp.Core implementation of FSharp.Quotations uses + // let isDelegateType (typ:Type) = + // if typ.IsSubclassOf(typeof) then ... + // This means even target type definitions must process the case where ``otherTy`` is typeof rather than + // the System.Delegate type for the target assemblies. + || (match this.BaseType with + | null -> false + | bt -> bt.FullName = "System.MulticastDelegate" && (let fn = otherTy.FullName in fn = "System.Delegate" || fn = "System.MulticastDelegate" )) + + + /// General implementation of .GetAttributeFlags logic for System.Type over symbol types + let getAttributeFlagsImpl (ty: Type) = + if ty.IsGenericType then ty.GetGenericTypeDefinition().Attributes + elif ty.IsArray then typeof.Attributes + elif ty.IsPointer then typeof.MakePointerType().Attributes + elif ty.IsByRef then typeof.MakeByRefType().Attributes + else Unchecked.defaultof + + let bindAll = BindingFlags.DeclaredOnly ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static ||| BindingFlags.Instance + let bindCommon = BindingFlags.DeclaredOnly ||| BindingFlags.Static ||| BindingFlags.Instance ||| BindingFlags.Public + let bindSome isStatic = BindingFlags.DeclaredOnly ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| (if isStatic then BindingFlags.Static else BindingFlags.Instance) + let inline hasFlag e flag = (e &&& flag) <> enum 0 + + let memberBinds isType (bindingFlags: BindingFlags) isStatic isPublic = + (isType || hasFlag bindingFlags (if isStatic then BindingFlags.Static else BindingFlags.Instance)) && + ((hasFlag bindingFlags BindingFlags.Public && isPublic) || (hasFlag bindingFlags BindingFlags.NonPublic && not isPublic)) + + [] + type ITypeBuilder = + abstract MakeGenericType: Type * Type[] -> Type + abstract MakeArrayType: Type -> Type + abstract MakeRankedArrayType: Type*int -> Type + abstract MakeByRefType: Type -> Type + abstract MakePointerType: Type -> Type + + let defaultTypeBuilder = + { new ITypeBuilder with + member __.MakeGenericType(typeDef, args) = typeDef.MakeGenericType(args) + member __.MakeArrayType(typ) = typ.MakeArrayType() + member __.MakeRankedArrayType(typ, rank) = typ.MakeArrayType(rank) + member __.MakeByRefType(typ) = typ.MakeByRefType() + member __.MakePointerType(typ) = typ.MakePointerType() } + + let rec instType (typeBuilder: ITypeBuilder) inst (ty:Type) = + if isNull ty then null + elif ty.IsGenericType then + let typeArgs = Array.map (instType typeBuilder inst) (ty.GetGenericArguments()) + typeBuilder.MakeGenericType(ty.GetGenericTypeDefinition(), typeArgs) + elif ty.HasElementType then + let ety : Type = instType typeBuilder inst (ty.GetElementType()) + if ty.IsArray then + let rank = ty.GetArrayRank() + if rank = 1 then typeBuilder.MakeArrayType(ety) + else typeBuilder.MakeRankedArrayType(ety,rank) + elif ty.IsPointer then typeBuilder.MakePointerType(ety) + elif ty.IsByRef then typeBuilder.MakeByRefType(ety) + else ty + elif ty.IsGenericParameter then + let pos = ty.GenericParameterPosition + let (inst1: Type[], inst2: Type[]) = inst + if pos < inst1.Length then inst1.[pos] + elif pos < inst1.Length + inst2.Length then inst2.[pos - inst1.Length] + else ty + else ty -[] -module internal Misc = - - let TypeBuilderInstantiationType = - let runningOnMono = try System.Type.GetType("Mono.Runtime") <> null with e -> false - let typeName = if runningOnMono then "System.Reflection.MonoGenericClass" else "System.Reflection.Emit.TypeBuilderInstantiation" - typeof.Assembly.GetType(typeName) - - let GetTypeFromHandleMethod = typeof.GetMethod("GetTypeFromHandle") - let LanguagePrimitivesType = typedefof>.Assembly.GetType("Microsoft.FSharp.Core.LanguagePrimitives") - let ParseInt32Method = LanguagePrimitivesType.GetMethod "ParseInt32" - let DecimalConstructor = typeof.GetConstructor([| typeof; typeof; typeof; typeof; typeof |]) - let DateTimeConstructor = typeof.GetConstructor([| typeof; typeof |]) - let DateTimeOffsetConstructor = typeof.GetConstructor([| typeof; typeof |]) - let TimeSpanConstructor = typeof.GetConstructor([|typeof|]) - let isEmpty s = s = ExpectedStackState.Empty - let isAddress s = s = ExpectedStackState.Address - - let nonNull str x = if x=null then failwith ("Null in " + str) else x - - let notRequired opname item = - let msg = sprintf "The operation '%s' on item '%s' should not be called on provided type, member or parameter" opname item - System.Diagnostics.Debug.Assert (false, msg) - raise (System.NotSupportedException msg) - - let mkParamArrayCustomAttributeData() = -#if FX_NO_CUSTOMATTRIBUTEDATA - { new IProvidedCustomAttributeData with -#else - { new CustomAttributeData() with -#endif - member _.Constructor = typeof.GetConstructors().[0] - member _.ConstructorArguments = upcast [| |] - member _.NamedArguments = upcast [| |] } - -#if FX_NO_CUSTOMATTRIBUTEDATA - let CustomAttributeTypedArgument(ty,v) = - { new IProvidedCustomAttributeTypedArgument with - member x.ArgumentType = ty - member x.Value = v } - let CustomAttributeNamedArgument(memb,arg:IProvidedCustomAttributeTypedArgument) = - { new IProvidedCustomAttributeNamedArgument with - member x.MemberInfo = memb - member x.ArgumentType = arg.ArgumentType - member x.TypedValue = arg } - type CustomAttributeData = Microsoft.FSharp.Core.CompilerServices.IProvidedCustomAttributeData -#endif - let mkEditorHideMethodsCustomAttributeData() = -#if FX_NO_CUSTOMATTRIBUTEDATA - { new IProvidedCustomAttributeData with -#else - { new CustomAttributeData() with -#endif - member _.Constructor = typeof.GetConstructors().[0] - member _.ConstructorArguments = upcast [| |] - member _.NamedArguments = upcast [| |] } + let mutable token = 0 + let genToken() = token <- token + 1; token + /// Internal code of .NET expects the obj[] returned by GetCustomAttributes to be an Attribute[] even in the case of empty arrays + let emptyAttributes = (([| |]: Attribute[]) |> box |> unbox) + + type Attributes<'T when 'T :> Attribute>() = + static let empty = ([| |] : 'T []) |> box |> unbox + static member Empty() = empty + + type Attributes = + static member CreateEmpty (typ : Type) = + let gtype = typedefof>.MakeGenericType([| typ |]) + // the Empty member is private due to the presence of the fsi file + // but when getting rid of the fsi for diagnostic purpose, it becomes public + // this is the reason for having both Public and NonPublic flag bellow + let gmethod = gtype.GetMethod("Empty", BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) + gmethod.Invoke(null, [||]) :?> obj array + + let nonNull str x = if isNull x then failwithf "Null in '%s', stacktrace = '%s'" str Environment.StackTrace else x + let nonNone str x = match x with None -> failwithf "No value has been specified for '%s', stacktrace = '%s'" str Environment.StackTrace | Some v -> v + let patchOption v f = match v with None -> f() | Some _ -> failwithf "Already patched, stacktrace = '%s'" Environment.StackTrace + + let notRequired this opname item = + let msg = sprintf "The operation '%s' on item '%s' should not be called on provided type, member or parameter of type '%O'. Stack trace:\n%s" opname item (this.GetType()) Environment.StackTrace + Debug.Assert (false, msg) + raise (NotSupportedException msg) + + + let adjustTypeAttributes isNested attrs = + let visibilityAttributes = + match attrs &&& TypeAttributes.VisibilityMask with + | TypeAttributes.Public when isNested -> TypeAttributes.NestedPublic + | TypeAttributes.NotPublic when isNested -> TypeAttributes.NestedAssembly + | TypeAttributes.NestedPublic when not isNested -> TypeAttributes.Public + | TypeAttributes.NestedAssembly + | TypeAttributes.NestedPrivate + | TypeAttributes.NestedFamORAssem + | TypeAttributes.NestedFamily + | TypeAttributes.NestedFamANDAssem when not isNested -> TypeAttributes.NotPublic + | a -> a + (attrs &&& ~~~TypeAttributes.VisibilityMask) ||| visibilityAttributes + + + type ConstructorInfo with + member m.GetDefinition() = + let dty = m.DeclaringType + if (dty.IsGenericType && not dty.IsGenericTypeDefinition) then + // Search through the original type definition looking for the one with a matching metadata token + let gdty = dty.GetGenericTypeDefinition() + gdty.GetConstructors(bindAll) + |> Array.tryFind (fun c -> c.MetadataToken = m.MetadataToken) + |> function Some m2 -> m2 | None -> failwithf "couldn't rebind %O::%s back to generic constructor definition via metadata token, stacktrace = '%s'" m.DeclaringType m.Name Environment.StackTrace + else + m + + type PropertyInfo with + member m.GetDefinition() = + let dty = m.DeclaringType + if (dty.IsGenericType && not dty.IsGenericTypeDefinition) then + // Search through the original type definition looking for the one with a matching metadata token + let gdty = dty.GetGenericTypeDefinition() + gdty.GetProperties(bindAll) + |> Array.tryFind (fun c -> c.MetadataToken = m.MetadataToken) + |> function Some m2 -> m2 | None -> failwithf "couldn't rebind %O::%s back to generic property definition via metadata token" m.DeclaringType m.Name + else + m + + member p.IsStatic = p.CanRead && p.GetGetMethod(true).IsStatic || p.CanWrite && p.GetSetMethod(true).IsStatic + member p.IsPublic = p.CanRead && p.GetGetMethod(true).IsPublic || p.CanWrite && p.GetSetMethod(true).IsPublic + + type EventInfo with + member m.GetDefinition() = + let dty = m.DeclaringType + if (dty.IsGenericType && not dty.IsGenericTypeDefinition) then + // Search through the original type definition looking for the one with a matching metadata token + let gdty = dty.GetGenericTypeDefinition() + gdty.GetEvents(bindAll) + |> Array.tryFind (fun c -> c.MetadataToken = m.MetadataToken) + |> function Some m2 -> m2 | None -> failwithf "couldn't rebind %O::%s back to generic event definition via metadata token" m.DeclaringType m.Name + else + m + + member p.IsStatic = p.GetAddMethod().IsStatic || p.GetRemoveMethod().IsStatic + member p.IsPublic = p.GetAddMethod().IsPublic || p.GetRemoveMethod().IsPublic + + type FieldInfo with + member m.GetDefinition() = + let dty = m.DeclaringType + if (dty.IsGenericType && not dty.IsGenericTypeDefinition) then + // Search through the original type definition looking for the one with a matching metadata token + let gdty = dty.GetGenericTypeDefinition() + gdty.GetFields(bindAll) + |> Array.tryFind (fun c -> c.MetadataToken = m.MetadataToken) + |> function Some m2 -> m2 | None -> failwithf "couldn't rebind %O::%s back to generic event definition via metadata token" m.DeclaringType m.Name + else + m + + type MethodInfo with + member m.GetDefinition() = + let dty = m.DeclaringType + if (m.IsGenericMethod && not dty.IsGenericType) then m.GetGenericMethodDefinition() + elif (m.IsGenericMethod && (not m.IsGenericMethodDefinition || not dty.IsGenericTypeDefinition)) || + (dty.IsGenericType && not dty.IsGenericTypeDefinition) then + + // Search through ALL the methods on the original type definition looking for the one + // with a matching metadata token + let gdty = if dty.IsGenericType then dty.GetGenericTypeDefinition() else dty + gdty.GetMethods(bindSome m.IsStatic) + |> Array.tryFind (fun c -> c.MetadataToken = m.MetadataToken) + |> function Some m2 -> m2 | None -> failwithf "couldn't rebind generic instantiation of %O::%s back to generic method definition via metadata token" m.DeclaringType m.Name - let mkAllowNullLiteralCustomAttributeData value = -#if FX_NO_CUSTOMATTRIBUTEDATA - { new IProvidedCustomAttributeData with -#else - { new CustomAttributeData() with -#endif - member _.Constructor = typeof.GetConstructors().[0] - member _.ConstructorArguments = upcast [| CustomAttributeTypedArgument(typeof, value) |] - member _.NamedArguments = upcast [| |] } + else + m - /// This makes an xml doc attribute w.r.t. an amortized computation of an xml doc string. - /// It is important that the text of the xml doc only get forced when poking on the ConstructorArguments - /// for the CustomAttributeData object. - let mkXmlDocCustomAttributeDataLazy(lazyText: Lazy) = -#if FX_NO_CUSTOMATTRIBUTEDATA - { new IProvidedCustomAttributeData with -#else - { new CustomAttributeData() with -#endif - member _.Constructor = typeof.GetConstructors().[0] - member _.ConstructorArguments = upcast [| CustomAttributeTypedArgument(typeof, lazyText.Force()) |] - member _.NamedArguments = upcast [| |] } + let canBindConstructor (bindingFlags: BindingFlags) (c: ConstructorInfo) = + hasFlag bindingFlags BindingFlags.Public && c.IsPublic || hasFlag bindingFlags BindingFlags.NonPublic && not c.IsPublic - let mkXmlDocCustomAttributeData(s:string) = mkXmlDocCustomAttributeDataLazy (lazy s) + let canBindMethod (bindingFlags: BindingFlags) (c: MethodInfo) = + hasFlag bindingFlags BindingFlags.Public && c.IsPublic || hasFlag bindingFlags BindingFlags.NonPublic && not c.IsPublic - let mkDefinitionLocationAttributeCustomAttributeData(line:int,column:int,filePath:string) = -#if FX_NO_CUSTOMATTRIBUTEDATA - { new IProvidedCustomAttributeData with -#else - { new CustomAttributeData() with -#endif - member _.Constructor = typeof.GetConstructors().[0] - member _.ConstructorArguments = upcast [| |] - member _.NamedArguments = - upcast [| CustomAttributeNamedArgument(typeof.GetProperty("FilePath"), CustomAttributeTypedArgument(typeof, filePath)); - CustomAttributeNamedArgument(typeof.GetProperty("Line"), CustomAttributeTypedArgument(typeof, line)) ; - CustomAttributeNamedArgument(typeof.GetProperty("Column"), CustomAttributeTypedArgument(typeof, column)) - |] } - let mkObsoleteAttributeCustomAttributeData(message:string, isError: bool) = -#if FX_NO_CUSTOMATTRIBUTEDATA - { new IProvidedCustomAttributeData with -#else - { new CustomAttributeData() with -#endif - member _.Constructor = typeof.GetConstructors() |> Array.find (fun x -> x.GetParameters().Length = 1) - member _.ConstructorArguments = upcast [|CustomAttributeTypedArgument(typeof, message) ; CustomAttributeTypedArgument(typeof, isError) |] - member _.NamedArguments = upcast [| |] } + let canBindProperty (bindingFlags: BindingFlags) (c: PropertyInfo) = + hasFlag bindingFlags BindingFlags.Public && c.IsPublic || hasFlag bindingFlags BindingFlags.NonPublic && not c.IsPublic - type CustomAttributesImpl() = - let customAttributes = ResizeArray() - let mutable hideObjectMethods = false - let mutable nonNullable = false - let mutable obsoleteMessage = None - let mutable xmlDocDelayed = None - let mutable xmlDocAlwaysRecomputed = None - let mutable hasParamArray = false + let canBindField (bindingFlags: BindingFlags) (c: FieldInfo) = + hasFlag bindingFlags BindingFlags.Public && c.IsPublic || hasFlag bindingFlags BindingFlags.NonPublic && not c.IsPublic - // XML doc text that we only compute once, if any. This must _not_ be forced until the ConstructorArguments - // property of the custom attribute is foced. - let xmlDocDelayedText = - lazy - (match xmlDocDelayed with None -> assert false; "" | Some f -> f()) + let canBindEvent (bindingFlags: BindingFlags) (c: EventInfo) = + hasFlag bindingFlags BindingFlags.Public && c.IsPublic || hasFlag bindingFlags BindingFlags.NonPublic && not c.IsPublic - // Custom atttributes that we only compute once - let customAttributesOnce = - lazy - [| if hideObjectMethods then yield mkEditorHideMethodsCustomAttributeData() - if nonNullable then yield mkAllowNullLiteralCustomAttributeData false - match xmlDocDelayed with None -> () | Some _ -> customAttributes.Add(mkXmlDocCustomAttributeDataLazy xmlDocDelayedText) - match obsoleteMessage with None -> () | Some s -> customAttributes.Add(mkObsoleteAttributeCustomAttributeData s) - if hasParamArray then yield mkParamArrayCustomAttributeData() - yield! customAttributes |] - - member _.AddDefinitionLocation(line:int,column:int,filePath:string) = customAttributes.Add(mkDefinitionLocationAttributeCustomAttributeData(line, column, filePath)) - member _.AddObsolete(message : string, isError) = obsoleteMessage <- Some (message,isError) - member _.HasParamArray with get() = hasParamArray and set(v) = hasParamArray <- v - member _.AddXmlDocComputed xmlDocFunction = xmlDocAlwaysRecomputed <- Some xmlDocFunction - member _.AddXmlDocDelayed xmlDocFunction = xmlDocDelayed <- Some xmlDocFunction - member _.AddXmlDoc xmlDoc = xmlDocDelayed <- Some (fun () -> xmlDoc) - member _.HideObjectMethods with set v = hideObjectMethods <- v - member _.NonNullable with set v = nonNullable <- v - member _.AddCustomAttribute(attribute) = customAttributes.Add(attribute) - member _.GetCustomAttributesData() = - [| yield! customAttributesOnce.Force() - match xmlDocAlwaysRecomputed with None -> () | Some f -> customAttributes.Add(mkXmlDocCustomAttributeData (f())) |] - :> IList<_> - - let transExpr isGenerated q = - let rec trans q = - match q with - // convert NewTuple to the call to the constructor of the Tuple type (only for generated types) - | Quotations.Patterns.NewTuple(items) when isGenerated -> - let rec mkCtor args ty = - let ctor, restTyOpt = Reflection.FSharpValue.PreComputeTupleConstructorInfo ty - match restTyOpt with - | None -> Quotations.Expr.NewObject(ctor, List.map trans args) - | Some restTy -> - let curr = [for a in Seq.take 7 args -> trans a] - let rest = List.ofSeq (Seq.skip 7 args) - Quotations.Expr.NewObject(ctor, curr @ [mkCtor rest restTy]) - let tys = [| for e in items -> e.Type |] - let tupleTy = Reflection.FSharpType.MakeTupleType tys - trans (mkCtor items tupleTy) - // convert TupleGet to the chain of PropertyGet calls (only for generated types) - | Quotations.Patterns.TupleGet(e, i) when isGenerated -> - let rec mkGet ty i (e : Quotations.Expr) = - let pi, restOpt = Reflection.FSharpValue.PreComputeTuplePropertyInfo(ty, i) - let propGet = Quotations.Expr.PropertyGet(e, pi) - match restOpt with - | None -> propGet - | Some (restTy, restI) -> mkGet restTy restI propGet - trans (mkGet e.Type i (trans e)) - | Quotations.Patterns.Value(value, ty) -> - if value <> null then - let tyOfValue = value.GetType() - transValue(value, tyOfValue, ty) - else q - // Eliminate F# property gets to method calls - | Quotations.Patterns.PropertyGet(obj,propInfo,args) -> - match obj with - | None -> trans (Quotations.Expr.Call(propInfo.GetGetMethod(),args)) - | Some o -> trans (Quotations.Expr.Call(trans o,propInfo.GetGetMethod(),args)) - // Eliminate F# property sets to method calls - | Quotations.Patterns.PropertySet(obj,propInfo,args,v) -> - match obj with - | None -> trans (Quotations.Expr.Call(propInfo.GetSetMethod(),args@[v])) - | Some o -> trans (Quotations.Expr.Call(trans o,propInfo.GetSetMethod(),args@[v])) - // Eliminate F# function applications to FSharpFunc<_,_>.Invoke calls - | Quotations.Patterns.Application(f,e) -> - trans (Quotations.Expr.Call(trans f, f.Type.GetMethod "Invoke", [ e ]) ) - | Quotations.Patterns.NewUnionCase(ci, es) -> - trans (Quotations.Expr.Call(Reflection.FSharpValue.PreComputeUnionConstructorInfo ci, es) ) - | Quotations.Patterns.NewRecord(ci, es) -> - trans (Quotations.Expr.NewObject(Reflection.FSharpValue.PreComputeRecordConstructorInfo ci, es) ) - | Quotations.Patterns.UnionCaseTest(e,uc) -> - let tagInfo = Reflection.FSharpValue.PreComputeUnionTagMemberInfo uc.DeclaringType - let tagExpr = - match tagInfo with - | :? PropertyInfo as tagProp -> - trans (Quotations.Expr.PropertyGet(e,tagProp) ) - | :? MethodInfo as tagMeth -> - if tagMeth.IsStatic then trans (Quotations.Expr.Call(tagMeth, [e])) - else trans (Quotations.Expr.Call(e,tagMeth,[])) - | _ -> failwith "unreachable: unexpected result from PreComputeUnionTagMemberInfo" - let tagNumber = uc.Tag - trans <@@ (%%(tagExpr) : int) = tagNumber @@> + let canBindNestedType (bindingFlags: BindingFlags) (c: Type) = + hasFlag bindingFlags BindingFlags.Public && c.IsNestedPublic || hasFlag bindingFlags BindingFlags.NonPublic && not c.IsNestedPublic - // Explicitly handle weird byref variables in lets (used to populate out parameters), since the generic handlers can't deal with byrefs - | Quotations.Patterns.Let(v,vexpr,bexpr) when v.Type.IsByRef -> + // We only want to return source types "typeof" values as _target_ types in one very specific location due to a limitation in the + // F# compiler code for multi-targeting. + let ImportProvidedMethodBaseAsILMethodRef_OnStack_HACK() = + let rec loop i = + if i > 9 then + false + else + let frame = StackFrame(i, true) + match frame.GetMethod() with + | null -> loop (i+1) + | m -> m.Name = "ImportProvidedMethodBaseAsILMethodRef" || loop (i+1) + loop 1 + +//-------------------------------------------------------------------------------- +// UncheckedQuotations + +// The FSharp.Core 2.0 - 4.0 (4.0.0.0 - 4.4.0.0) quotations implementation is overly strict in that it doesn't allow +// generation of quotations for cross-targeted FSharp.Core. Below we define a series of Unchecked methods +// implemented via reflection hacks to allow creation of various nodes when using a cross-targets FSharp.Core and +// mscorlib.dll. +// +// - Most importantly, these cross-targeted quotations can be provided to the F# compiler by a type provider. +// They are generally produced via the AssemblyReplacer.fs component through a process of rewriting design-time quotations that +// are not cross-targeted. +// +// - However, these quotation values are a bit fragile. Using existing FSharp.Core.Quotations.Patterns +// active patterns on these quotation nodes will generally work correctly. But using ExprShape.RebuildShapeCombination +// on these new nodes will not succed, nor will operations that build new quotations such as Expr.Call. +// Instead, use the replacement provided in this module. +// +// - Likewise, some operations in these quotation values like "expr.Type" may be a bit fragile, possibly returning non cross-targeted types in +// the result. However those operations are not used by the F# compiler. +[] +module UncheckedQuotations = - // the binding must have leaves that are themselves variables (due to the limited support for byrefs in expressions) - // therefore, we can perform inlining to translate this to a form that can be compiled - inlineByref v vexpr bexpr + let qTy = typeof.Assembly.GetType("Microsoft.FSharp.Quotations.ExprConstInfo") + assert (not (isNull qTy)) - // Eliminate recursive let bindings (which are unsupported by the type provider API) to regular let bindings - | Quotations.Patterns.LetRecursive(bindings, expr) -> - // This uses a "lets and sets" approach, converting something like - // let rec even = function - // | 0 -> true - // | n -> odd (n-1) - // and odd = function - // | 0 -> false - // | n -> even (n-1) - // X - // to something like - // let even = ref Unchecked.defaultof<_> - // let odd = ref Unchecked.defaultof<_> - // even := function - // | 0 -> true - // | n -> !odd (n-1) - // odd := function - // | 0 -> false - // | n -> !even (n-1) - // X' - // where X' is X but with occurrences of even/odd substituted by !even and !odd (since now even and odd are references) - // Translation relies on typedefof<_ ref> - does this affect ability to target different runtime and design time environments? - let vars = List.map fst bindings - let vars' = vars |> List.map (fun v -> Quotations.Var(v.Name, typedefof<_ ref>.MakeGenericType(v.Type))) - - // init t generates the equivalent of <@ ref Unchecked.defaultof @> - let init (t:Type) = - let r = match <@ ref 1 @> with Quotations.Patterns.Call(None, r, [_]) -> r | _ -> failwith "Extracting MethodInfo from <@ 1 @> failed" - let d = match <@ Unchecked.defaultof<_> @> with Quotations.Patterns.Call(None, d, []) -> d | _ -> failwith "Extracting MethodInfo from <@ Unchecked.defaultof<_> @> failed" - Quotations.Expr.Call(r.GetGenericMethodDefinition().MakeGenericMethod(t), [Quotations.Expr.Call(d.GetGenericMethodDefinition().MakeGenericMethod(t),[])]) - - // deref v generates the equivalent of <@ !v @> - // (so v's type must be ref) - let deref (v:Quotations.Var) = - let m = match <@ !(ref 1) @> with Quotations.Patterns.Call(None, m, [_]) -> m | _ -> failwith "Extracting MethodInfo from <@ !(ref 1) @> failed" - let tyArgs = v.Type.GetGenericArguments() - Quotations.Expr.Call(m.GetGenericMethodDefinition().MakeGenericMethod(tyArgs), [Quotations.Expr.Var v]) - - // substitution mapping a variable v to the expression <@ !v' @> using the corresponding new variable v' of ref type - let subst = - let map = - vars' - |> List.map deref - |> List.zip vars - |> Map.ofList - fun v -> Map.tryFind v map - - let expr' = expr.Substitute(subst) - - // maps variables to new variables - let varDict = List.zip vars vars' |> dict - - // given an old variable v and an expression e, returns a quotation like <@ v' := e @> using the corresponding new variable v' of ref type - let setRef (v:Quotations.Var) e = - let m = match <@ (ref 1) := 2 @> with Quotations.Patterns.Call(None, m, [_;_]) -> m | _ -> failwith "Extracting MethodInfo from <@ (ref 1) := 2 @> failed" - Quotations.Expr.Call(m.GetGenericMethodDefinition().MakeGenericMethod(v.Type), [Quotations.Expr.Var varDict.[v]; e]) - - // Something like - // <@ - // v1 := e1' - // v2 := e2' - // ... - // expr' - // @> - // Note that we must substitute our new variable dereferences into the bound expressions - let body = - bindings - |> List.fold (fun b (v,e) -> Quotations.Expr.Sequential(setRef v (e.Substitute subst), b)) expr' - - // Something like - // let v1 = ref Unchecked.defaultof - // let v2 = ref Unchecked.defaultof - // ... - // body - vars - |> List.fold (fun b v -> Quotations.Expr.Let(varDict.[v], init v.Type, b)) body - |> trans + let pTy = typeof.Assembly.GetType("Microsoft.FSharp.Quotations.PatternsModule") + assert (not (isNull pTy)) - // Handle the generic cases - | Quotations.ExprShape.ShapeLambda(v,body) -> - Quotations.Expr.Lambda(v, trans body) - | Quotations.ExprShape.ShapeCombination(comb,args) -> - Quotations.ExprShape.RebuildShapeCombination(comb,List.map trans args) - | Quotations.ExprShape.ShapeVar _ -> q - and inlineByref v vexpr bexpr = - match vexpr with - | Quotations.Patterns.Sequential(e',vexpr') -> - (* let v = (e'; vexpr') in bexpr => e'; let v = vexpr' in bexpr *) - Quotations.Expr.Sequential(e', inlineByref v vexpr' bexpr) - |> trans - | Quotations.Patterns.IfThenElse(c,b1,b2) -> - (* let v = if c then b1 else b2 in bexpr => if c then let v = b1 in bexpr else let v = b2 in bexpr *) - Quotations.Expr.IfThenElse(c, inlineByref v b1 bexpr, inlineByref v b2 bexpr) - |> trans - | Quotations.Patterns.Var _ -> - (* let v = v1 in bexpr => bexpr[v/v1] *) - bexpr.Substitute(fun v' -> if v = v' then Some vexpr else None) - |> trans - | _ -> - failwith (sprintf "Unexpected byref binding: %A = %A" v vexpr) - and transValue (v : obj, tyOfValue : Type, expectedTy : Type) = - let rec transArray (o : Array, ty : Type) = - let elemTy = ty.GetElementType() - let converter = getConverterForType elemTy - let elements = - [ - for el in o do - yield converter el - ] - Quotations.Expr.NewArray(elemTy, elements) - and transList(o, ty : Type, nil, cons) = - let converter = getConverterForType (ty.GetGenericArguments().[0]) - o - |> Seq.cast - |> List.ofSeq - |> fun l -> List.foldBack(fun o s -> Quotations.Expr.NewUnionCase(cons, [ converter(o); s ])) l (Quotations.Expr.NewUnionCase(nil, [])) - |> trans - and getConverterForType (ty : Type) = - if ty.IsArray then - fun (v : obj) -> transArray(v :?> Array, ty) - elif ty.IsGenericType && ty.GetGenericTypeDefinition() = typedefof<_ list> then - let nil, cons = - let cases = Reflection.FSharpType.GetUnionCases(ty) - let a = cases.[0] - let b = cases.[1] - if a.Name = "Empty" then a,b - else b,a - - fun v -> transList (v :?> System.Collections.IEnumerable, ty, nil, cons) - else - fun v -> Quotations.Expr.Value(v, ty) - let converter = getConverterForType tyOfValue - let r = converter v - if tyOfValue <> expectedTy then Quotations.Expr.Coerce(r, expectedTy) - else r - trans q - - let getFastFuncType (args : list) resultType = - let types = - [| - for arg in args -> arg.Type - yield resultType - |] - let fastFuncTy = - match List.length args with - | 2 -> typedefof>.MakeGenericType(types) - | 3 -> typedefof>.MakeGenericType(types) - | 4 -> typedefof>.MakeGenericType(types) - | 5 -> typedefof>.MakeGenericType(types) - | _ -> invalidArg "args" "incorrect number of arguments" - fastFuncTy.GetMethod("Adapt") - - let inline (===) a b = LanguagePrimitives.PhysicalEquality a b - - let traverse f = - let rec fallback e = - match e with - | P.Let(v, value, body) -> - let fixedValue = f fallback value - let fixedBody = f fallback body - if fixedValue === value && fixedBody === body then - e - else - E.Let(v, fixedValue, fixedBody) - | ES.ShapeVar _ -> e - | ES.ShapeLambda(v, body) -> - let fixedBody = f fallback body - if fixedBody === body then - e - else - E.Lambda(v, fixedBody) - | ES.ShapeCombination(shape, exprs) -> - let exprs1 = List.map (f fallback) exprs - if List.forall2 (===) exprs exprs1 then - e - else - ES.RebuildShapeCombination(shape, exprs1) - fun e -> f fallback e - - let RightPipe = <@@ (|>) @@> - let inlineRightPipe expr = - let rec loop expr = traverse loopCore expr - and loopCore fallback orig = - match orig with - | DP.SpecificCall RightPipe (None, _, [operand; applicable]) -> - let fixedOperand = loop operand - match loop applicable with - | P.Lambda(arg, body) -> - let v = Quotations.Var("__temp", operand.Type) - let ev = E.Var v + // These are handles to the internal functions that create quotation nodes of different sizes. Although internal, + // these function names have been stable since F# 2.0. + let mkFE0 = pTy.GetMethod("mkFE0", bindAll) + assert (not (isNull mkFE0)) - let fixedBody = loop body - E.Let(v, fixedOperand, fixedBody.Substitute(fun v1 -> if v1 = arg then Some ev else None)) - | fixedApplicable -> E.Application(fixedApplicable, fixedOperand) - | x -> fallback x - loop expr - - let inlineValueBindings e = - let map = Dictionary(HashIdentity.Reference) - let rec loop expr = traverse loopCore expr - and loopCore fallback orig = - match orig with - | P.Let(id, (P.Value(_) as v), body) when not id.IsMutable -> - map.[id] <- v - let fixedBody = loop body - map.Remove(id) |> ignore - fixedBody - | ES.ShapeVar v -> - match map.TryGetValue v with - | true, e -> e - | _ -> orig - | x -> fallback x - loop e - - - let optimizeCurriedApplications expr = - let rec loop expr = traverse loopCore expr - and loopCore fallback orig = - match orig with - | P.Application(e, arg) -> - let e1 = tryPeelApplications e [loop arg] - if e1 === e then - orig - else - e1 - | x -> fallback x - and tryPeelApplications orig args = - let n = List.length args - match orig with - | P.Application(e, arg) -> - let e1 = tryPeelApplications e ((loop arg)::args) - if e1 === e then - orig - else - e1 - | P.Let(id, applicable, (P.Lambda(_) as body)) when n > 0 -> - let numberOfApplication = countPeelableApplications body id 0 - if numberOfApplication = 0 then orig - elif n = 1 then E.Application(applicable, List.head args) - elif n <= 5 then - let resultType = - applicable.Type - |> Seq.unfold (fun t -> - if not t.IsGenericType then None - else - let args = t.GetGenericArguments() - if args.Length <> 2 then None - else - Some (args.[1], args.[1]) - ) - |> Seq.item (n - 1) - - let adaptMethod = getFastFuncType args resultType - let adapted = E.Call(adaptMethod, [loop applicable]) - let invoke = adapted.Type.GetMethod("Invoke", [| for arg in args -> arg.Type |]) - E.Call(adapted, invoke, args) - else - (applicable, args) ||> List.fold (fun e a -> E.Application(e, a)) - | _ -> - orig - and countPeelableApplications expr v n = - match expr with - // v - applicable entity obtained on the prev step - // \arg -> let v1 = (f arg) in rest ==> f - | P.Lambda(arg, P.Let(v1, P.Application(P.Var f, P.Var arg1), rest)) when v = f && arg = arg1 -> countPeelableApplications rest v1 (n + 1) - // \arg -> (f arg) ==> f - | P.Lambda(arg, P.Application(P.Var f, P.Var arg1)) when v = f && arg = arg1 -> n - | _ -> n - loop expr - - // FSharp.Data change: use the real variable names instead of indices, to improve output of Debug.fs - let transQuotationToCode isGenerated qexprf (paramNames: string[]) (argExprs: Quotations.Expr[]) = - // add let bindings for arguments to ensure that arguments will be evaluated - let vars = argExprs |> Array.mapi (fun i e -> Quotations.Var(paramNames.[i], e.Type)) - let expr = qexprf ([for v in vars -> Quotations.Expr.Var v]) - - let pairs = Array.zip argExprs vars - let expr = Array.foldBack (fun (arg, var) e -> Quotations.Expr.Let(var, arg, e)) pairs expr - let expr = - if isGenerated then - let e1 = inlineRightPipe expr - let e2 = optimizeCurriedApplications e1 - let e3 = inlineValueBindings e2 - e3 - else - expr + let mkFE1 = pTy.GetMethod("mkFE1", bindAll) + assert (not (isNull mkFE1)) - transExpr isGenerated expr + let mkFE2 = pTy.GetMethod("mkFE2", bindAll) + assert (mkFE2 |> isNull |> not) - let adjustTypeAttributes attributes isNested = - let visibilityAttributes = - match attributes &&& TypeAttributes.VisibilityMask with - | TypeAttributes.Public when isNested -> TypeAttributes.NestedPublic - | TypeAttributes.NotPublic when isNested -> TypeAttributes.NestedAssembly - | TypeAttributes.NestedPublic when not isNested -> TypeAttributes.Public - | TypeAttributes.NestedAssembly - | TypeAttributes.NestedPrivate - | TypeAttributes.NestedFamORAssem - | TypeAttributes.NestedFamily - | TypeAttributes.NestedFamANDAssem when not isNested -> TypeAttributes.NotPublic - | a -> a - (attributes &&& ~~~TypeAttributes.VisibilityMask) ||| visibilityAttributes - -type ProvidedStaticParameter(parameterName:string,parameterType:Type,?parameterDefaultValue:obj) = - inherit System.Reflection.ParameterInfo() - - let customAttributesImpl = CustomAttributesImpl() - - member _.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction - member _.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction - member _.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc - - override _.RawDefaultValue = defaultArg parameterDefaultValue null - override _.Attributes = if parameterDefaultValue.IsNone then enum 0 else ParameterAttributes.Optional - override _.Position = 0 - override _.ParameterType = parameterType - override _.Name = parameterName - - override _.GetCustomAttributes(_inherit) = ignore(_inherit); notRequired "GetCustomAttributes" parameterName - override _.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" parameterName - -type ProvidedParameter(name:string,parameterType:Type,?isOut:bool,?optionalValue:obj) = - inherit System.Reflection.ParameterInfo() - let customAttributesImpl = CustomAttributesImpl() - let isOut = defaultArg isOut false - member _.IsParamArray with get() = customAttributesImpl.HasParamArray and set(v) = customAttributesImpl.HasParamArray <- v - override _.Name = name - override _.ParameterType = parameterType - override _.Attributes = (base.Attributes ||| (if isOut then ParameterAttributes.Out else enum 0) - ||| (match optionalValue with None -> enum 0 | Some _ -> ParameterAttributes.Optional ||| ParameterAttributes.HasDefault)) - override _.RawDefaultValue = defaultArg optionalValue null - member _.HasDefaultParameterValue = Option.isSome optionalValue - member _.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData() -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() -#endif + let mkFE3 = pTy.GetMethod("mkFE3", bindAll) + assert (mkFE3 |> isNull |> not) -type ProvidedConstructor(parameters : ProvidedParameter list) = - inherit ConstructorInfo() - let parameters = parameters |> List.map (fun p -> p :> ParameterInfo) - let mutable baseCall = None - - let mutable declaringType = null : System.Type - let mutable invokeCode = None : option Quotations.Expr> - let mutable isImplicitCtor = false - let mutable ctorAttributes = MethodAttributes.Public ||| MethodAttributes.RTSpecialName - let nameText () = sprintf "constructor for %s" (if declaringType=null then "" else declaringType.FullName) - let isStatic() = ctorAttributes.HasFlag(MethodAttributes.Static) - - let customAttributesImpl = CustomAttributesImpl() - member _.IsTypeInitializer - with get() = isStatic() && ctorAttributes.HasFlag(MethodAttributes.Private) - and set(v) = - let typeInitializerAttributes = MethodAttributes.Static ||| MethodAttributes.Private - ctorAttributes <- if v then ctorAttributes ||| typeInitializerAttributes else ctorAttributes &&& ~~~typeInitializerAttributes - - member _.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction - member _.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction - member _.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc - member _.AddObsoleteAttribute (message,?isError) = customAttributesImpl.AddObsolete (message,defaultArg isError false) - member _.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) - member _.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData() -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() -#endif + let mkFEN = pTy.GetMethod("mkFEN", bindAll) + assert (mkFEN |> isNull |> not) - member _.DeclaringTypeImpl - with set x = - if declaringType<>null then failwith (sprintf "ProvidedConstructor: declaringType already set on '%s'" (nameText())); - declaringType <- x + // These are handles to the internal tags attached to quotation nodes of different sizes. Although internal, + // these function names have been stable since F# 2.0. + let newDelegateOp = qTy.GetMethod("NewNewDelegateOp", bindAll) + assert (newDelegateOp |> isNull |> not) - member _.InvokeCode - with set (q:Quotations.Expr list -> Quotations.Expr) = - match invokeCode with - | None -> invokeCode <- Some q - | Some _ -> failwith (sprintf "ProvidedConstructor: code already given for '%s'" (nameText())) + let instanceCallOp = qTy.GetMethod("NewInstanceMethodCallOp", bindAll) + assert (instanceCallOp |> isNull |> not) - member _.BaseConstructorCall - with set (d:Quotations.Expr list -> (ConstructorInfo * Quotations.Expr list)) = - match baseCall with - | None -> baseCall <- Some d - | Some _ -> failwith (sprintf "ProvidedConstructor: base call already given for '%s'" (nameText())) - - member _.GetInvokeCodeInternal isGenerated = - match invokeCode with - | Some f -> - // FSharp.Data change: use the real variable names instead of indices, to improve output of Debug.fs - let paramNames = - parameters - |> List.map (fun p -> p.Name) - |> List.append (if not isGenerated || isStatic() then [] else ["this"]) - |> Array.ofList - transQuotationToCode isGenerated f paramNames - | None -> failwith (sprintf "ProvidedConstructor: no invoker for '%s'" (nameText())) + let staticCallOp = qTy.GetMethod("NewStaticMethodCallOp", bindAll) + assert (staticCallOp |> isNull |> not) - member _.GetBaseConstructorCallInternal isGenerated = - match baseCall with - | Some f -> Some(fun ctorArgs -> let c,baseCtorArgExprs = f ctorArgs in c, List.map (transExpr isGenerated) baseCtorArgExprs) - | None -> None - member _.IsImplicitCtor with get() = isImplicitCtor and set v = isImplicitCtor <- v + let newObjectOp = qTy.GetMethod("NewNewObjectOp", bindAll) + assert (newObjectOp |> isNull |> not) - // Implement overloads - override _.GetParameters() = parameters |> List.toArray - override _.Attributes = ctorAttributes - override _.Name = if isStatic() then ".cctor" else ".ctor" - override _.DeclaringType = declaringType |> nonNull "ProvidedConstructor.DeclaringType" - override _.IsDefined(_attributeType, _inherit) = true - - override _.Invoke(_invokeAttr, _binder, _parameters, _culture) = notRequired "Invoke" (nameText()) - override _.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired "Invoke" (nameText()) - override _.ReflectedType = notRequired "ReflectedType" (nameText()) - override _.GetMethodImplementationFlags() = notRequired "GetMethodImplementationFlags" (nameText()) - override _.MethodHandle = notRequired "MethodHandle" (nameText()) - override _.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" (nameText()) - override _.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" (nameText()) - -type ProvidedMethod(methodName: string, parameters: ProvidedParameter list, returnType: Type) = - inherit System.Reflection.MethodInfo() - let argParams = parameters |> List.map (fun p -> p :> ParameterInfo) - - // State - let mutable declaringType : Type = null - let mutable methodAttrs = MethodAttributes.Public - let mutable invokeCode = None : option Quotations.Expr> - let mutable staticParams = [ ] - let mutable staticParamsApply = None - let isStatic() = methodAttrs.HasFlag(MethodAttributes.Static) - let customAttributesImpl = CustomAttributesImpl() - - member _.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction - member _.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction - member _.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc - member _.AddObsoleteAttribute (message,?isError) = customAttributesImpl.AddObsolete (message,defaultArg isError false) - member _.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) - member _.AddCustomAttribute(attribute) = customAttributesImpl.AddCustomAttribute(attribute) - member _.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData() -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() -#endif + let newArrayOp = qTy.GetMethod("NewNewArrayOp", bindAll) + assert (newArrayOp |> isNull |> not) - member _.SetMethodAttrs m = methodAttrs <- m - member _.AddMethodAttrs m = methodAttrs <- methodAttrs ||| m - member _.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice - member _.IsStaticMethod - with get() = isStatic() - and set x = if x then methodAttrs <- methodAttrs ||| MethodAttributes.Static - else methodAttrs <- methodAttrs &&& (~~~ MethodAttributes.Static) + let appOp = qTy.GetMethod("get_AppOp", bindAll) + assert (appOp |> isNull |> not) - member _.InvokeCode - with set (q:Quotations.Expr list -> Quotations.Expr) = - match invokeCode with - | None -> invokeCode <- Some q - | Some _ -> failwith (sprintf "ProvidedConstructor: code already given for %s on type %s" methodName (if declaringType=null then "" else declaringType.FullName)) + let instancePropGetOp = qTy.GetMethod("NewInstancePropGetOp", bindAll) + assert (instancePropGetOp |> isNull |> not) + let staticPropGetOp = qTy.GetMethod("NewStaticPropGetOp", bindAll) + assert (staticPropGetOp |> isNull |> not) - /// Abstract a type to a parametric-type. Requires "formal parameters" and "instantiation function". - member _.DefineStaticParameters(staticParameters : list, apply : (string -> obj[] -> ProvidedMethod)) = - staticParams <- staticParameters - staticParamsApply <- Some apply - - /// Get ParameterInfo[] for the parametric type parameters (//s GetGenericParameters) - member _.GetStaticParameters() = [| for p in staticParams -> p :> ParameterInfo |] - - /// Instantiate parametrics type - member _.ApplyStaticArguments(mangledName:string, args:obj[]) = - if staticParams.Length>0 then - if staticParams.Length <> args.Length then - failwith (sprintf "ProvidedTypeDefinition: expecting %d static parameters but given %d for method %s" staticParams.Length args.Length methodName) - match staticParamsApply with - | None -> failwith "ProvidedTypeDefinition: DefineStaticParameters was not called" - | Some f -> f mangledName args - else - failwith (sprintf "ProvidedTypeDefinition: static parameters supplied but not expected for method %s" methodName) - - member _.GetInvokeCodeInternal isGenerated = - match invokeCode with - | Some f -> - // FSharp.Data change: use the real variable names instead of indices, to improve output of Debug.fs - let paramNames = - parameters - |> List.map (fun p -> p.Name) - |> List.append (if isStatic() then [] else ["this"]) - |> Array.ofList - transQuotationToCode isGenerated f paramNames - | None -> failwith (sprintf "ProvidedMethod: no invoker for %s on type %s" methodName (if declaringType=null then "" else declaringType.FullName)) - - // Implement overloads - override _.GetParameters() = argParams |> Array.ofList - override _.Attributes = methodAttrs - override _.Name = methodName - override _.DeclaringType = declaringType |> nonNull "ProvidedMethod.DeclaringType" - override _.IsDefined(_attributeType, _inherit) : bool = true - override _.MemberType = MemberTypes.Method - override _.CallingConvention = - let cc = CallingConventions.Standard - let cc = if not (isStatic()) then cc ||| CallingConventions.HasThis else cc - cc - override _.ReturnType = returnType - override _.ReturnParameter = null // REVIEW: Give it a name and type? - override _.ToString() = "Method " + methodName - - // These don't have to return fully accurate results - they are used - // by the F# Quotations library function SpecificCall as a pre-optimization - // when comparing methods - override _.MetadataToken = hash declaringType + hash methodName - override _.MethodHandle = RuntimeMethodHandle() - - override _.ReturnTypeCustomAttributes = notRequired "ReturnTypeCustomAttributes" methodName - override _.GetBaseDefinition() = notRequired "GetBaseDefinition" methodName - override _.GetMethodImplementationFlags() = notRequired "GetMethodImplementationFlags" methodName - override _.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired "Invoke" methodName - override _.ReflectedType = notRequired "ReflectedType" methodName - override _.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" methodName - override _.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" methodName - - -type ProvidedProperty(propertyName: string, propertyType: Type, ?parameters: ProvidedParameter list) = - inherit System.Reflection.PropertyInfo() - // State - - let parameters = defaultArg parameters [] - let mutable declaringType = null - let mutable isStatic = false - let mutable getterCode = None : option Quotations.Expr> - let mutable setterCode = None : option Quotations.Expr> - - let hasGetter() = getterCode.IsSome - let hasSetter() = setterCode.IsSome - - // Delay construction - to pick up the latest isStatic - let markSpecialName (m:ProvidedMethod) = m.AddMethodAttrs(MethodAttributes.SpecialName); m - let getter = lazy (ProvidedMethod("get_" + propertyName,parameters,propertyType,IsStaticMethod=isStatic,DeclaringTypeImpl=declaringType,InvokeCode=getterCode.Value) |> markSpecialName) - let setter = lazy (ProvidedMethod("set_" + propertyName,parameters @ [ProvidedParameter("value",propertyType)],typeof,IsStaticMethod=isStatic,DeclaringTypeImpl=declaringType,InvokeCode=setterCode.Value) |> markSpecialName) - - let customAttributesImpl = CustomAttributesImpl() - member _.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction - member _.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction - member _.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc - member _.AddObsoleteAttribute (message,?isError) = customAttributesImpl.AddObsolete (message,defaultArg isError false) - member _.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) - member _.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData() - member _.AddCustomAttribute attribute = customAttributesImpl.AddCustomAttribute attribute -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() -#endif + let instancePropSetOp = qTy.GetMethod("NewInstancePropSetOp", bindAll) + assert (instancePropSetOp |> isNull |> not) - member _.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice + let staticPropSetOp = qTy.GetMethod("NewStaticPropSetOp", bindAll) + assert (staticPropSetOp |> isNull |> not) - member _.IsStatic - with get() = isStatic - and set x = isStatic <- x + let instanceFieldGetOp = qTy.GetMethod("NewInstanceFieldGetOp", bindAll) + assert (instanceFieldGetOp |> isNull |> not) - member _.GetterCode - with set (q:Quotations.Expr list -> Quotations.Expr) = - if not getter.IsValueCreated then getterCode <- Some q else failwith "ProvidedProperty: getter MethodInfo has already been created" + let staticFieldGetOp = qTy.GetMethod("NewStaticFieldGetOp", bindAll) + assert (staticFieldGetOp |> isNull |> not) - member _.SetterCode - with set (q:Quotations.Expr list -> Quotations.Expr) = - if not (setter.IsValueCreated) then setterCode <- Some q else failwith "ProvidedProperty: setter MethodInfo has already been created" + let instanceFieldSetOp = qTy.GetMethod("NewInstanceFieldSetOp", bindAll) + assert (instanceFieldSetOp |> isNull |> not) - // Implement overloads - override _.PropertyType = propertyType - override _.SetValue(_obj, _value, _invokeAttr, _binder, _index, _culture) = notRequired "SetValue" propertyName - override _.GetAccessors _nonPublic = notRequired "nonPublic" propertyName - override _.GetGetMethod _nonPublic = if hasGetter() then getter.Force() :> MethodInfo else null - override _.GetSetMethod _nonPublic = if hasSetter() then setter.Force() :> MethodInfo else null - override _.GetIndexParameters() = [| for p in parameters -> upcast p |] - override _.Attributes = PropertyAttributes.None - override _.CanRead = hasGetter() - override _.CanWrite = hasSetter() - override _.GetValue(_obj, _invokeAttr, _binder, _index, _culture) : obj = notRequired "GetValue" propertyName - override _.Name = propertyName - override _.DeclaringType = declaringType |> nonNull "ProvidedProperty.DeclaringType" - override _.MemberType : MemberTypes = MemberTypes.Property - - override _.ReflectedType = notRequired "ReflectedType" propertyName - override _.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" propertyName - override _.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" propertyName - override _.IsDefined(_attributeType, _inherit) = notRequired "IsDefined" propertyName - -type ProvidedEvent(eventName:string,eventHandlerType:Type) = - inherit System.Reflection.EventInfo() - // State - - let mutable declaringType = null - let mutable isStatic = false - let mutable adderCode = None : option Quotations.Expr> - let mutable removerCode = None : option Quotations.Expr> - - // Delay construction - to pick up the latest isStatic - let markSpecialName (m:ProvidedMethod) = m.AddMethodAttrs(MethodAttributes.SpecialName); m - let adder = lazy (ProvidedMethod("add_" + eventName, [ProvidedParameter("handler", eventHandlerType)],typeof,IsStaticMethod=isStatic,DeclaringTypeImpl=declaringType,InvokeCode=adderCode.Value) |> markSpecialName) - let remover = lazy (ProvidedMethod("remove_" + eventName, [ProvidedParameter("handler", eventHandlerType)],typeof,IsStaticMethod=isStatic,DeclaringTypeImpl=declaringType,InvokeCode=removerCode.Value) |> markSpecialName) - - let customAttributesImpl = CustomAttributesImpl() - member _.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction - member _.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction - member _.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc - member _.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) - member _.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData() -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() -#endif + let staticFieldSetOp = qTy.GetMethod("NewStaticFieldSetOp", bindAll) + assert (staticFieldSetOp |> isNull |> not) - member _.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice - member _.IsStatic - with get() = isStatic - and set x = isStatic <- x + let tupleGetOp = qTy.GetMethod("NewTupleGetOp", bindAll) + assert (tupleGetOp |> isNull |> not) - member _.AdderCode - with get() = adderCode.Value - and set f = - if not adder.IsValueCreated then adderCode <- Some f else failwith "ProvidedEvent: Add MethodInfo has already been created" + let letOp = qTy.GetMethod("get_LetOp", bindAll) + assert (letOp |> isNull |> not) - member _.RemoverCode - with get() = removerCode.Value - and set f = - if not (remover.IsValueCreated) then removerCode <- Some f else failwith "ProvidedEvent: Remove MethodInfo has already been created" + let forIntegerRangeLoopOp = qTy.GetMethod("get_ForIntegerRangeLoopOp", bindAll) + assert (forIntegerRangeLoopOp |> isNull |> not) - // Implement overloads - override _.EventHandlerType = eventHandlerType - override _.GetAddMethod _nonPublic = adder.Force() :> MethodInfo - override _.GetRemoveMethod _nonPublic = remover.Force() :> MethodInfo - override _.Attributes = EventAttributes.None - override _.Name = eventName - override _.DeclaringType = declaringType |> nonNull "ProvidedEvent.DeclaringType" - override _.MemberType : MemberTypes = MemberTypes.Event - - override _.GetRaiseMethod _nonPublic = notRequired "GetRaiseMethod" eventName - override _.ReflectedType = notRequired "ReflectedType" eventName - override _.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" eventName - override _.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" eventName - override _.IsDefined(_attributeType, _inherit) = notRequired "IsDefined" eventName - -type ProvidedLiteralField(fieldName:string,fieldType:Type,literalValue:obj) = - inherit System.Reflection.FieldInfo() - // State - - let mutable declaringType = null - - let customAttributesImpl = CustomAttributesImpl() - member _.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction - member _.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction - member _.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc - member _.AddObsoleteAttribute (message,?isError) = customAttributesImpl.AddObsolete (message,defaultArg isError false) - member _.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) - member _.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData() -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() -#endif + let whileLoopOp = qTy.GetMethod("get_WhileLoopOp", bindAll) + assert (whileLoopOp |> isNull |> not) - member _.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice + let ifThenElseOp = qTy.GetMethod("get_IfThenElseOp", bindAll) + assert (ifThenElseOp |> isNull |> not) + let newUnionCaseOp = qTy.GetMethod("NewNewUnionCaseOp", bindAll) + assert (newUnionCaseOp |> isNull |> not) - // Implement overloads - override _.FieldType = fieldType - override _.GetRawConstantValue() = literalValue - override _.Attributes = FieldAttributes.Static ||| FieldAttributes.Literal ||| FieldAttributes.Public - override _.Name = fieldName - override _.DeclaringType = declaringType |> nonNull "ProvidedLiteralField.DeclaringType" - override _.MemberType : MemberTypes = MemberTypes.Field - - override _.ReflectedType = notRequired "ReflectedType" fieldName - override _.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" fieldName - override _.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" fieldName - override _.IsDefined(_attributeType, _inherit) = notRequired "IsDefined" fieldName - - override _.SetValue(_obj, _value, _invokeAttr, _binder, _culture) = notRequired "SetValue" fieldName - override _.GetValue(_obj) : obj = notRequired "GetValue" fieldName - override _.FieldHandle = notRequired "FieldHandle" fieldName - -type ProvidedField(fieldName:string,fieldType:Type) = - inherit System.Reflection.FieldInfo() - // State - - let mutable declaringType = null - - let customAttributesImpl = CustomAttributesImpl() - let mutable fieldAttrs = FieldAttributes.Private - member _.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction - member _.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction - member _.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc - member _.AddObsoleteAttribute (message,?isError) = customAttributesImpl.AddObsolete (message,defaultArg isError false) - member _.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) - member _.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData() -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() -#endif + let newRecordOp = qTy.GetMethod("NewNewRecordOp", bindAll) + assert (newRecordOp |> isNull |> not) - member _.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice + type Microsoft.FSharp.Quotations.Expr with - member _.SetFieldAttributes attrs = fieldAttrs <- attrs - // Implement overloads - override _.FieldType = fieldType - override _.GetRawConstantValue() = null - override _.Attributes = fieldAttrs - override _.Name = fieldName - override _.DeclaringType = declaringType |> nonNull "ProvidedField.DeclaringType" - override _.MemberType : MemberTypes = MemberTypes.Field - - override _.ReflectedType = notRequired "ReflectedType" fieldName - override _.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" fieldName - override _.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" fieldName - override _.IsDefined(_attributeType, _inherit) = notRequired "IsDefined" fieldName - - override _.SetValue(_obj, _value, _invokeAttr, _binder, _culture) = notRequired "SetValue" fieldName - override _.GetValue(_obj) : obj = notRequired "GetValue" fieldName - override _.FieldHandle = notRequired "FieldHandle" fieldName + static member NewDelegateUnchecked (ty: Type, vs: Var list, body: Expr) = + let e = List.foldBack (fun v acc -> Expr.Lambda(v, acc)) vs body + let op = newDelegateOp.Invoke(null, [| box ty |]) + mkFE1.Invoke(null, [| box op; box e |]) :?> Expr + + static member NewObjectUnchecked (cinfo: ConstructorInfo, args: Expr list) = + let op = newObjectOp.Invoke(null, [| box cinfo |]) + mkFEN.Invoke(null, [| box op; box args |]) :?> Expr + + static member NewArrayUnchecked (elementType: Type, elements: Expr list) = + let op = newArrayOp.Invoke(null, [| box elementType |]) + mkFEN.Invoke(null, [| box op; box elements |]) :?> Expr + + static member CallUnchecked (minfo: MethodInfo, args: Expr list) = + let op = staticCallOp.Invoke(null, [| box minfo |]) + mkFEN.Invoke(null, [| box op; box args |]) :?> Expr + + static member CallUnchecked (obj: Expr, minfo: MethodInfo, args: Expr list) = + let op = instanceCallOp.Invoke(null, [| box minfo |]) + mkFEN.Invoke(null, [| box op; box (obj::args) |]) :?> Expr + + static member ApplicationUnchecked (f: Expr, x: Expr) = + let op = appOp.Invoke(null, [| |]) + mkFE2.Invoke(null, [| box op; box f; box x |]) :?> Expr + + static member PropertyGetUnchecked (pinfo: PropertyInfo, args: Expr list) = + let op = staticPropGetOp.Invoke(null, [| box pinfo |]) + mkFEN.Invoke(null, [| box op; box args |]) :?> Expr + + static member PropertyGetUnchecked (obj: Expr, pinfo: PropertyInfo, ?args: Expr list) = + let args = defaultArg args [] + let op = instancePropGetOp.Invoke(null, [| box pinfo |]) + mkFEN.Invoke(null, [| box op; box (obj::args) |]) :?> Expr + + static member PropertySetUnchecked (pinfo: PropertyInfo, value: Expr, ?args: Expr list) = + let args = defaultArg args [] + let op = staticPropSetOp.Invoke(null, [| box pinfo |]) + mkFEN.Invoke(null, [| box op; box (args@[value]) |]) :?> Expr + + static member PropertySetUnchecked (obj: Expr, pinfo: PropertyInfo, value: Expr, ?args: Expr list) = + let args = defaultArg args [] + let op = instancePropSetOp.Invoke(null, [| box pinfo |]) + mkFEN.Invoke(null, [| box op; box (obj::(args@[value])) |]) :?> Expr + + static member FieldGetUnchecked (pinfo: FieldInfo) = + let op = staticFieldGetOp.Invoke(null, [| box pinfo |]) + mkFE0.Invoke(null, [| box op; |]) :?> Expr + + static member FieldGetUnchecked (obj: Expr, pinfo: FieldInfo) = + let op = instanceFieldGetOp.Invoke(null, [| box pinfo |]) + mkFE1.Invoke(null, [| box op; box obj |]) :?> Expr + + static member FieldSetUnchecked (pinfo: FieldInfo, value: Expr) = + let op = staticFieldSetOp.Invoke(null, [| box pinfo |]) + mkFE1.Invoke(null, [| box op; box value |]) :?> Expr + + static member FieldSetUnchecked (obj: Expr, pinfo: FieldInfo, value: Expr) = + let op = instanceFieldSetOp.Invoke(null, [| box pinfo |]) + mkFE2.Invoke(null, [| box op; box obj; box value |]) :?> Expr + + static member TupleGetUnchecked (e: Expr, n:int) = + let op = tupleGetOp.Invoke(null, [| box e.Type; box n |]) + mkFE1.Invoke(null, [| box op; box e |]) :?> Expr + + static member LetUnchecked (v:Var, e: Expr, body:Expr) = + let lam = Expr.Lambda(v, body) + let op = letOp.Invoke(null, [| |]) + mkFE2.Invoke(null, [| box op; box e; box lam |]) :?> Expr + + static member ForIntegerRangeLoopUnchecked (loopVariable, startExpr:Expr, endExpr:Expr, body:Expr) = + let lam = Expr.Lambda(loopVariable, body) + let op = forIntegerRangeLoopOp.Invoke(null, [| |]) + mkFE3.Invoke(null, [| box op; box startExpr; box endExpr; box lam |] ) :?> Expr + + static member WhileLoopUnchecked (guard:Expr, body:Expr) = + let op = whileLoopOp.Invoke(null, [| |]) + mkFE2.Invoke(null, [| box op; box guard; box body |] ):?> Expr + + static member IfThenElseUnchecked (e:Expr, t:Expr, f:Expr) = + let op = ifThenElseOp.Invoke(null, [| |]) + mkFE3.Invoke(null, [| box op; box e; box t; box f |] ):?> Expr + + static member NewUnionCaseUnchecked (uci:Reflection.UnionCaseInfo, args:Expr list) = + let op = newUnionCaseOp.Invoke(null, [| box uci |]) + mkFEN.Invoke(null, [| box op; box args |]) :?> Expr + + static member NewRecordUnchecked (ty:Type, args:Expr list) = + let op = newRecordOp.Invoke(null, [| box ty |]) + mkFEN.Invoke(null, [| box op; box args |]) :?> Expr + + type Shape = Shape of (Expr list -> Expr) + + let (|ShapeCombinationUnchecked|ShapeVarUnchecked|ShapeLambdaUnchecked|) e = + match e with + | NewObject (cinfo, args) -> + ShapeCombinationUnchecked (Shape (function args -> Expr.NewObjectUnchecked (cinfo, args)), args) + | NewArray (ty, args) -> + ShapeCombinationUnchecked (Shape (function args -> Expr.NewArrayUnchecked (ty, args)), args) + | NewDelegate (t, vars, expr) -> + ShapeCombinationUnchecked (Shape (function [expr] -> Expr.NewDelegateUnchecked (t, vars, expr) | _ -> invalidArg "expr" "invalid shape"), [expr]) + | TupleGet (expr, n) -> + ShapeCombinationUnchecked (Shape (function [expr] -> Expr.TupleGetUnchecked (expr, n) | _ -> invalidArg "expr" "invalid shape"), [expr]) + | Application (f, x) -> + ShapeCombinationUnchecked (Shape (function [f; x] -> Expr.ApplicationUnchecked (f, x) | _ -> invalidArg "expr" "invalid shape"), [f; x]) + | Call (objOpt, minfo, args) -> + match objOpt with + | None -> ShapeCombinationUnchecked (Shape (function args -> Expr.CallUnchecked (minfo, args)), args) + | Some obj -> ShapeCombinationUnchecked (Shape (function (obj::args) -> Expr.CallUnchecked (obj, minfo, args) | _ -> invalidArg "expr" "invalid shape"), obj::args) + | PropertyGet (objOpt, pinfo, args) -> + match objOpt with + | None -> ShapeCombinationUnchecked (Shape (function args -> Expr.PropertyGetUnchecked (pinfo, args)), args) + | Some obj -> ShapeCombinationUnchecked (Shape (function (obj::args) -> Expr.PropertyGetUnchecked (obj, pinfo, args) | _ -> invalidArg "expr" "invalid shape"), obj::args) + | PropertySet (objOpt, pinfo, args, value) -> + match objOpt with + | None -> ShapeCombinationUnchecked (Shape (function (value::args) -> Expr.PropertySetUnchecked (pinfo, value, args) | _ -> invalidArg "expr" "invalid shape"), value::args) + | Some obj -> ShapeCombinationUnchecked (Shape (function (obj::value::args) -> Expr.PropertySetUnchecked (obj, pinfo, value, args) | _ -> invalidArg "expr" "invalid shape"), obj::value::args) + | FieldGet (objOpt, pinfo) -> + match objOpt with + | None -> ShapeCombinationUnchecked (Shape (function _ -> Expr.FieldGetUnchecked (pinfo)), []) + | Some obj -> ShapeCombinationUnchecked (Shape (function [obj] -> Expr.FieldGetUnchecked (obj, pinfo) | _ -> invalidArg "expr" "invalid shape"), [obj]) + | FieldSet (objOpt, pinfo, value) -> + match objOpt with + | None -> ShapeCombinationUnchecked (Shape (function [value] -> Expr.FieldSetUnchecked (pinfo, value) | _ -> invalidArg "expr" "invalid shape"), [value]) + | Some obj -> ShapeCombinationUnchecked (Shape (function [obj;value] -> Expr.FieldSetUnchecked (obj, pinfo, value) | _ -> invalidArg "expr" "invalid shape"), [obj; value]) + | Let (var, value, body) -> + ShapeCombinationUnchecked (Shape (function [value;Lambda(var, body)] -> Expr.LetUnchecked(var, value, body) | _ -> invalidArg "expr" "invalid shape"), [value; Expr.Lambda(var, body)]) + | ForIntegerRangeLoop (loopVar, first, last, body) -> + ShapeCombinationUnchecked (Shape (function [first; last; Lambda(loopVar, body)] -> Expr.ForIntegerRangeLoopUnchecked (loopVar, first, last, body) | _ -> invalidArg "expr" "invalid shape"), [first; last; Expr.Lambda(loopVar, body)]) + | WhileLoop (cond, body) -> + ShapeCombinationUnchecked (Shape (function [cond; body] -> Expr.WhileLoopUnchecked (cond, body) | _ -> invalidArg "expr" "invalid shape"), [cond; body]) + | IfThenElse (g, t, e) -> + ShapeCombinationUnchecked (Shape (function [g; t; e] -> Expr.IfThenElseUnchecked (g, t, e) | _ -> invalidArg "expr" "invalid shape"), [g; t; e]) + | TupleGet (expr, i) -> + ShapeCombinationUnchecked (Shape (function [expr] -> Expr.TupleGetUnchecked (expr, i) | _ -> invalidArg "expr" "invalid shape"), [expr]) + | ExprShape.ShapeCombination (comb, args) -> + ShapeCombinationUnchecked (Shape (fun args -> ExprShape.RebuildShapeCombination(comb, args)), args) + | ExprShape.ShapeVar v -> ShapeVarUnchecked v + | ExprShape.ShapeLambda (v, e) -> ShapeLambdaUnchecked (v, e) + + let RebuildShapeCombinationUnchecked (Shape comb, args) = comb args + +//-------------------------------------------------------------------------------- +// Instantiated symbols +// /// Represents the type constructor in a provided symbol type. [] -type SymbolKind = - | SDArray - | Array of int - | Pointer - | ByRef - | Generic of System.Type - | FSharpTypeAbbreviation of (System.Reflection.Assembly * string * string[]) +type ProvidedTypeSymbolKind = + | SDArray + | Array of int + | Pointer + | ByRef + | Generic of Type + | FSharpTypeAbbreviation of (Assembly * string * string[]) /// Represents an array or other symbolic type involving a provided type as the argument. /// See the type provider spec for the methods that must be implemented. /// Note that the type provider specification does not require us to implement pointer-equality for provided types. -type ProvidedSymbolType(kind: SymbolKind, args: Type list) = - inherit Type() - - let rec isEquivalentTo (thisTy: Type) (otherTy: Type) = - match thisTy, otherTy with - | (:? ProvidedSymbolType as thisTy), (:? ProvidedSymbolType as thatTy) -> (thisTy.Kind,thisTy.Args) = (thatTy.Kind, thatTy.Args) - | (:? ProvidedSymbolType as thisTy), otherTy | otherTy, (:? ProvidedSymbolType as thisTy) -> - match thisTy.Kind, thisTy.Args with - | SymbolKind.SDArray, [ty] | SymbolKind.Array _, [ty] when otherTy.IsArray-> ty.Equals(otherTy.GetElementType()) - | SymbolKind.ByRef, [ty] when otherTy.IsByRef -> ty.Equals(otherTy.GetElementType()) - | SymbolKind.Pointer, [ty] when otherTy.IsPointer -> ty.Equals(otherTy.GetElementType()) - | SymbolKind.Generic baseTy, args -> otherTy.IsGenericType && isEquivalentTo baseTy (otherTy.GetGenericTypeDefinition()) && Seq.forall2 isEquivalentTo args (otherTy.GetGenericArguments()) - | _ -> false - | a, b -> a.Equals b - - let nameText() = - match kind,args with - | SymbolKind.SDArray,[arg] -> arg.Name + "[]" - | SymbolKind.Array _,[arg] -> arg.Name + "[*]" - | SymbolKind.Pointer,[arg] -> arg.Name + "*" - | SymbolKind.ByRef,[arg] -> arg.Name + "&" - | SymbolKind.Generic gty, args -> gty.Name + (sprintf "%A" args) - | SymbolKind.FSharpTypeAbbreviation (_,_,path),_ -> path.[path.Length-1] +type ProvidedTypeSymbol(kind: ProvidedTypeSymbolKind, typeArgs: Type list, typeBuilder: ITypeBuilder) as this = + inherit TypeDelegator() + let typeArgs = Array.ofList typeArgs + + do this.typeImpl <- this + + /// Substitute types for type variables. + override __.FullName = + match kind, typeArgs with + | ProvidedTypeSymbolKind.SDArray, [| arg |] -> arg.FullName + "[]" + | ProvidedTypeSymbolKind.Array _, [| arg |] -> arg.FullName + "[*]" + | ProvidedTypeSymbolKind.Pointer, [| arg |] -> arg.FullName + "*" + | ProvidedTypeSymbolKind.ByRef, [| arg |] -> arg.FullName + "&" + | ProvidedTypeSymbolKind.Generic gty, typeArgs -> gty.FullName + "[" + (typeArgs |> Array.map (fun arg -> arg.ToString()) |> String.concat ",") + "]" + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation (_, nsp, path), typeArgs -> String.concat "." (Array.append [| nsp |] path) + (match typeArgs with [| |] -> "" | _ -> typeArgs.ToString()) | _ -> failwith "unreachable" - static member convType (parameters: Type list) (ty:Type) = - if ty = null then null - elif ty.IsGenericType then - let args = Array.map (ProvidedSymbolType.convType parameters) (ty.GetGenericArguments()) - ProvidedSymbolType(Generic (ty.GetGenericTypeDefinition()), Array.toList args) :> Type - elif ty.HasElementType then - let ety = ProvidedSymbolType.convType parameters (ty.GetElementType()) - if ty.IsArray then - let rank = ty.GetArrayRank() - if rank = 1 then ProvidedSymbolType(SDArray,[ety]) :> Type - else ProvidedSymbolType(Array rank,[ety]) :> Type - elif ty.IsPointer then ProvidedSymbolType(Pointer,[ety]) :> Type - elif ty.IsByRef then ProvidedSymbolType(ByRef,[ety]) :> Type - else ty - elif ty.IsGenericParameter then - if ty.GenericParameterPosition <= parameters.Length - 1 then - parameters.[ty.GenericParameterPosition] - else - ty - else ty - - override _.FullName = - match kind,args with - | SymbolKind.SDArray,[arg] -> arg.FullName + "[]" - | SymbolKind.Array _,[arg] -> arg.FullName + "[*]" - | SymbolKind.Pointer,[arg] -> arg.FullName + "*" - | SymbolKind.ByRef,[arg] -> arg.FullName + "&" - | SymbolKind.Generic gty, args -> gty.FullName + "[" + (args |> List.map (fun arg -> arg.ToString()) |> String.concat ",") + "]" - | SymbolKind.FSharpTypeAbbreviation (_,nsp,path),args -> String.concat "." (Array.append [| nsp |] path) + args.ToString() - | _ -> failwith "unreachable" - /// Although not strictly required by the type provider specification, this is required when doing basic operations like FullName on /// .NET symbolic types made from this type, e.g. when building Nullable.FullName - override _.DeclaringType = - match kind,args with - | SymbolKind.SDArray,[arg] -> arg - | SymbolKind.Array _,[arg] -> arg - | SymbolKind.Pointer,[arg] -> arg - | SymbolKind.ByRef,[arg] -> arg - | SymbolKind.Generic gty,_ -> gty - | SymbolKind.FSharpTypeAbbreviation _,_ -> null + override __.DeclaringType = + match kind with + | ProvidedTypeSymbolKind.SDArray -> null + | ProvidedTypeSymbolKind.Array _ -> null + | ProvidedTypeSymbolKind.Pointer -> null + | ProvidedTypeSymbolKind.ByRef -> null + | ProvidedTypeSymbolKind.Generic gty -> gty.DeclaringType + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation _ -> null + + override __.Name = + match kind, typeArgs with + | ProvidedTypeSymbolKind.SDArray, [| arg |] -> arg.Name + "[]" + | ProvidedTypeSymbolKind.Array _, [| arg |] -> arg.Name + "[*]" + | ProvidedTypeSymbolKind.Pointer, [| arg |] -> arg.Name + "*" + | ProvidedTypeSymbolKind.ByRef, [| arg |] -> arg.Name + "&" + | ProvidedTypeSymbolKind.Generic gty, _typeArgs -> gty.Name + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation (_, _, path), _ -> path.[path.Length-1] | _ -> failwith "unreachable" - override _.IsAssignableFrom(otherTy) = + override __.BaseType = match kind with - | Generic gtd -> - if otherTy.IsGenericType then - let otherGtd = otherTy.GetGenericTypeDefinition() - let otherArgs = otherTy.GetGenericArguments() - let yes = gtd.Equals(otherGtd) && Seq.forall2 isEquivalentTo args otherArgs - yes - else - base.IsAssignableFrom(otherTy) - | _ -> base.IsAssignableFrom(otherTy) - - override _.Name = nameText() - - override _.BaseType = - match kind with - | SymbolKind.SDArray -> typeof - | SymbolKind.Array _ -> typeof - | SymbolKind.Pointer -> typeof - | SymbolKind.ByRef -> typeof - | SymbolKind.Generic gty -> - if gty.BaseType = null then null else - ProvidedSymbolType.convType args gty.BaseType - | SymbolKind.FSharpTypeAbbreviation _ -> typeof - - override _.GetArrayRank() = (match kind with SymbolKind.Array n -> n | SymbolKind.SDArray -> 1 | _ -> invalidOp "non-array type") - override _.IsArrayImpl() = (match kind with SymbolKind.Array _ | SymbolKind.SDArray -> true | _ -> false) - override _.IsByRefImpl() = (match kind with SymbolKind.ByRef _ -> true | _ -> false) - override _.IsPointerImpl() = (match kind with SymbolKind.Pointer _ -> true | _ -> false) - override _.IsPrimitiveImpl() = false - override _.IsGenericType = (match kind with SymbolKind.Generic _ -> true | _ -> false) - override _.GetGenericArguments() = (match kind with SymbolKind.Generic _ -> args |> List.toArray | _ -> invalidOp "non-generic type") - override _.GetGenericTypeDefinition() = (match kind with SymbolKind.Generic e -> e | _ -> invalidOp "non-generic type") - override _.IsCOMObjectImpl() = false - override _.HasElementTypeImpl() = (match kind with SymbolKind.Generic _ -> false | _ -> true) - override _.GetElementType() = (match kind,args with (SymbolKind.Array _ | SymbolKind.SDArray | SymbolKind.ByRef | SymbolKind.Pointer),[e] -> e | _ -> invalidOp "not an array, pointer or byref type") - override this.ToString() = this.FullName - - override _.Assembly = - match kind with - | SymbolKind.FSharpTypeAbbreviation (assembly,_nsp,_path) -> assembly - | SymbolKind.Generic gty -> gty.Assembly - | _ -> notRequired "Assembly" (nameText()) - - override _.Namespace = - match kind with - | SymbolKind.FSharpTypeAbbreviation (_assembly,nsp,_path) -> nsp - | _ -> notRequired "Namespace" (nameText()) - - override _.GetHashCode() = - match kind,args with - | SymbolKind.SDArray,[arg] -> 10 + hash arg - | SymbolKind.Array _,[arg] -> 163 + hash arg - | SymbolKind.Pointer,[arg] -> 283 + hash arg - | SymbolKind.ByRef,[arg] -> 43904 + hash arg - | SymbolKind.Generic gty,_ -> 9797 + hash gty + List.sumBy hash args - | SymbolKind.FSharpTypeAbbreviation _,_ -> 3092 + | ProvidedTypeSymbolKind.SDArray -> typeof + | ProvidedTypeSymbolKind.Array _ -> typeof + | ProvidedTypeSymbolKind.Pointer -> typeof + | ProvidedTypeSymbolKind.ByRef -> typeof + | ProvidedTypeSymbolKind.Generic gty -> + if isNull gty.BaseType then null else + instType typeBuilder (typeArgs, [| |]) gty.BaseType + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation _ -> typeof + + override __.GetArrayRank() = (match kind with ProvidedTypeSymbolKind.Array n -> n | ProvidedTypeSymbolKind.SDArray -> 1 | _ -> failwithf "non-array type '%O'" this) + override __.IsValueTypeImpl() = (match kind with ProvidedTypeSymbolKind.Generic gtd -> gtd.IsValueType | _ -> false) + override __.IsArrayImpl() = (match kind with ProvidedTypeSymbolKind.Array _ | ProvidedTypeSymbolKind.SDArray -> true | _ -> false) + override __.IsByRefImpl() = (match kind with ProvidedTypeSymbolKind.ByRef _ -> true | _ -> false) + override __.IsPointerImpl() = (match kind with ProvidedTypeSymbolKind.Pointer _ -> true | _ -> false) + override __.IsPrimitiveImpl() = false + override __.IsGenericType = (match kind with ProvidedTypeSymbolKind.Generic _ -> true | _ -> false) + override this.GetGenericArguments() = (match kind with ProvidedTypeSymbolKind.Generic _ -> typeArgs | _ -> failwithf "non-generic type '%O'" this) + override this.GetGenericTypeDefinition() = (match kind with ProvidedTypeSymbolKind.Generic e -> e | _ -> failwithf "non-generic type '%O'" this) + override __.IsCOMObjectImpl() = false + override __.HasElementTypeImpl() = (match kind with ProvidedTypeSymbolKind.Generic _ -> false | _ -> true) + override __.GetElementType() = (match kind, typeArgs with (ProvidedTypeSymbolKind.Array _ | ProvidedTypeSymbolKind.SDArray | ProvidedTypeSymbolKind.ByRef | ProvidedTypeSymbolKind.Pointer), [| e |] -> e | _ -> failwithf "not an array, pointer or byref type") + + override this.Assembly = + match kind, typeArgs with + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation (assembly, _nsp, _path), _ -> assembly + | ProvidedTypeSymbolKind.Generic gty, _ -> gty.Assembly + | ProvidedTypeSymbolKind.SDArray, [| arg |] -> arg.Assembly + | ProvidedTypeSymbolKind.Array _, [| arg |] -> arg.Assembly + | ProvidedTypeSymbolKind.Pointer, [| arg |] -> arg.Assembly + | ProvidedTypeSymbolKind.ByRef, [| arg |] -> arg.Assembly + | _ -> notRequired this "Assembly" this.FullName + + override this.Namespace = + match kind, typeArgs with + | ProvidedTypeSymbolKind.SDArray, [| arg |] -> arg.Namespace + | ProvidedTypeSymbolKind.Array _, [| arg |] -> arg.Namespace + | ProvidedTypeSymbolKind.Pointer, [| arg |] -> arg.Namespace + | ProvidedTypeSymbolKind.ByRef, [| arg |] -> arg.Namespace + | ProvidedTypeSymbolKind.Generic gty, _ -> gty.Namespace + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation (_assembly, nsp, _path), _ -> nsp + | _ -> notRequired this "Namespace" this.FullName + + override x.Module = x.Assembly.ManifestModule + + override __.GetHashCode() = + match kind, typeArgs with + | ProvidedTypeSymbolKind.SDArray, [| arg |] -> 10 + hash arg + | ProvidedTypeSymbolKind.Array _, [| arg |] -> 163 + hash arg + | ProvidedTypeSymbolKind.Pointer, [| arg |] -> 283 + hash arg + | ProvidedTypeSymbolKind.ByRef, [| arg |] -> 43904 + hash arg + | ProvidedTypeSymbolKind.Generic gty, _ -> 9797 + hash gty + Array.sumBy hash typeArgs + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation _, _ -> 3092 | _ -> failwith "unreachable" - - override _.Equals(other: obj) = - match other with - | :? ProvidedSymbolType as otherTy -> (kind, args) = (otherTy.Kind, otherTy.Args) - | _ -> false - member _.Kind = kind - member _.Args = args - - override _.Module : Module = notRequired "Module" (nameText()) - override _.GetConstructors _bindingAttr = notRequired "GetConstructors" (nameText()) - override _.GetMethodImpl(_name, _bindingAttr, _binderBinder, _callConvention, _types, _modifiers) = - match kind with - | Generic gtd -> - let ty = gtd.GetGenericTypeDefinition().MakeGenericType(Array.ofList args) - ty.GetMethod(_name, _bindingAttr) - | _ -> notRequired "GetMethodImpl" (nameText()) - override _.GetMembers _bindingAttr = notRequired "GetMembers" (nameText()) - override _.GetMethods _bindingAttr = notRequired "GetMethods" (nameText()) - override _.GetField(_name, _bindingAttr) = notRequired "GetField" (nameText()) - override _.GetFields _bindingAttr = notRequired "GetFields" (nameText()) - override _.GetInterface(_name, _ignoreCase) = notRequired "GetInterface" (nameText()) - override _.GetInterfaces() = notRequired "GetInterfaces" (nameText()) - override _.GetEvent(_name, _bindingAttr) = notRequired "GetEvent" (nameText()) - override _.GetEvents _bindingAttr = notRequired "GetEvents" (nameText()) - override _.GetProperties _bindingAttr = notRequired "GetProperties" (nameText()) - override _.GetPropertyImpl(_name, _bindingAttr, _binder, _returnType, _types, _modifiers) = notRequired "GetPropertyImpl" (nameText()) - override _.GetNestedTypes _bindingAttr = notRequired "GetNestedTypes" (nameText()) - override _.GetNestedType(_name, _bindingAttr) = notRequired "GetNestedType" (nameText()) - override _.GetAttributeFlagsImpl() = notRequired "GetAttributeFlagsImpl" (nameText()) - override this.UnderlyingSystemType = - match kind with - | SymbolKind.SDArray - | SymbolKind.Array _ - | SymbolKind.Pointer - | SymbolKind.FSharpTypeAbbreviation _ - | SymbolKind.ByRef -> upcast this - | SymbolKind.Generic gty -> gty.UnderlyingSystemType -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = ([| |] :> IList<_>) -#endif - override _.MemberType = notRequired "MemberType" (nameText()) - override _.GetMember(_name,_mt,_bindingAttr) = notRequired "GetMember" (nameText()) - override _.GUID = notRequired "GUID" (nameText()) - override _.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired "InvokeMember" (nameText()) - override _.AssemblyQualifiedName = notRequired "AssemblyQualifiedName" (nameText()) - override _.GetConstructorImpl(_bindingAttr, _binder, _callConvention, _types, _modifiers) = notRequired "GetConstructorImpl" (nameText()) - override _.GetCustomAttributes(_inherit) = [| |] - override _.GetCustomAttributes(_attributeType, _inherit) = [| |] - override _.IsDefined(_attributeType, _inherit) = false - // FSharp.Data addition: this was added to support arrays of arrays - override this.MakeArrayType() = ProvidedSymbolType(SymbolKind.SDArray, [this]) :> Type - override this.MakeArrayType arg = ProvidedSymbolType(SymbolKind.Array arg, [this]) :> Type - -type ProvidedSymbolMethod(genericMethodDefinition: MethodInfo, parameters: Type list) = - inherit System.Reflection.MethodInfo() - - let convParam (p:ParameterInfo) = - { new System.Reflection.ParameterInfo() with - override _.Name = p.Name - override _.ParameterType = ProvidedSymbolType.convType parameters p.ParameterType - override _.Attributes = p.Attributes - override _.RawDefaultValue = p.RawDefaultValue -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = p.GetCustomAttributesData() -#endif - } + override this.Equals(other: obj) = eqTypeObj this other - override this.IsGenericMethod = - (if this.DeclaringType.IsGenericType then this.DeclaringType.GetGenericArguments().Length else 0) < parameters.Length + override this.Equals(otherTy: Type) = eqTypes this otherTy - override this.GetGenericArguments() = - Seq.skip (if this.DeclaringType.IsGenericType then this.DeclaringType.GetGenericArguments().Length else 0) parameters |> Seq.toArray + override this.IsAssignableFrom(otherTy: Type) = isAssignableFrom this otherTy - override _.GetGenericMethodDefinition() = genericMethodDefinition + override this.IsSubclassOf(otherTy: Type) = isSubclassOf this otherTy - override _.DeclaringType = ProvidedSymbolType.convType parameters genericMethodDefinition.DeclaringType - override _.ToString() = "Method " + genericMethodDefinition.Name - override _.Name = genericMethodDefinition.Name - override _.MetadataToken = genericMethodDefinition.MetadataToken - override _.Attributes = genericMethodDefinition.Attributes - override _.CallingConvention = genericMethodDefinition.CallingConvention - override _.MemberType = genericMethodDefinition.MemberType + member __.Kind = kind - override _.IsDefined(_attributeType, _inherit) : bool = notRequired "IsDefined" genericMethodDefinition.Name - override _.ReturnType = ProvidedSymbolType.convType parameters genericMethodDefinition.ReturnType - override _.GetParameters() = genericMethodDefinition.GetParameters() |> Array.map convParam - override _.ReturnParameter = genericMethodDefinition.ReturnParameter |> convParam - override _.ReturnTypeCustomAttributes = notRequired "ReturnTypeCustomAttributes" genericMethodDefinition.Name - override _.GetBaseDefinition() = notRequired "GetBaseDefinition" genericMethodDefinition.Name - override _.GetMethodImplementationFlags() = notRequired "GetMethodImplementationFlags" genericMethodDefinition.Name - override _.MethodHandle = notRequired "MethodHandle" genericMethodDefinition.Name - override _.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired "Invoke" genericMethodDefinition.Name - override _.ReflectedType = notRequired "ReflectedType" genericMethodDefinition.Name - override _.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" genericMethodDefinition.Name - override _.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" genericMethodDefinition.Name + member __.Args = typeArgs + member __.IsFSharpTypeAbbreviation = match kind with FSharpTypeAbbreviation _ -> true | _ -> false + // For example, int + member __.IsFSharpUnitAnnotated = match kind with ProvidedTypeSymbolKind.Generic gtd -> not gtd.IsGenericTypeDefinition | _ -> false -type ProvidedTypeBuilder() = - static member MakeGenericType(genericTypeDefinition, genericArguments) = ProvidedSymbolType(Generic genericTypeDefinition, genericArguments) :> Type - static member MakeGenericMethod(genericMethodDefinition, genericArguments) = ProvidedSymbolMethod(genericMethodDefinition, genericArguments) :> MethodInfo + override __.GetConstructorImpl(_bindingFlags, _binder, _callConventions, _types, _modifiers) = null -[] -type ProvidedMeasureBuilder() = + override this.GetMethodImpl(name, bindingFlags, _binderBinder, _callConvention, _types, _modifiers) = + match kind with + | Generic gtd -> + let ty = gtd.GetGenericTypeDefinition().MakeGenericType(typeArgs) + ty.GetMethod(name, bindingFlags) + | _ -> notRequired this "GetMethodImpl" this.FullName - // TODO: this shouldn't be hardcoded, but without creating a dependency on FSharp.Compiler.Service - // there seems to be no way to check if a type abbreviation exists - let unitNamesTypeAbbreviations = - [ "meter"; "hertz"; "newton"; "pascal"; "joule"; "watt"; "coulomb"; - "volt"; "farad"; "ohm"; "siemens"; "weber"; "tesla"; "henry" - "lumen"; "lux"; "becquerel"; "gray"; "sievert"; "katal" ] - |> Set.ofList - let unitSymbolsTypeAbbreviations = - [ "m"; "kg"; "s"; "A"; "K"; "mol"; "cd"; "Hz"; "N"; "Pa"; "J"; "W"; "C" - "V"; "F"; "S"; "Wb"; "T"; "lm"; "lx"; "Bq"; "Gy"; "Sv"; "kat"; "H" ] - |> Set.ofList + override this.GetField(_name, _bindingFlags) = notRequired this "GetField" this.FullName - static let theBuilder = ProvidedMeasureBuilder() - static member Default = theBuilder - member _.One = typeof - member _.Product (m1,m2) = typedefof>.MakeGenericType [| m1;m2 |] - member _.Inverse m = typedefof>.MakeGenericType [| m |] - member b.Ratio (m1, m2) = b.Product(m1, b.Inverse m2) - member b.Square m = b.Product(m, m) + override this.GetPropertyImpl(_name, _bindingFlags, _binder, _returnType, _types, _modifiers) = notRequired this "GetPropertyImpl" this.FullName - // FSharp.Data change: if the unit is not a valid type, instead - // of assuming it's a type abbreviation, which may not be the case and cause a - // problem later on, check the list of valid abbreviations - member _.SI (m:string) = - let mLowerCase = m.ToLowerInvariant() - let abbreviation = - if unitNamesTypeAbbreviations.Contains mLowerCase then - Some ("Microsoft.FSharp.Data.UnitSystems.SI.UnitNames", mLowerCase) - elif unitSymbolsTypeAbbreviations.Contains m then - Some ("Microsoft.FSharp.Data.UnitSystems.SI.UnitSymbols", m) - else - None - match abbreviation with - | Some (ns, unitName) -> - ProvidedSymbolType - (SymbolKind.FSharpTypeAbbreviation - (typeof.Assembly, - ns, - [| unitName |]), - []) :> Type - | None -> - typedefof>.Assembly.GetType("Microsoft.FSharp.Data.UnitSystems.SI.UnitNames." + mLowerCase) + override this.GetEvent(_name, _bindingFlags) = notRequired this "GetEvent" this.FullName - member _.AnnotateType (basicType, annotation) = ProvidedSymbolType(Generic basicType, annotation) :> Type + override this.GetNestedType(_name, _bindingFlags) = notRequired this "GetNestedType" this.FullName + override this.GetConstructors _bindingFlags = notRequired this "GetConstructors" this.FullName + override this.GetMethods _bindingFlags = notRequired this "GetMethods" this.FullName -[] -type TypeContainer = - | Namespace of Assembly * string // namespace - | Type of System.Type - | TypeToBeDecided + override this.GetFields _bindingFlags = notRequired this "GetFields" this.FullName -module GlobalProvidedAssemblyElementsTable = - let theTable = Dictionary>() + override this.GetProperties _bindingFlags = notRequired this "GetProperties" this.FullName -type ProvidedTypeDefinition(container:TypeContainer,className : string, baseType : Type option) as this = - inherit Type() + override this.GetEvents _bindingFlags = notRequired this "GetEvents" this.FullName - do match container, !ProvidedTypeDefinition.Logger with - | TypeContainer.Namespace _, Some logger -> logger (sprintf "Creating ProvidedTypeDefinition %s [%d]" className (System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode this)) - | _ -> () + override this.GetNestedTypes _bindingFlags = notRequired this "GetNestedTypes" this.FullName - // state - let mutable attributes = - TypeAttributes.Public ||| - TypeAttributes.Class ||| - TypeAttributes.Sealed ||| - enum (int32 TypeProviderTypeAttributes.IsErased) + override this.GetMembers _bindingFlags = notRequired this "GetMembers" this.FullName + override this.GetInterface(_name, _ignoreCase) = notRequired this "GetInterface" this.FullName - let mutable enumUnderlyingType = typeof - let mutable baseType = lazy baseType - let mutable membersKnown = ResizeArray() - let mutable membersQueue = ResizeArray<(unit -> list)>() - let mutable staticParams = [ ] - let mutable staticParamsApply = None - let mutable container = container - let mutable interfaceImpls = ResizeArray() - let mutable interfaceImplsDelayed = ResizeArray list>() - let mutable methodOverrides = ResizeArray() + override this.GetInterfaces() = notRequired this "GetInterfaces" this.FullName - // members API - let getMembers() = - if membersQueue.Count > 0 then - let elems = membersQueue |> Seq.toArray // take a copy in case more elements get added - membersQueue.Clear() - for f in elems do - for i in f() do - membersKnown.Add i - match i with - | :? ProvidedProperty as p -> - if p.CanRead then membersKnown.Add (p.GetGetMethod true) - if p.CanWrite then membersKnown.Add (p.GetSetMethod true) - | :? ProvidedEvent as e -> - membersKnown.Add (e.GetAddMethod true) - membersKnown.Add (e.GetRemoveMethod true) - | _ -> () - - membersKnown.ToArray() + override this.GetAttributeFlagsImpl() = getAttributeFlagsImpl this - // members API - let getInterfaces() = - if interfaceImplsDelayed.Count > 0 then - let elems = interfaceImplsDelayed |> Seq.toArray // take a copy in case more elements get added - interfaceImplsDelayed.Clear() - for f in elems do - for i in f() do - interfaceImpls.Add i - - interfaceImpls.ToArray() + override this.UnderlyingSystemType = + match kind with + | ProvidedTypeSymbolKind.SDArray + | ProvidedTypeSymbolKind.Array _ + | ProvidedTypeSymbolKind.Pointer + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation _ + | ProvidedTypeSymbolKind.ByRef -> upcast this + | ProvidedTypeSymbolKind.Generic gty -> gty.UnderlyingSystemType - let mutable theAssembly = - lazy - match container with - | TypeContainer.Namespace (theAssembly, rootNamespace) -> - if theAssembly = null then failwith "Null assemblies not allowed" - if rootNamespace<>null && rootNamespace.Length=0 then failwith "Use 'null' for global namespace" - theAssembly - | TypeContainer.Type superTy -> superTy.Assembly - | TypeContainer.TypeToBeDecided -> failwith (sprintf "type '%s' was not added as a member to a declaring type" className) - - let rootNamespace = - lazy - match container with - | TypeContainer.Namespace (_,rootNamespace) -> rootNamespace - | TypeContainer.Type enclosingTyp -> enclosingTyp.Namespace - | TypeContainer.TypeToBeDecided -> failwith (sprintf "type '%s' was not added as a member to a declaring type" className) + override __.GetCustomAttributesData() = ([| |] :> IList<_>) - let declaringType = - lazy - match container with - | TypeContainer.Namespace _ -> null - | TypeContainer.Type enclosingTyp -> enclosingTyp - | TypeContainer.TypeToBeDecided -> failwith (sprintf "type '%s' was not added as a member to a declaring type" className) + override this.MemberType = notRequired this "MemberType" this.FullName - let fullName = - lazy - match container with - | TypeContainer.Type declaringType -> declaringType.FullName + "+" + className - | TypeContainer.Namespace (_,namespaceName) -> - if namespaceName="" then failwith "use null for global namespace" - match namespaceName with - | null -> className - | _ -> namespaceName + "." + className - | TypeContainer.TypeToBeDecided -> failwith (sprintf "type '%s' was not added as a member to a declaring type" className) - - let patchUpAddedMemberInfo (this:Type) (m:MemberInfo) = - match m with - | :? ProvidedConstructor as c -> c.DeclaringTypeImpl <- this // patch up "declaring type" on provided MethodInfo - | :? ProvidedMethod as m -> m.DeclaringTypeImpl <- this // patch up "declaring type" on provided MethodInfo - | :? ProvidedProperty as p -> p.DeclaringTypeImpl <- this // patch up "declaring type" on provided MethodInfo - | :? ProvidedEvent as e -> e.DeclaringTypeImpl <- this // patch up "declaring type" on provided MethodInfo - | :? ProvidedTypeDefinition as t -> t.DeclaringTypeImpl <- this - | :? ProvidedLiteralField as l -> l.DeclaringTypeImpl <- this - | :? ProvidedField as l -> l.DeclaringTypeImpl <- this - | _ -> () + override this.GetMember(_name, _mt, _bindingFlags) = notRequired this "GetMember" this.FullName - let customAttributesImpl = CustomAttributesImpl() - - member _.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction - member _.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction - member _.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc - member _.AddObsoleteAttribute (message,?isError) = customAttributesImpl.AddObsolete (message,defaultArg isError false) - member _.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) - member _.HideObjectMethods with set v = customAttributesImpl.HideObjectMethods <- v - member _.NonNullable with set v = customAttributesImpl.NonNullable <- v - member _.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData() - member _.AddCustomAttribute attribute = customAttributesImpl.AddCustomAttribute attribute -#if FX_NO_CUSTOMATTRIBUTEDATA -#else - override _.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() -#endif + override this.GUID = notRequired this "GUID" this.FullName - member _.ResetEnclosingType (ty) = - container <- TypeContainer.Type ty - new (assembly:Assembly,namespaceName,className,baseType) = new ProvidedTypeDefinition(TypeContainer.Namespace (assembly,namespaceName), className, baseType) - new (className,baseType) = new ProvidedTypeDefinition(TypeContainer.TypeToBeDecided, className, baseType) - // state ops + override this.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired this "InvokeMember" this.FullName - override _.UnderlyingSystemType = typeof + override this.AssemblyQualifiedName = notRequired this "AssemblyQualifiedName" this.FullName - member _.SetEnumUnderlyingType(ty) = enumUnderlyingType <- ty + override __.GetCustomAttributes(_inherit) = emptyAttributes - override _.GetEnumUnderlyingType() = if this.IsEnum then enumUnderlyingType else invalidOp "not enum type" + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType - member _.SetBaseType t = baseType <- lazy Some t + override __.IsDefined(_attributeType, _inherit) = false - member _.SetBaseTypeDelayed baseTypeFunction = baseType <- lazy (Some (baseTypeFunction())) + override this.MakeArrayType() = ProvidedTypeSymbol(ProvidedTypeSymbolKind.SDArray, [this], typeBuilder) :> Type - member _.SetAttributes x = attributes <- x + override this.MakeArrayType arg = ProvidedTypeSymbol(ProvidedTypeSymbolKind.Array arg, [this], typeBuilder) :> Type - // Add MemberInfos - member _.AddMembersDelayed(membersFunction : unit -> list<#MemberInfo>) = - membersQueue.Add (fun () -> membersFunction() |> List.map (fun x -> patchUpAddedMemberInfo this x; x :> MemberInfo )) +#if NETCOREAPP + // See bug https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues/236 + override __.IsSZArray = + match kind with + | ProvidedTypeSymbolKind.SDArray -> true + | _ -> false +#endif - member _.AddMembers(memberInfos:list<#MemberInfo>) = (* strict *) - memberInfos |> List.iter (patchUpAddedMemberInfo this) // strict: patch up now - membersQueue.Add (fun () -> memberInfos |> List.map (fun x -> x :> MemberInfo)) + override __.MetadataToken = + match kind with + | ProvidedTypeSymbolKind.SDArray -> typeof.MetadataToken + | ProvidedTypeSymbolKind.Array _ -> typeof.MetadataToken + | ProvidedTypeSymbolKind.Pointer -> typeof.MetadataToken + | ProvidedTypeSymbolKind.ByRef -> typeof.MetadataToken + | ProvidedTypeSymbolKind.Generic gty -> gty.MetadataToken + | ProvidedTypeSymbolKind.FSharpTypeAbbreviation _ -> typeof.MetadataToken - member _.AddMember(memberInfo:MemberInfo) = - this.AddMembers [memberInfo] + override this.GetEvents() = this.GetEvents(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.Static) // Needed because TypeDelegator.cs provides a delegting implementation of this, and we are self-delegating - member _.AddMemberDelayed(memberFunction : unit -> #MemberInfo) = - this.AddMembersDelayed(fun () -> [memberFunction()]) + override this.ToString() = this.FullName - member _.AddAssemblyTypesAsNestedTypesDelayed (assemblyf : unit -> System.Reflection.Assembly) = - let bucketByPath nodef tipf (items: (string list * 'Value) list) = - // Find all the items with an empty key list and call 'tipf' - let tips = - [ for (keylist,v) in items do - match keylist with - | [] -> yield tipf v - | _ -> () ] +type ProvidedSymbolMethod(genericMethodDefinition: MethodInfo, parameters: Type[], typeBuilder: ITypeBuilder) = + inherit MethodInfo() - // Find all the items with a non-empty key list. Bucket them together by - // the first key. For each bucket, call 'nodef' on that head key and the bucket. - let nodes = - let buckets = new Dictionary<_,_>(10) - for (keylist,v) in items do - match keylist with - | [] -> () - | key::rest -> - buckets.[key] <- (rest,v) :: (if buckets.ContainsKey key then buckets.[key] else []); + let convParam (p:ParameterInfo) = + { new ParameterInfo() with + override __.Name = p.Name + override __.ParameterType = instType typeBuilder (parameters, [| |]) p.ParameterType + override __.Attributes = p.Attributes + override __.RawDefaultValue = p.RawDefaultValue + override __.GetCustomAttributesData() = p.GetCustomAttributesData() + } - [ for (KeyValue(key,items)) in buckets -> nodef key items ] + override this.IsGenericMethod = + (if this.DeclaringType.IsGenericType then this.DeclaringType.GetGenericArguments().Length else 0) < parameters.Length - tips @ nodes - this.AddMembersDelayed (fun _ -> - let topTypes = [ for ty in assemblyf().GetTypes() do - if not ty.IsNested then - let namespaceParts = match ty.Namespace with null -> [] | s -> s.Split '.' |> Array.toList - yield namespaceParts, ty ] - let rec loop types = - types - |> bucketByPath - (fun namespaceComponent typesUnderNamespaceComponent -> - let t = ProvidedTypeDefinition(namespaceComponent, baseType = Some typeof) - t.AddMembers (loop typesUnderNamespaceComponent) - (t :> Type)) - (fun ty -> ty) - loop topTypes) + override this.GetGenericArguments() = + Seq.skip (if this.DeclaringType.IsGenericType then this.DeclaringType.GetGenericArguments().Length else 0) parameters |> Seq.toArray - /// Abstract a type to a parametric-type. Requires "formal parameters" and "instantiation function". - member _.DefineStaticParameters(staticParameters : list, apply : (string -> obj[] -> ProvidedTypeDefinition)) = - staticParams <- staticParameters - staticParamsApply <- Some apply - - /// Get ParameterInfo[] for the parametric type parameters (//s GetGenericParameters) - member _.GetStaticParameters() = [| for p in staticParams -> p :> ParameterInfo |] - - /// Instantiate parametrics type - member _.MakeParametricType(name:string,args:obj[]) = - if staticParams.Length>0 then - if staticParams.Length <> args.Length then - failwith (sprintf "ProvidedTypeDefinition: expecting %d static parameters but given %d for type %s" staticParams.Length args.Length (fullName.Force())) - match staticParamsApply with - | None -> failwith "ProvidedTypeDefinition: DefineStaticParameters was not called" - | Some f -> f name args + override __.GetGenericMethodDefinition() = genericMethodDefinition - else - failwith (sprintf "ProvidedTypeDefinition: static parameters supplied but not expected for %s" (fullName.Force())) + override __.DeclaringType = instType typeBuilder (parameters, [| |]) genericMethodDefinition.DeclaringType + override __.ToString() = "Method " + genericMethodDefinition.Name + override __.Name = genericMethodDefinition.Name + override __.MetadataToken = genericMethodDefinition.MetadataToken + override __.Attributes = genericMethodDefinition.Attributes + override __.CallingConvention = genericMethodDefinition.CallingConvention + override __.MemberType = genericMethodDefinition.MemberType - member _.DeclaringTypeImpl - with set x = - match container with TypeContainer.TypeToBeDecided -> () | _ -> failwith (sprintf "container type for '%s' was already set to '%s'" this.FullName x.FullName); - container <- TypeContainer.Type x + override this.IsDefined(_attributeType, _inherit): bool = notRequired this "IsDefined" genericMethodDefinition.Name + override __.ReturnType = instType typeBuilder (parameters, [| |]) genericMethodDefinition.ReturnType + override __.GetParameters() = genericMethodDefinition.GetParameters() |> Array.map convParam + override __.ReturnParameter = genericMethodDefinition.ReturnParameter |> convParam + override this.ReturnTypeCustomAttributes = notRequired this "ReturnTypeCustomAttributes" genericMethodDefinition.Name + override this.GetBaseDefinition() = notRequired this "GetBaseDefinition" genericMethodDefinition.Name + override this.GetMethodImplementationFlags() = notRequired this "GetMethodImplementationFlags" genericMethodDefinition.Name + override this.MethodHandle = notRequired this "MethodHandle" genericMethodDefinition.Name + override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" genericMethodDefinition.Name + override this.ReflectedType = notRequired this "ReflectedType" genericMethodDefinition.Name + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType - // Implement overloads - override _.Assembly = theAssembly.Force() +//-------------------------------------------------------------------------------- +// ProvidedMethod, ProvidedConstructor, ProvidedTypeDefinition and other provided objects - member _.SetAssembly assembly = theAssembly <- lazy assembly - member _.SetAssemblyLazy assembly = theAssembly <- assembly +[] +module Misc = - override _.FullName = fullName.Force() - override _.Namespace = rootNamespace.Force() + let mkParamArrayCustomAttributeData() = + { new CustomAttributeData() with + member __.Constructor = typeof.GetConstructors().[0] + member __.ConstructorArguments = upcast [| |] + member __.NamedArguments = upcast [| |] } - override _.BaseType = match baseType.Value with Some ty -> ty | None -> null - - // Constructors - override _.GetConstructors bindingAttr = - [| for m in this.GetMembers bindingAttr do - if m.MemberType = MemberTypes.Constructor then - yield (m :?> ConstructorInfo) |] - // Methods - override _.GetMethodImpl(name, bindingAttr, _binderBinder, _callConvention, _types, _modifiers) : MethodInfo = - let membersWithName = - [ for m in this.GetMembers(bindingAttr) do - if m.MemberType.HasFlag(MemberTypes.Method) && m.Name = name then - yield m ] - match membersWithName with - | [] -> null - | [meth] -> meth :?> MethodInfo - | _several -> failwith "GetMethodImpl. not support overloads" - - override _.GetMethods bindingAttr = - this.GetMembers bindingAttr - |> Array.filter (fun m -> m.MemberType.HasFlag(MemberTypes.Method)) - |> Array.map (fun m -> m :?> MethodInfo) - - // Fields - override _.GetField(name, bindingAttr) = - let fields = [| for m in this.GetMembers bindingAttr do - if m.MemberType.HasFlag(MemberTypes.Field) && (name = null || m.Name = name) then // REVIEW: name = null. Is that a valid query?! - yield m |] - if fields.Length > 0 then fields.[0] :?> FieldInfo else null - - override _.GetFields bindingAttr = - [| for m in this.GetMembers bindingAttr do if m.MemberType.HasFlag(MemberTypes.Field) then yield m :?> FieldInfo |] - - override _.GetInterface(_name, _ignoreCase) = notRequired "GetInterface" this.Name - - override _.GetInterfaces() = - [| yield! getInterfaces() |] - - member _.GetInterfaceImplementations() = - [| yield! getInterfaces() |] - - member _.AddInterfaceImplementation ityp = interfaceImpls.Add ityp - - member _.AddInterfaceImplementationsDelayed itypf = interfaceImplsDelayed.Add itypf - - member _.GetMethodOverrides() = - [| yield! methodOverrides |] - - member _.DefineMethodOverride (bodyMethInfo,declMethInfo) = methodOverrides.Add (bodyMethInfo, declMethInfo) - - // Events - override _.GetEvent(name, bindingAttr) = - let events = this.GetMembers bindingAttr - |> Array.filter(fun m -> m.MemberType.HasFlag(MemberTypes.Event) && (name = null || m.Name = name)) - if events.Length > 0 then events.[0] :?> EventInfo else null - - override _.GetEvents bindingAttr = - [| for m in this.GetMembers bindingAttr do if m.MemberType.HasFlag(MemberTypes.Event) then yield downcast m |] - - // Properties - override _.GetProperties bindingAttr = - [| for m in this.GetMembers bindingAttr do if m.MemberType.HasFlag(MemberTypes.Property) then yield downcast m |] - - override _.GetPropertyImpl(name, bindingAttr, binder, returnType, types, modifiers) = - if returnType <> null then failwith "Need to handle specified return type in GetPropertyImpl" - if types <> null then failwith "Need to handle specified parameter types in GetPropertyImpl" - if modifiers <> null then failwith "Need to handle specified modifiers in GetPropertyImpl" - if binder <> null then failwith "Need to handle binder in GetPropertyImpl" - let props = this.GetMembers bindingAttr |> Array.filter(fun m -> m.MemberType.HasFlag(MemberTypes.Property) && (name = null || m.Name = name)) // Review: nam = null, valid query!? - if props.Length > 0 then - props.[0] :?> PropertyInfo - else - null - // Nested Types - override _.MakeArrayType() = ProvidedSymbolType(SymbolKind.SDArray, [this]) :> Type - override _.MakeArrayType arg = ProvidedSymbolType(SymbolKind.Array arg, [this]) :> Type - override _.MakePointerType() = ProvidedSymbolType(SymbolKind.Pointer, [this]) :> Type - override _.MakeByRefType() = ProvidedSymbolType(SymbolKind.ByRef, [this]) :> Type - - // FSharp.Data addition: this method is used by Debug.fs and QuotationBuilder.fs - // Emulate the F# type provider type erasure mechanism to get the - // actual (erased) type. We erase ProvidedTypes to their base type - // and we erase array of provided type to array of base type. In the - // case of generics all the generic type arguments are also recursively + let mkEditorHideMethodsCustomAttributeData() = + { new CustomAttributeData() with + member __.Constructor = typeof.GetConstructors().[0] + member __.ConstructorArguments = upcast [| |] + member __.NamedArguments = upcast [| |] } + + let mkAllowNullLiteralCustomAttributeData value = + { new CustomAttributeData() with + member __.Constructor = typeof.GetConstructors().[0] + member __.ConstructorArguments = upcast [| CustomAttributeTypedArgument(typeof, value) |] + member __.NamedArguments = upcast [| |] } + + /// This makes an xml doc attribute w.r.t. an amortized computation of an xml doc string. + /// It is important that the text of the xml doc only get forced when poking on the ConstructorArguments + /// for the CustomAttributeData object. + let mkXmlDocCustomAttributeDataLazy(lazyText: Lazy) = + { new CustomAttributeData() with + member __.Constructor = typeof.GetConstructors().[0] + member __.ConstructorArguments = upcast [| CustomAttributeTypedArgument(typeof, lazyText.Force()) |] + member __.NamedArguments = upcast [| |] } + + let mkXmlDocCustomAttributeData(s:string) = mkXmlDocCustomAttributeDataLazy (lazy s) + + let mkDefinitionLocationAttributeCustomAttributeData(line:int, column:int, filePath:string) = + { new CustomAttributeData() with + member __.Constructor = typeof.GetConstructors().[0] + member __.ConstructorArguments = upcast [| |] + member __.NamedArguments = + upcast [| CustomAttributeNamedArgument(typeof.GetProperty("FilePath"), CustomAttributeTypedArgument(typeof, filePath)); + CustomAttributeNamedArgument(typeof.GetProperty("Line"), CustomAttributeTypedArgument(typeof, line)) ; + CustomAttributeNamedArgument(typeof.GetProperty("Column"), CustomAttributeTypedArgument(typeof, column)) + |] } + let mkObsoleteAttributeCustomAttributeData(message:string, isError: bool) = + { new CustomAttributeData() with + member __.Constructor = typeof.GetConstructors() |> Array.find (fun x -> x.GetParameters().Length = 2) + member __.ConstructorArguments = upcast [|CustomAttributeTypedArgument(typeof, message) ; CustomAttributeTypedArgument(typeof, isError) |] + member __.NamedArguments = upcast [| |] } + + let mkReflectedDefinitionCustomAttributeData() = + { new CustomAttributeData() with + member __.Constructor = typeof.GetConstructors().[0] + member __.ConstructorArguments = upcast [| |] + member __.NamedArguments = upcast [| |] } + + type CustomAttributesImpl(isTgt, customAttributesData) = + let customAttributes = ResizeArray() + let mutable hideObjectMethods = false + let mutable nonNullable = false + let mutable obsoleteMessage = None + let mutable xmlDocDelayed = None + let mutable xmlDocAlwaysRecomputed = None + let mutable hasParamArray = false + let mutable hasReflectedDefinition = false + + // XML doc text that we only compute once, if any. This must _not_ be forced until the ConstructorArguments + // property of the custom attribute is foced. + let xmlDocDelayedText = + lazy + (match xmlDocDelayed with None -> assert false; "" | Some f -> f()) + + // Custom atttributes that we only compute once + let customAttributesOnce = + lazy + [| + if not isTgt then + if hideObjectMethods then yield mkEditorHideMethodsCustomAttributeData() + if nonNullable then yield mkAllowNullLiteralCustomAttributeData false + match xmlDocDelayed with None -> () | Some _ -> customAttributes.Add(mkXmlDocCustomAttributeDataLazy xmlDocDelayedText) + match xmlDocAlwaysRecomputed with None -> () | Some f -> yield mkXmlDocCustomAttributeData (f()) + match obsoleteMessage with None -> () | Some s -> customAttributes.Add(mkObsoleteAttributeCustomAttributeData s) + if hasParamArray then yield mkParamArrayCustomAttributeData() + if hasReflectedDefinition then yield mkReflectedDefinitionCustomAttributeData() + yield! customAttributes + yield! customAttributesData() + |] + + member __.AddDefinitionLocation(line:int, column:int, filePath:string) = customAttributes.Add(mkDefinitionLocationAttributeCustomAttributeData(line, column, filePath)) + member __.AddObsolete(message: string, isError) = obsoleteMessage <- Some (message, isError) + member __.HasParamArray with get() = hasParamArray and set(v) = hasParamArray <- v + member __.HasReflectedDefinition with get() = hasReflectedDefinition and set(v) = hasReflectedDefinition <- v + member __.AddXmlDocComputed xmlDocFunction = xmlDocAlwaysRecomputed <- Some xmlDocFunction + member __.AddXmlDocDelayed xmlDocFunction = xmlDocDelayed <- Some xmlDocFunction + member __.AddXmlDoc xmlDoc = xmlDocDelayed <- Some (K xmlDoc) + member __.HideObjectMethods with get() = hideObjectMethods and set v = hideObjectMethods <- v + member __.NonNullable with get () = nonNullable and set v = nonNullable <- v + member __.AddCustomAttribute(attribute) = customAttributes.Add(attribute) + member __.GetCustomAttributesData() = + let attrs = customAttributesOnce.Force() + let attrsWithDocHack = + match xmlDocAlwaysRecomputed with + | None -> + attrs + | Some f -> + // Recomputed XML doc is evaluated on every call to GetCustomAttributesData() when in the IDE + [| for ca in attrs -> + if ca.Constructor.DeclaringType.Name = typeof.Name then + { new CustomAttributeData() with + member __.Constructor = ca.Constructor + member __.ConstructorArguments = upcast [| CustomAttributeTypedArgument(typeof, f()) |] + member __.NamedArguments = upcast [| |] } + else ca |] + attrsWithDocHack :> IList<_> + + +type ProvidedStaticParameter(isTgt: bool, parameterName:string, parameterType:Type, parameterDefaultValue:obj option, customAttributesData) = + inherit ParameterInfo() + + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + + new (parameterName:string, parameterType:Type, ?parameterDefaultValue:obj) = + ProvidedStaticParameter(false, parameterName, parameterType, parameterDefaultValue, (K [| |])) + + member __.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction + member __.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction + member __.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc + + member __.ParameterDefaultValue = parameterDefaultValue + member __.BelongsToTargetModel = isTgt + + override __.RawDefaultValue = defaultArg parameterDefaultValue null + override __.Attributes = if parameterDefaultValue.IsNone then enum 0 else ParameterAttributes.Optional + override __.Position = 0 + override __.ParameterType = parameterType + override __.Name = parameterName + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + +type ProvidedParameter(isTgt: bool, parameterName:string, attrs, parameterType:Type, optionalValue:obj option, customAttributesData) = + + inherit ParameterInfo() + + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + + new (parameterName:string, parameterType:Type, ?isOut:bool, ?optionalValue:obj) = + ProvidedParameter(false, parameterName, parameterType, isOut, optionalValue) + + new (_isTgt, parameterName:string, parameterType:Type, isOut:bool option, optionalValue:obj option) = + let isOut = defaultArg isOut false + let attrs = (if isOut then ParameterAttributes.Out else enum 0) ||| + (match optionalValue with None -> enum 0 | Some _ -> ParameterAttributes.Optional ||| ParameterAttributes.HasDefault) + ProvidedParameter(false, parameterName, attrs, parameterType, optionalValue, K [| |]) + + member __.IsParamArray with set(v) = customAttributesImpl.HasParamArray <- v + member __.IsReflectedDefinition with set(v) = customAttributesImpl.HasReflectedDefinition <- v + member __.OptionalValue = optionalValue + member __.HasDefaultParameterValue = Option.isSome optionalValue + member __.BelongsToTargetModel = isTgt + member __.AddCustomAttribute(attribute) = customAttributesImpl.AddCustomAttribute(attribute) + + override __.Name = parameterName + override __.ParameterType = parameterType + override __.Attributes = attrs + override __.RawDefaultValue = defaultArg optionalValue null + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + +and ProvidedConstructor(isTgt: bool, attrs: MethodAttributes, parameters: ProvidedParameter[], invokeCode: (Expr list -> Expr), baseCall, isImplicitCtor, customAttributesData) = + + inherit ConstructorInfo() + let parameterInfos = parameters |> Array.map (fun p -> p :> ParameterInfo) + let mutable baseCall = baseCall + let mutable declaringType : ProvidedTypeDefinition option = None + let mutable isImplicitCtor = isImplicitCtor + let mutable attrs = attrs + let isStatic() = hasFlag attrs MethodAttributes.Static + + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + + new (parameters, invokeCode) = + ProvidedConstructor(false, MethodAttributes.Public ||| MethodAttributes.RTSpecialName ||| MethodAttributes.HideBySig, Array.ofList parameters, invokeCode, None, false, K [| |]) + + member __.IsTypeInitializer + with get() = isStatic() && hasFlag attrs MethodAttributes.Private + and set(v) = + let typeInitializerAttributes = MethodAttributes.Static ||| MethodAttributes.Private + attrs <- if v then attrs ||| typeInitializerAttributes else attrs &&& ~~~typeInitializerAttributes + + member __.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction + member __.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction + member __.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc + member __.AddObsoleteAttribute (message, ?isError) = customAttributesImpl.AddObsolete (message, defaultArg isError false) + member __.AddDefinitionLocation(line, column, filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) + + member __.PatchDeclaringType x = patchOption declaringType (fun () -> declaringType <- Some x) + member this.BaseConstructorCall + with set (d:Expr list -> (ConstructorInfo * Expr list)) = + match baseCall with + | None -> baseCall <- Some d + | Some _ -> failwithf "ProvidedConstructor: base call already given for '%s'" this.Name + + member __.IsImplicitConstructor with get() = isImplicitCtor and set v = isImplicitCtor <- v + member __.BaseCall = baseCall + member __.Parameters = parameters + member __.GetInvokeCode args = invokeCode args + member __.BelongsToTargetModel = isTgt + member __.DeclaringProvidedType = declaringType + member this.IsErased = (nonNone "DeclaringType" this.DeclaringProvidedType).IsErased + + // Implement overloads + override __.GetParameters() = parameterInfos + override __.Attributes = attrs + override __.Name = if isStatic() then ".cctor" else ".ctor" + override __.DeclaringType = declaringType |> nonNone "DeclaringType" :> Type + override __.IsDefined(_attributeType, _inherit) = true + + override this.Invoke(_invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetMethodImplementationFlags() = notRequired this "GetMethodImplementationFlags" this.Name + override this.MethodHandle = notRequired this "MethodHandle" this.Name + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + +and ProvidedMethod(isTgt: bool, methodName: string, attrs: MethodAttributes, parameters: ProvidedParameter[], returnType: Type, invokeCode: (Expr list -> Expr) option, staticParams, staticParamsApply, customAttributesData) = + inherit MethodInfo() + let parameterInfos = parameters |> Array.map (fun p -> p :> ParameterInfo) + + let mutable declaringType : ProvidedTypeDefinition option = None + let mutable attrs = attrs + let mutable staticParams = staticParams + let mutable staticParamsApply = staticParamsApply + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + let mutable returnTypeFixCache = None + + /// The public constructor for the design-time/source model + new (methodName, parameters, returnType, ?invokeCode, ?isStatic) = + let isStatic = defaultArg isStatic false + let attrs = if isStatic then MethodAttributes.Public ||| MethodAttributes.Static else MethodAttributes.Public + ProvidedMethod(false, methodName, attrs, Array.ofList parameters, returnType, invokeCode, [], None, K [| |]) + + member __.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction + member __.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction + member __.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc + member __.AddObsoleteAttribute (message, ?isError) = customAttributesImpl.AddObsolete (message, defaultArg isError false) + member __.AddDefinitionLocation(line, column, filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) + member __.AddCustomAttribute(attribute) = customAttributesImpl.AddCustomAttribute(attribute) + + member __.SetMethodAttrs attributes = attrs <- attributes + member __.AddMethodAttrs attributes = attrs <- attrs ||| attributes + member __.PatchDeclaringType x = patchOption declaringType (fun () -> declaringType <- Some x) + + /// Abstract a type to a parametric-type. Requires "formal parameters" and "instantiation function". + member __.DefineStaticParameters(parameters: ProvidedStaticParameter list, instantiationFunction: (string -> obj[] -> ProvidedMethod)) = + staticParams <- parameters + staticParamsApply <- Some instantiationFunction + + /// Get ParameterInfo[] for the parametric type parameters + member __.GetStaticParametersInternal() = [| for p in staticParams -> p :> ParameterInfo |] + + /// Instantiate parametric method + member this.ApplyStaticArguments(mangledName:string, args:obj[]) = + if staticParams.Length <> args.Length then + failwithf "ProvidedMethod: expecting %d static parameters but given %d for method %s" staticParams.Length args.Length methodName + if staticParams.Length > 0 then + match staticParamsApply with + | None -> failwith "ProvidedMethod: DefineStaticParameters was not called" + | Some f -> f mangledName args + else + this + + member __.Parameters = parameters + member __.GetInvokeCode = invokeCode + member __.StaticParams = staticParams + member __.StaticParamsApply = staticParamsApply + member __.BelongsToTargetModel = isTgt + member __.DeclaringProvidedType = declaringType + member this.IsErased = (nonNone "DeclaringType" this.DeclaringProvidedType).IsErased + + // Implement overloads + override __.GetParameters() = parameterInfos + + override this.Attributes = + match invokeCode, this.DeclaringProvidedType with + | None, Some pt when pt.IsInterface || pt.IsAbstract -> + attrs ||| MethodAttributes.Abstract ||| MethodAttributes.Virtual ||| MethodAttributes.HideBySig ||| MethodAttributes.NewSlot + | _ -> attrs + + + override __.Name = methodName + + override __.DeclaringType = declaringType |> nonNone "DeclaringType" :> Type + + override __.IsDefined(_attributeType, _inherit): bool = true + + override __.MemberType = MemberTypes.Method + + override x.CallingConvention = + let cc = CallingConventions.Standard + let cc = if not x.IsStatic then cc ||| CallingConventions.HasThis else cc + cc + + override __.ReturnType = + if isTgt then + match returnTypeFixCache with + | Some returnTypeFix -> returnTypeFix + | None -> + let returnTypeFix = + match returnType.Namespace, returnType.Name with + | "System", "Void"-> + if ImportProvidedMethodBaseAsILMethodRef_OnStack_HACK() then + typeof + else + returnType + | _ -> returnType + returnTypeFixCache <- Some returnTypeFix + returnTypeFix + else + returnType + + override __.ReturnParameter = null // REVIEW: Give it a name and type? + + override __.ToString() = "Method " + methodName + + // These don't have to return fully accurate results - they are used + // by the F# Quotations library function SpecificCall as a pre-optimization + // when comparing methods + override __.MetadataToken = genToken() + override __.MethodHandle = RuntimeMethodHandle() + + override this.ReturnTypeCustomAttributes = notRequired this "ReturnTypeCustomAttributes" methodName + override this.GetBaseDefinition() = notRequired this "GetBaseDefinition" methodName + override this.GetMethodImplementationFlags() = notRequired this "GetMethodImplementationFlags" methodName + override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" methodName + override this.ReflectedType = notRequired this "ReflectedType" methodName + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + + +and ProvidedProperty(isTgt: bool, propertyName: string, attrs: PropertyAttributes, propertyType: Type, isStatic: bool, getter: (unit -> MethodInfo) option, setter: (unit -> MethodInfo) option, indexParameters: ProvidedParameter[], customAttributesData) = + inherit PropertyInfo() + + let mutable declaringType : ProvidedTypeDefinition option = None + + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + + /// The public constructor for the design-time/source model + new (propertyName, propertyType, ?getterCode, ?setterCode, ?isStatic, ?indexParameters) = + let isStatic = defaultArg isStatic false + let indexParameters = defaultArg indexParameters [] + let pattrs = (if isStatic then MethodAttributes.Static else enum(0)) ||| MethodAttributes.Public ||| MethodAttributes.SpecialName + let getter = getterCode |> Option.map (fun _ -> ProvidedMethod(false, "get_" + propertyName, pattrs, Array.ofList indexParameters, propertyType, getterCode, [], None, K [| |]) :> MethodInfo) + let setter = setterCode |> Option.map (fun _ -> ProvidedMethod(false, "set_" + propertyName, pattrs, [| yield! indexParameters; yield ProvidedParameter(false, "value", propertyType, isOut=Some false, optionalValue=None) |], typeof, setterCode, [], None, K [| |]) :> MethodInfo) + ProvidedProperty(false, propertyName, PropertyAttributes.None, propertyType, isStatic, Option.map K getter, Option.map K setter, Array.ofList indexParameters, K [| |]) + + member __.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction + member __.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction + member __.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc + member __.AddObsoleteAttribute (message, ?isError) = customAttributesImpl.AddObsolete (message, defaultArg isError false) + member __.AddDefinitionLocation(line, column, filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) + member __.AddCustomAttribute attribute = customAttributesImpl.AddCustomAttribute attribute + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + + member __.PatchDeclaringType x = + if not isTgt then + match getter with Some f -> (match f() with (:? ProvidedMethod as g) -> g.PatchDeclaringType x | _ -> ()) | _ -> () + match setter with Some f -> (match f() with (:? ProvidedMethod as s) -> s.PatchDeclaringType x | _ -> ()) | _ -> () + patchOption declaringType (fun () -> declaringType <- Some x) + + member __.IsStatic = isStatic + member __.IndexParameters = indexParameters + member __.BelongsToTargetModel = isTgt + member __.Getter = getter + member __.Setter = setter + + override __.PropertyType = propertyType + override this.SetValue(_obj, _value, _invokeAttr, _binder, _index, _culture) = notRequired this "SetValue" propertyName + override this.GetAccessors _nonPublic = notRequired this "nonPublic" propertyName + override __.GetGetMethod _nonPublic = match getter with None -> null | Some g -> g() + override __.GetSetMethod _nonPublic = match setter with None -> null | Some s -> s() + override __.GetIndexParameters() = [| for p in indexParameters -> upcast p |] + override __.Attributes = attrs + override __.CanRead = getter.IsSome + override __.CanWrite = setter.IsSome + override this.GetValue(_obj, _invokeAttr, _binder, _index, _culture): obj = notRequired this "GetValue" propertyName + override __.Name = propertyName + override __.DeclaringType = declaringType |> nonNone "DeclaringType":> Type + override __.MemberType: MemberTypes = MemberTypes.Property + + override this.ReflectedType = notRequired this "ReflectedType" propertyName + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType + override this.IsDefined(_attributeType, _inherit) = notRequired this "IsDefined" propertyName + +and ProvidedEvent(isTgt: bool, eventName:string, attrs: EventAttributes, eventHandlerType:Type, isStatic: bool, adder: (unit -> MethodInfo), remover: (unit -> MethodInfo), customAttributesData) = + inherit EventInfo() + + let mutable declaringType : ProvidedTypeDefinition option = None + + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + + new (eventName, eventHandlerType, adderCode, removerCode, ?isStatic) = + let isStatic = defaultArg isStatic false + let pattrs = (if isStatic then MethodAttributes.Static else enum(0)) ||| MethodAttributes.Public ||| MethodAttributes.SpecialName + let adder = ProvidedMethod(false, "add_" + eventName, pattrs, [| ProvidedParameter(false, "handler", eventHandlerType, isOut=Some false, optionalValue=None) |], typeof, Some adderCode, [], None, K [| |]) :> MethodInfo + let remover = ProvidedMethod(false, "remove_" + eventName, pattrs, [| ProvidedParameter(false, "handler", eventHandlerType, isOut=Some false, optionalValue=None) |], typeof, Some removerCode, [], None, K [| |]) :> MethodInfo + ProvidedEvent(false, eventName, EventAttributes.None, eventHandlerType, isStatic, K adder, K remover, K [| |]) + + member __.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction + member __.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction + member __.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc + member __.AddDefinitionLocation(line, column, filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) + + member __.PatchDeclaringType x = + if not isTgt then + match adder() with :? ProvidedMethod as a -> a.PatchDeclaringType x | _ -> () + match remover() with :? ProvidedMethod as r -> r.PatchDeclaringType x | _ -> () + patchOption declaringType (fun () -> declaringType <- Some x) + + member __.IsStatic = isStatic + member __.Adder = adder() + member __.Remover = remover() + member __.BelongsToTargetModel = isTgt + + override __.EventHandlerType = eventHandlerType + override __.GetAddMethod _nonPublic = adder() + override __.GetRemoveMethod _nonPublic = remover() + override __.Attributes = attrs + override __.Name = eventName + override __.DeclaringType = declaringType |> nonNone "DeclaringType":> Type + override __.MemberType: MemberTypes = MemberTypes.Event + + override this.GetRaiseMethod _nonPublic = notRequired this "GetRaiseMethod" eventName + override this.ReflectedType = notRequired this "ReflectedType" eventName + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType + override this.IsDefined(_attributeType, _inherit) = notRequired this "IsDefined" eventName + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + +and ProvidedField(isTgt: bool, fieldName:string, attrs, fieldType:Type, rawConstantValue: obj, customAttributesData) = + inherit FieldInfo() + + let mutable declaringType : ProvidedTypeDefinition option = None + + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + let mutable attrs = attrs + + new (fieldName:string, fieldType:Type) = ProvidedField(false, fieldName, FieldAttributes.Private, fieldType, null, (K [| |])) + + member __.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction + member __.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction + member __.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc + member __.AddObsoleteAttribute (message, ?isError) = customAttributesImpl.AddObsolete (message, defaultArg isError false) + member __.AddDefinitionLocation(line, column, filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) + member __.SetFieldAttributes attributes = attrs <- attributes + member __.BelongsToTargetModel = isTgt + + member __.PatchDeclaringType x = patchOption declaringType (fun () -> declaringType <- Some x) + + member __.AddCustomAttribute attribute = customAttributesImpl.AddCustomAttribute attribute + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + + // Implement overloads + override __.FieldType = fieldType + override __.GetRawConstantValue() = rawConstantValue + override __.Attributes = attrs + override __.Name = fieldName + override __.DeclaringType = declaringType |> nonNone "DeclaringType":> Type + override __.MemberType: MemberTypes = MemberTypes.Field + + override this.ReflectedType = notRequired this "ReflectedType" fieldName + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType + override this.IsDefined(_attributeType, _inherit) = notRequired this "IsDefined" fieldName + + override this.SetValue(_obj, _value, _invokeAttr, _binder, _culture) = notRequired this "SetValue" fieldName + override this.GetValue(_obj): obj = notRequired this "GetValue" fieldName + override this.FieldHandle = notRequired this "FieldHandle" fieldName + + static member Literal(fieldName:string, fieldType:Type, literalValue: obj) = + ProvidedField(false, fieldName, (FieldAttributes.Static ||| FieldAttributes.Literal ||| FieldAttributes.Public), fieldType, literalValue, K [| |]) + + +and ProvidedMeasureBuilder() = + + // TODO: this shouldn't be hardcoded, but without creating a dependency on FSharp.Compiler.Service + // there seems to be no way to check if a type abbreviation exists + static let unitNamesTypeAbbreviations = + [ + "meter"; "hertz"; "newton"; "pascal"; "joule"; "watt"; "coulomb"; + "volt"; "farad"; "ohm"; "siemens"; "weber"; "tesla"; "henry" + "lumen"; "lux"; "becquerel"; "gray"; "sievert"; "katal" + ] + |> Set.ofList + + static let unitSymbolsTypeAbbreviations = + [ + "m"; "kg"; "s"; "A"; "K"; "mol"; "cd"; "Hz"; "N"; "Pa"; "J"; "W"; "C" + "V"; "F"; "S"; "Wb"; "T"; "lm"; "lx"; "Bq"; "Gy"; "Sv"; "kat"; "H" + ] + |> Set.ofList + + static member One = typeof + static member Product (measure1, measure2) = typedefof>.MakeGenericType [| measure1;measure2 |] + static member Inverse denominator = typedefof>.MakeGenericType [| denominator |] + static member Ratio (numerator, denominator) = ProvidedMeasureBuilder.Product(numerator, ProvidedMeasureBuilder.Inverse denominator) + static member Square measure = ProvidedMeasureBuilder.Product(measure, measure) + + // If the unit is not a valid type, instead + // of assuming it's a type abbreviation, which may not be the case and cause a + // problem later on, check the list of valid abbreviations + static member SI (unitName:string) = + let mLowerCase = unitName.ToLowerInvariant() + let abbreviation = + if unitNamesTypeAbbreviations.Contains mLowerCase then + Some ("Microsoft.FSharp.Data.UnitSystems.SI.UnitNames", mLowerCase) + elif unitSymbolsTypeAbbreviations.Contains unitName then + Some ("Microsoft.FSharp.Data.UnitSystems.SI.UnitSymbols", unitName) + else + None + match abbreviation with + | Some (ns, unitName) -> + ProvidedTypeSymbol(ProvidedTypeSymbolKind.FSharpTypeAbbreviation(typeof.Assembly, ns, [| unitName |]), [], defaultTypeBuilder) :> Type + | None -> + typedefof>.Assembly.GetType("Microsoft.FSharp.Data.UnitSystems.SI.UnitNames." + mLowerCase) + + static member AnnotateType (basic, argument) = ProvidedTypeSymbol(Generic basic, argument, defaultTypeBuilder) :> Type + +and + [] + TypeContainer = + | Namespace of (unit -> Assembly) * string // namespace + | Type of ProvidedTypeDefinition + | TypeToBeDecided + +/// backingDataSource is a set of functions to fetch backing data for the ProvidedTypeDefinition, +/// and allows us to reuse this type for both target and source models, even when the +/// source model is being incrementally updates by further .AddMember calls +and ProvidedTypeDefinition(isTgt: bool, container:TypeContainer, className: string, getBaseType: (unit -> Type option), attrs: TypeAttributes, getEnumUnderlyingType, staticParams, staticParamsApply, backingDataSource, customAttributesData, nonNullable, hideObjectMethods, typeBuilder: ITypeBuilder) as this = + inherit TypeDelegator() + + do match container, !ProvidedTypeDefinition.Logger with + | TypeContainer.Namespace _, Some logger when not isTgt -> logger (sprintf "Creating ProvidedTypeDefinition %s [%d]" className (System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode this)) + | _ -> () + + static let defaultAttributes (isErased, isSealed, isInterface, isAbstract) = + TypeAttributes.Public ||| + (if isInterface then TypeAttributes.Interface ||| TypeAttributes.Abstract + elif isAbstract then TypeAttributes.Abstract + else TypeAttributes.Class) ||| + (if isSealed && not isInterface && not isAbstract then TypeAttributes.Sealed else enum 0) ||| + enum (if isErased then int32 TypeProviderTypeAttributes.IsErased else 0) + + // state + let mutable attrs = attrs + let mutable enumUnderlyingType = lazy getEnumUnderlyingType() + let mutable baseType = lazy getBaseType() + + /// Represents the evaluated members so far + let members = ResizeArray() + + /// Represents delayed members, as yet uncomputed + let membersQueue = ResizeArray<(unit -> MemberInfo[])>() + + let mutable staticParamsDefined = false + let mutable staticParams = staticParams + let mutable staticParamsApply = staticParamsApply + let mutable container = container + let interfaceImpls = ResizeArray() + let interfacesQueue = ResizeArray Type[]>() + let methodOverrides = ResizeArray() + let methodOverridesQueue = ResizeArray (ProvidedMethod * MethodInfo)[]>() + + do match backingDataSource with + | None -> () + | Some (_, getFreshMembers, getFreshInterfaces, getFreshMethodOverrides) -> + membersQueue.Add getFreshMembers + interfacesQueue.Add getFreshInterfaces + methodOverridesQueue.Add getFreshMethodOverrides + + let checkFreshMembers() = + match backingDataSource with + | None -> false + | Some (checkFreshMembers, _getFreshMembers, _getFreshInterfaces, _getFreshMethodOverrides) -> checkFreshMembers() + + let moreMembers() = + membersQueue.Count > 0 || checkFreshMembers() + + let evalMembers() = + if moreMembers() then + // re-add the getFreshMembers call from the backingDataSource to make sure we fetch the latest translated members from the source model + match backingDataSource with + | None -> () + | Some (_, getFreshMembers, _getFreshInterfaces, _getFreshMethodOverrides) -> + membersQueue.Add getFreshMembers + + let elems = membersQueue |> Seq.toArray // take a copy in case more elements get added + membersQueue.Clear() + for f in elems do + for m in f() do + members.Add m + + // Implicitly add the property and event methods (only for the source model where they are not explicitly declared) + match m with + | :? ProvidedProperty as p -> + if not p.BelongsToTargetModel then + if p.CanRead then members.Add (p.GetGetMethod true) + if p.CanWrite then members.Add (p.GetSetMethod true) + | :? ProvidedEvent as e -> + if not e.BelongsToTargetModel then + members.Add (e.GetAddMethod true) + members.Add (e.GetRemoveMethod true) + | _ -> () + + let getMembers() = + evalMembers() + members.ToArray() + + // Save some common lookups for provided types with lots of members + let mutable bindings : Dictionary = null + + let save (key: BindingFlags) f : 'T = + let key = int key + + if bindings = null then + bindings <- Dictionary<_, _>(HashIdentity.Structural) + + if not (moreMembers()) && bindings.ContainsKey(key) then + bindings.[key] :?> 'T + else + let res = f () // this will refresh the members + bindings.[key] <- box res + res + + let evalInterfaces() = + if interfacesQueue.Count > 0 then + let elems = interfacesQueue |> Seq.toArray // take a copy in case more elements get added + interfacesQueue.Clear() + for f in elems do + for i in f() do + interfaceImpls.Add i + match backingDataSource with + | None -> () + | Some (_, _getFreshMembers, getInterfaces, _getFreshMethodOverrides) -> + interfacesQueue.Add getInterfaces + + let getInterfaces() = + evalInterfaces() + interfaceImpls.ToArray() + + let evalMethodOverrides () = + if methodOverridesQueue.Count > 0 then + let elems = methodOverridesQueue |> Seq.toArray // take a copy in case more elements get added + methodOverridesQueue.Clear() + for f in elems do + for i in f() do + methodOverrides.Add i + match backingDataSource with + | None -> () + | Some (_, _getFreshMembers, _getFreshInterfaces, getFreshMethodOverrides) -> + methodOverridesQueue.Add getFreshMethodOverrides + + let getFreshMethodOverrides () = + evalMethodOverrides () + methodOverrides.ToArray() + + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + + do if nonNullable then customAttributesImpl.NonNullable <- true + do if hideObjectMethods then customAttributesImpl.HideObjectMethods <- true + do this.typeImpl <- this + + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + + new (assembly:Assembly, namespaceName, className, baseType, ?hideObjectMethods, ?nonNullable, ?isErased, ?isSealed, ?isInterface, ?isAbstract) = + let isErased = defaultArg isErased true + let isSealed = defaultArg isSealed true + let isInterface = defaultArg isInterface false + let isAbstract = defaultArg isAbstract false + let nonNullable = defaultArg nonNullable false + let hideObjectMethods = defaultArg hideObjectMethods false + let attrs = defaultAttributes (isErased, isSealed, isInterface, isAbstract) + //if not isErased && assembly.GetType().Name <> "ProvidedAssembly" then failwithf "a non-erased (i.e. generative) ProvidedTypeDefinition '%s.%s' was placed in an assembly '%s' that is not a ProvidedAssembly" namespaceName className (assembly.GetName().Name) + ProvidedTypeDefinition(false, TypeContainer.Namespace (K assembly, namespaceName), className, K baseType, attrs, K None, [], None, None, K [| |], nonNullable, hideObjectMethods, defaultTypeBuilder) + + new (className:string, baseType, ?hideObjectMethods, ?nonNullable, ?isErased, ?isSealed, ?isInterface, ?isAbstract) = + let isErased = defaultArg isErased true + let isSealed = defaultArg isSealed true + let isInterface = defaultArg isInterface false + let isAbstract = defaultArg isAbstract false + let nonNullable = defaultArg nonNullable false + let hideObjectMethods = defaultArg hideObjectMethods false + let attrs = defaultAttributes (isErased, isSealed, isInterface, isAbstract) + ProvidedTypeDefinition(false, TypeContainer.TypeToBeDecided, className, K baseType, attrs, K None, [], None, None, K [| |], nonNullable, hideObjectMethods, defaultTypeBuilder) + + // state ops + + override __.UnderlyingSystemType = typeof + + // Implement overloads + override __.Assembly = + match container with + | TypeContainer.Namespace (theAssembly, _) -> theAssembly() + | TypeContainer.Type t -> t.Assembly + | TypeContainer.TypeToBeDecided -> failwithf "type '%s' was not yet added as a member to a declaring type, stacktrace = %s" className Environment.StackTrace + + override __.FullName = + match container with + | TypeContainer.Type declaringType -> declaringType.FullName + "+" + className + | TypeContainer.Namespace (_, namespaceName) -> + if namespaceName="" then failwith "use null for global namespace" + match namespaceName with + | null -> className + | _ -> namespaceName + "." + className + | TypeContainer.TypeToBeDecided -> failwithf "type '%s' was not added as a member to a declaring type" className + + override __.Namespace = + match container with + | TypeContainer.Namespace (_, nsp) -> nsp + | TypeContainer.Type t -> t.Namespace + | TypeContainer.TypeToBeDecided -> failwithf "type '%s' was not added as a member to a declaring type" className + + override __.BaseType = match baseType.Value with Some ty -> ty | None -> null + + override __.GetConstructors bindingFlags = + (//save ("ctor", bindingFlags, None) (fun () -> + getMembers() + |> Array.choose (function :? ConstructorInfo as c when memberBinds false bindingFlags c.IsStatic c.IsPublic -> Some c | _ -> None)) + + override this.GetMethods bindingFlags = + (//save ("methods", bindingFlags, None) (fun () -> + getMembers() + |> Array.choose (function :? MethodInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> Some m | _ -> None) + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetMethods(bindingFlags))))) + + override this.GetFields bindingFlags = + (//save ("fields", bindingFlags, None) (fun () -> + getMembers() + |> Array.choose (function :? FieldInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> Some m | _ -> None) + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetFields(bindingFlags))))) + + override this.GetProperties bindingFlags = + (//save ("props", bindingFlags, None) (fun () -> + let staticOrPublic = + getMembers() + |> Array.choose (function :? PropertyInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> Some m | _ -> None) + staticOrPublic + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null + then id + else (fun mems -> Array.append mems (this.ErasedBaseType.GetProperties(bindingFlags))))) + + override this.GetEvents bindingFlags = + (//save ("events", bindingFlags, None) (fun () -> + getMembers() + |> Array.choose (function :? EventInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> Some m | _ -> None) + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetEvents(bindingFlags))))) + + override __.GetNestedTypes bindingFlags = + (//save ("nested", bindingFlags, None) (fun () -> + getMembers() + |> Array.choose (function :? Type as m when memberBinds true bindingFlags false m.IsPublic || m.IsNestedPublic -> Some m | _ -> None) + |> (if hasFlag bindingFlags BindingFlags.DeclaredOnly || this.BaseType = null then id else (fun mems -> Array.append mems (this.ErasedBaseType.GetNestedTypes(bindingFlags))))) + + override this.GetConstructorImpl(bindingFlags, _binder, _callConventions, _types, _modifiers) = + let xs = this.GetConstructors bindingFlags |> Array.filter (fun m -> m.Name = ".ctor") + if xs.Length > 1 then failwith "GetConstructorImpl. not support overloads" + if xs.Length > 0 then xs.[0] else null + + override __.GetMethodImpl(name, bindingFlags, _binderBinder, _callConvention, _types, _modifiers): MethodInfo = + (//save ("methimpl", bindingFlags, Some name) (fun () -> + // This is performance critical for large spaces of provided methods and properties + // Save a table of the methods grouped by name + let table = + save (bindingFlags ||| BindingFlags.InvokeMethod) (fun () -> + let methods = this.GetMethods bindingFlags + methods |> Seq.groupBy (fun m -> m.Name) |> Seq.map (fun (k, v) -> k, Seq.toArray v) |> dict) + + let xs = if table.ContainsKey name then table.[name] else [| |] + //let xs = this.GetMethods bindingFlags |> Array.filter (fun m -> m.Name = name) + if xs.Length > 1 then failwithf "GetMethodImpl. not support overloads, name = '%s', methods - '%A', callstack = '%A'" name xs Environment.StackTrace + if xs.Length > 0 then xs.[0] else null) + + override this.GetField(name, bindingFlags) = + (//save ("field1", bindingFlags, Some name) (fun () -> + let xs = this.GetFields bindingFlags |> Array.filter (fun m -> m.Name = name) + if xs.Length > 0 then xs.[0] else null) + + override __.GetPropertyImpl(name, bindingFlags, _binder, _returnType, _types, _modifiers) = + (//save ("prop1", bindingFlags, Some name) (fun () -> + let table = + save (bindingFlags ||| BindingFlags.GetProperty) (fun () -> + let methods = this.GetProperties bindingFlags + methods |> Seq.groupBy (fun m -> m.Name) |> Seq.map (fun (k, v) -> k, Seq.toArray v) |> dict) + let xs = if table.ContainsKey name then table.[name] else [| |] + //let xs = this.GetProperties bindingFlags |> Array.filter (fun m -> m.Name = name) + if xs.Length > 0 then xs.[0] else null) + + override __.GetEvent(name, bindingFlags) = + (//save ("event1", bindingFlags, Some name) (fun () -> + let xs = this.GetEvents bindingFlags |> Array.filter (fun m -> m.Name = name) + if xs.Length > 0 then xs.[0] else null) + + override __.GetNestedType(name, bindingFlags) = + (//save ("nested1", bindingFlags, Some name) (fun () -> + let xs = this.GetNestedTypes bindingFlags |> Array.filter (fun m -> m.Name = name) + if xs.Length > 0 then xs.[0] else null) + + override __.GetInterface(_name, _ignoreCase) = notRequired this "GetInterface" this.Name + + override __.GetInterfaces() = getInterfaces() + + + override __.MakeArrayType() = ProvidedTypeSymbol(ProvidedTypeSymbolKind.SDArray, [this], typeBuilder) :> Type + + override __.MakeArrayType arg = ProvidedTypeSymbol(ProvidedTypeSymbolKind.Array arg, [this], typeBuilder) :> Type + + override __.MakePointerType() = ProvidedTypeSymbol(ProvidedTypeSymbolKind.Pointer, [this], typeBuilder) :> Type + + override __.MakeByRefType() = ProvidedTypeSymbol(ProvidedTypeSymbolKind.ByRef, [this], typeBuilder) :> Type + + // The binding attributes are always set to DeclaredOnly ||| Static ||| Instance ||| Public when GetMembers is called directly by the F# compiler + // However, it's possible for the framework to generate other sets of flags in some corner cases (e.g. via use of `enum` with a provided type as the target) + override __.GetMembers bindingFlags = + [| for m in getMembers() do + match m with + | :? ConstructorInfo as c when memberBinds false bindingFlags c.IsStatic c.IsPublic -> yield (c :> MemberInfo) + | :? MethodInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> yield (m :> _) + | :? FieldInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> yield (m :> _) + | :? PropertyInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> yield (m :> _) + | :? EventInfo as m when memberBinds false bindingFlags m.IsStatic m.IsPublic -> yield (m :> _) + | :? Type as m when memberBinds true bindingFlags false m.IsPublic || m.IsNestedPublic -> yield (m :> _) + | _ -> () |] + + override this.GetMember(name, mt, _bindingFlags) = + let mt = if hasFlag mt MemberTypes.NestedType then mt ||| MemberTypes.TypeInfo else mt + this.GetMembers() |> Array.filter (fun m -> 0 <> int(m.MemberType &&& mt) && m.Name = name) + + // Attributes, etc.. + override __.GetAttributeFlagsImpl() = adjustTypeAttributes this.IsNested attrs + + override this.IsValueTypeImpl() = + match this.BaseType with + | null -> false + | bt -> bt.FullName = "System.Enum" || bt.FullName = "System.ValueType" || bt.IsValueType + + override __.IsEnum = + match this.BaseType with + | null -> false + | bt -> bt.FullName = "System.Enum" || bt.IsEnum + + override __.GetEnumUnderlyingType() = + if this.IsEnum then + match enumUnderlyingType.Force() with + | None -> typeof + | Some ty -> ty + else failwithf "not enum type" + + override __.IsArrayImpl() = false + override __.IsByRefImpl() = false + override __.IsPointerImpl() = false + override __.IsPrimitiveImpl() = false + override __.IsCOMObjectImpl() = false + override __.HasElementTypeImpl() = false + override __.Name = className + + override __.DeclaringType = + match container with + | TypeContainer.Namespace _ -> null + | TypeContainer.Type enclosingTyp -> (enclosingTyp :> Type) + | TypeContainer.TypeToBeDecided -> failwithf "type '%s' was not added as a member to a declaring type" className + + override __.MemberType = if this.IsNested then MemberTypes.NestedType else MemberTypes.TypeInfo + +#if NETCOREAPP + // See bug https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues/236 + override __.IsSZArray = false +#endif + + override x.GetHashCode() = x.Namespace.GetHashCode() ^^^ className.GetHashCode() + override this.Equals(that: obj) = Object.ReferenceEquals(this, that) + override this.Equals(that: Type) = Object.ReferenceEquals(this, that) + + override this.IsAssignableFrom(otherTy: Type) = isAssignableFrom this otherTy + + override this.IsSubclassOf(otherTy: Type) = isSubclassOf this otherTy + + override __.GetGenericArguments() = [||] + + override __.ToString() = this.Name + + override x.Module = x.Assembly.ManifestModule + + override __.GUID = Guid.Empty + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType + override __.IsDefined(_attributeType: Type, _inherit) = false + + override __.GetElementType() = notRequired this "Module" this.Name + override __.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired this "Module" this.Name + override __.AssemblyQualifiedName = notRequired this "Module" this.Name + // Needed because TypeDelegator.cs provides a delegting implementation of this, and we are self-delegating + override this.GetEvents() = this.GetEvents(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.Static) // Needed because TypeDelegator.cs provides a delegting implementation of this, and we are self-delegating + + // Get the model + member __.BelongsToTargetModel = isTgt + member __.AttributesRaw = attrs + member __.EnumUnderlyingTypeRaw() = enumUnderlyingType.Force() + member __.Container = container + member __.BaseTypeRaw() = baseType.Force() + member __.StaticParams = staticParams + member __.StaticParamsApply = staticParamsApply + + // Count the members declared since the indicated position in the members list. This allows the target model to observe + // incremental additions made to the source model + member __.CountMembersFromCursor(idx: int) = evalMembers(); members.Count - idx + + // Fetch the members declared since the indicated position in the members list. This allows the target model to observe + // incremental additions made to the source model + member __.GetMembersFromCursor(idx: int) = evalMembers(); members.GetRange(idx, members.Count - idx).ToArray(), members.Count + + // Fetch the interfaces declared since the indicated position in the interfaces list + member __.GetInterfaceImplsFromCursor(idx: int) = evalInterfaces(); interfaceImpls.GetRange(idx, interfaceImpls.Count - idx).ToArray(), interfaceImpls.Count + + // Fetch the method overrides declared since the indicated position in the list + member __.GetMethodOverridesFromCursor(idx: int) = evalMethodOverrides(); methodOverrides.GetRange(idx, methodOverrides.Count - idx).ToArray(), methodOverrides.Count + + // Fetch the method overrides + member __.GetMethodOverrides() = getFreshMethodOverrides() + + member this.ErasedBaseType : Type = ProvidedTypeDefinition.EraseType(this.BaseType) + + member __.AddXmlDocComputed xmlDocFunction = customAttributesImpl.AddXmlDocComputed xmlDocFunction + member __.AddXmlDocDelayed xmlDocFunction = customAttributesImpl.AddXmlDocDelayed xmlDocFunction + member __.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc + member __.AddObsoleteAttribute (message, ?isError) = customAttributesImpl.AddObsolete (message, defaultArg isError false) + member __.AddDefinitionLocation(line, column, filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath) + member __.HideObjectMethods with get() = customAttributesImpl.HideObjectMethods and set v = customAttributesImpl.HideObjectMethods <- v + member __.NonNullable with get() = customAttributesImpl.NonNullable and set v = customAttributesImpl.NonNullable <- v + member __.AddCustomAttribute attribute = customAttributesImpl.AddCustomAttribute attribute + + member __.SetEnumUnderlyingType(ty) = enumUnderlyingType <- lazy Some ty + member __.SetBaseType t = + if baseType.IsValueCreated then failwithf "The base type has already been evaluated for this type. Please call SetBaseType before any operations which traverse the type hierarchy. stacktrace = %A" Environment.StackTrace + baseType <- lazy Some t + member __.SetBaseTypeDelayed baseTypeFunction = + if baseType.IsValueCreated then failwithf "The base type has already been evaluated for this type. Please call SetBaseType before any operations which traverse the type hierarchy. stacktrace = %A" Environment.StackTrace + baseType <- lazy (Some (baseTypeFunction())) + member __.AddAttributes x = attrs <- attrs ||| x + member __.SetAttributes x = attrs <- x + + member this.AddMembers(memberInfos:list<#MemberInfo>) = + memberInfos |> List.iter this.PatchDeclaringTypeOfMember + membersQueue.Add (fun () -> memberInfos |> List.toArray |> Array.map (fun x -> x :> MemberInfo )) + + member __.AddMember(memberInfo:MemberInfo) = + this.AddMembers [memberInfo] + + member __.AddMembersDelayed(membersFunction: unit -> list<#MemberInfo>) = + membersQueue.Add (fun () -> membersFunction() |> List.toArray |> Array.map (fun x -> this.PatchDeclaringTypeOfMember x; x :> MemberInfo )) + + member __.AddMemberDelayed(memberFunction: unit -> #MemberInfo) = + this.AddMembersDelayed(fun () -> [memberFunction()]) + + member __.AddAssemblyTypesAsNestedTypesDelayed (assemblyFunction: unit -> Assembly) = + let bucketByPath nodef tipf (items: (string list * 'Value) list) = + // Find all the items with an empty key list and call 'tipf' + let tips = + [ for (keylist, v) in items do + match keylist with + | [] -> yield tipf v + | _ -> () ] + + // Find all the items with a non-empty key list. Bucket them together by + // the first key. For each bucket, call 'nodef' on that head key and the bucket. + let nodes = + let buckets = new Dictionary<_, _>(10) + for (keylist, v) in items do + match keylist with + | [] -> () + | key::rest -> + buckets.[key] <- (rest, v) :: (if buckets.ContainsKey key then buckets.[key] else []); + + [ for (KeyValue(key, items)) in buckets -> nodef key items ] + + tips @ nodes + this.AddMembersDelayed (fun _ -> + let topTypes = [ for ty in assemblyFunction().GetTypes() do + if not ty.IsNested then + let namespaceParts = match ty.Namespace with null -> [] | s -> s.Split '.' |> Array.toList + yield namespaceParts, ty ] + let rec loop types = + types + |> bucketByPath + (fun namespaceComponent typesUnderNamespaceComponent -> + let t = ProvidedTypeDefinition(namespaceComponent, baseType = Some typeof) + t.AddMembers (loop typesUnderNamespaceComponent) + (t :> Type)) + id + loop topTypes) + + /// Abstract a type to a parametric-type. Requires "formal parameters" and "instantiation function". + member __.DefineStaticParameters(parameters: ProvidedStaticParameter list, instantiationFunction: (string -> obj[] -> ProvidedTypeDefinition)) = + if staticParamsDefined then failwithf "Static parameters have already been defined for this type. stacktrace = %A" Environment.StackTrace + staticParamsDefined <- true + staticParams <- parameters + staticParamsApply <- Some instantiationFunction + + /// Get ParameterInfo[] for the parametric type parameters + member __.GetStaticParametersInternal() = [| for p in staticParams -> p :> ParameterInfo |] + + /// Instantiate parametric type + member this.ApplyStaticArguments(name:string, args:obj[]) = + if staticParams.Length <> args.Length then + failwithf "ProvidedTypeDefinition: expecting %d static parameters but given %d for type %s" staticParams.Length args.Length this.FullName + if staticParams.Length > 0 then + match staticParamsApply with + | None -> failwith "ProvidedTypeDefinition: DefineStaticParameters was not called" + | Some f -> f name args + else + this + + member __.PatchDeclaringType x = container <- TypeContainer.Type x + + member __.IsErased + with get() = (attrs &&& enum (int32 TypeProviderTypeAttributes.IsErased)) <> enum 0 + and set v = + if v then attrs <- attrs ||| enum (int32 TypeProviderTypeAttributes.IsErased) + else attrs <- attrs &&& ~~~(enum (int32 TypeProviderTypeAttributes.IsErased)) + + member __.SuppressRelocation + with get() = (attrs &&& enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) <> enum 0 + and set v = + if v then attrs <- attrs ||| enum (int32 TypeProviderTypeAttributes.SuppressRelocate) + else attrs <- attrs &&& ~~~(enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) + + member __.AddInterfaceImplementation interfaceType = interfaceImpls.Add interfaceType + + member __.AddInterfaceImplementationsDelayed interfacesFunction = interfacesQueue.Add (interfacesFunction >> Array.ofList) + + member __.SetAssemblyInternal (assembly: unit -> Assembly) = + match container with + | TypeContainer.Namespace (_, ns) -> container <- TypeContainer.Namespace (assembly, ns) + | TypeContainer.Type _ -> failwithf "can't set assembly of nested type '%s'" className + | TypeContainer.TypeToBeDecided -> failwithf "type '%s' was not added as a member to a declaring type" className + + member __.DefineMethodOverride (methodInfoBody, methodInfoDeclaration) = methodOverrides.Add (methodInfoBody, methodInfoDeclaration) + member __.DefineMethodOverridesDelayed f = methodOverridesQueue.Add (f >> Array.ofList) + + // This method is used by Debug.fs and QuotationBuilder.fs. + // Emulate the F# type provider type erasure mechanism to get the + // actual (erased) type. We erase ProvidedTypes to their base type + // and we erase array of provided type to array of base type. In the + // case of generics all the generic type arguments are also recursively // replaced with the erased-to types - static member EraseType(t:Type) = - match t with - | :? ProvidedTypeDefinition -> ProvidedTypeDefinition.EraseType t.BaseType - | :? ProvidedSymbolType as sym -> - match sym.Kind, sym.Args with - | SymbolKind.SDArray, [typ] -> - let (t:Type) = ProvidedTypeDefinition.EraseType typ - t.MakeArrayType() - | SymbolKind.Generic genericTypeDefinition, _ when not genericTypeDefinition.IsGenericTypeDefinition -> - // Unit of measure parameters can match here, but not really generic types. - genericTypeDefinition.UnderlyingSystemType - | SymbolKind.Generic genericTypeDefinition, typeArgs -> - let genericArguments = - typeArgs - |> List.toArray - |> Array.map ProvidedTypeDefinition.EraseType - genericTypeDefinition.MakeGenericType(genericArguments) - | _ -> failwith "getTypeErasedTo: Unsupported ProvidedSymbolType" + static member EraseType(typ:Type): Type = + match typ with + | :? ProvidedTypeDefinition as ptd when ptd.IsErased -> ProvidedTypeDefinition.EraseType typ.BaseType + | t when t.IsArray -> + let rank = t.GetArrayRank() + let et = ProvidedTypeDefinition.EraseType (t.GetElementType()) + if rank = 0 then et.MakeArrayType() else et.MakeArrayType(rank) + | :? ProvidedTypeSymbol as sym when sym.IsFSharpUnitAnnotated -> + typ.UnderlyingSystemType | t when t.IsGenericType && not t.IsGenericTypeDefinition -> let genericTypeDefinition = t.GetGenericTypeDefinition() - let genericArguments = - t.GetGenericArguments() - |> Array.map ProvidedTypeDefinition.EraseType + let genericArguments = t.GetGenericArguments() |> Array.map ProvidedTypeDefinition.EraseType genericTypeDefinition.MakeGenericType(genericArguments) | t -> t - static member Logger : (string -> unit) option ref = ref None - // The binding attributes are always set to DeclaredOnly ||| Static ||| Instance ||| Public when GetMembers is called directly by the F# compiler - // However, it's possible for the framework to generate other sets of flags in some corner cases (e.g. via use of `enum` with a provided type as the target) - override _.GetMembers bindingAttr = - let mems = - getMembers() - |> Array.filter (fun mem -> - let isStatic, isPublic = - match mem with - | :? FieldInfo as f -> f.IsStatic, f.IsPublic - | :? MethodInfo as m -> m.IsStatic, m.IsPublic - | :? ConstructorInfo as c -> c.IsStatic, c.IsPublic - | :? PropertyInfo as p -> - let m = if p.CanRead then p.GetGetMethod() else p.GetSetMethod() - m.IsStatic, m.IsPublic - | :? EventInfo as e -> - let m = e.GetAddMethod() - m.IsStatic, m.IsPublic - | :? Type as ty -> - true, ty.IsNestedPublic - | _ -> failwith (sprintf "Member %O is of unexpected type" mem) - bindingAttr.HasFlag(if isStatic then BindingFlags.Static else BindingFlags.Instance) && - ( - (bindingAttr.HasFlag(BindingFlags.Public) && isPublic) || (bindingAttr.HasFlag(BindingFlags.NonPublic) && not isPublic) - )) - - if bindingAttr.HasFlag(BindingFlags.DeclaredOnly) || this.BaseType = null then mems - else - // FSharp.Data change: just using this.BaseType is not enough in the case of CsvProvider, - // because the base type is CsvRow, so we have to erase recursively to CsvRow - let baseMems = (ProvidedTypeDefinition.EraseType this.BaseType).GetMembers bindingAttr - Array.append mems baseMems - - override _.GetNestedTypes bindingAttr = - this.GetMembers bindingAttr - |> Array.filter(fun m -> - m.MemberType.HasFlag(MemberTypes.NestedType) || - // Allow 'fake' nested types that are actually real .NET types - m.MemberType.HasFlag(MemberTypes.TypeInfo)) |> Array.map(fun m -> m :?> Type) - - override _.GetMember(name,mt,_bindingAttr) = - let mt = - if mt &&& MemberTypes.NestedType = MemberTypes.NestedType then - mt ||| MemberTypes.TypeInfo - else - mt - getMembers() |> Array.filter(fun m->0<>(int(m.MemberType &&& mt)) && m.Name = name) - - override _.GetNestedType(name, bindingAttr) = - let nt = this.GetMember(name, MemberTypes.NestedType ||| MemberTypes.TypeInfo, bindingAttr) - match nt.Length with - | 0 -> null - | 1 -> downcast nt.[0] - | _ -> failwith (sprintf "There is more than one nested type called '%s' in type '%s'" name this.FullName) + member this.PatchDeclaringTypeOfMember (m:MemberInfo) = + match m with + | :? ProvidedConstructor as c -> c.PatchDeclaringType this + | :? ProvidedMethod as m -> m.PatchDeclaringType this + | :? ProvidedProperty as p -> p.PatchDeclaringType this + | :? ProvidedEvent as e -> e.PatchDeclaringType this + | :? ProvidedTypeDefinition as t -> t.PatchDeclaringType this + | :? ProvidedField as l -> l.PatchDeclaringType this + | _ -> () + + static member Logger: (string -> unit) option ref = ref None + + +//==================================================================================================== +// AssemblyReader for ProvidedTypesContext +// +// A lightweight .NET assembly reader that fits in a single F# file. Based on the well-tested Abstract IL +// binary reader code. Used by the type provider to read referenced asssemblies. + +module internal AssemblyReader = + + open System + open System.Collections.Generic + open System.Collections.Concurrent + open System.Collections.ObjectModel + open System.IO + open System.Reflection + open System.Text + //open ProviderImplementation.ProvidedTypes + + [] + module Utils = + + let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) + let doubleOfBits (x:int64) = System.BitConverter.Int64BitsToDouble(x) + + //--------------------------------------------------------------------- + // SHA1 hash-signing algorithm. Used to get the public key token from + // the public key. + //--------------------------------------------------------------------- + + // Little-endian encoding of int32 + let b0 n = byte (n &&& 0xFF) + let b1 n = byte ((n >>> 8) &&& 0xFF) + let b2 n = byte ((n >>> 16) &&& 0xFF) + let b3 n = byte ((n >>> 24) &&& 0xFF) + + // Little-endian encoding of int64 + let dw7 n = byte ((n >>> 56) &&& 0xFFL) + let dw6 n = byte ((n >>> 48) &&& 0xFFL) + let dw5 n = byte ((n >>> 40) &&& 0xFFL) + let dw4 n = byte ((n >>> 32) &&& 0xFFL) + let dw3 n = byte ((n >>> 24) &&& 0xFFL) + let dw2 n = byte ((n >>> 16) &&& 0xFFL) + let dw1 n = byte ((n >>> 8) &&& 0xFFL) + let dw0 n = byte (n &&& 0xFFL) + + + module SHA1 = + let inline (>>>&) (x:int) (y:int) = int32 (uint32 x >>> y) + let f(t, b, c, d) = + if t < 20 then (b &&& c) ||| ((~~~b) &&& d) + elif t < 40 then b ^^^ c ^^^ d + elif t < 60 then (b &&& c) ||| (b &&& d) ||| (c &&& d) + else b ^^^ c ^^^ d + + let [] k0to19 = 0x5A827999 + let [] k20to39 = 0x6ED9EBA1 + let [] k40to59 = 0x8F1BBCDC + let [] k60to79 = 0xCA62C1D6 + + let k t = + if t < 20 then k0to19 + elif t < 40 then k20to39 + elif t < 60 then k40to59 + else k60to79 + + type SHAStream = + { stream: byte[]; + mutable pos: int; + mutable eof: bool; } + + let rotLeft32 x n = (x <<< n) ||| (x >>>& (32-n)) + + // padding and length (in bits!) recorded at end + let shaAfterEof sha = + let n = sha.pos + let len = sha.stream.Length + if n = len then 0x80 + else + let paddedLen = (((len + 9 + 63) / 64) * 64) - 8 + if n < paddedLen - 8 then 0x0 + elif (n &&& 63) = 56 then int32 ((int64 len * int64 8) >>> 56) &&& 0xff + elif (n &&& 63) = 57 then int32 ((int64 len * int64 8) >>> 48) &&& 0xff + elif (n &&& 63) = 58 then int32 ((int64 len * int64 8) >>> 40) &&& 0xff + elif (n &&& 63) = 59 then int32 ((int64 len * int64 8) >>> 32) &&& 0xff + elif (n &&& 63) = 60 then int32 ((int64 len * int64 8) >>> 24) &&& 0xff + elif (n &&& 63) = 61 then int32 ((int64 len * int64 8) >>> 16) &&& 0xff + elif (n &&& 63) = 62 then int32 ((int64 len * int64 8) >>> 8) &&& 0xff + elif (n &&& 63) = 63 then (sha.eof <- true; int32 (int64 len * int64 8) &&& 0xff) + else 0x0 + + let shaRead8 sha = + let s = sha.stream + let b = if sha.pos >= s.Length then shaAfterEof sha else int32 s.[sha.pos] + sha.pos <- sha.pos + 1 + b + + let shaRead32 sha = + let b0 = shaRead8 sha + let b1 = shaRead8 sha + let b2 = shaRead8 sha + let b3 = shaRead8 sha + let res = (b0 <<< 24) ||| (b1 <<< 16) ||| (b2 <<< 8) ||| b3 + res + + let sha1Hash sha = + let mutable h0 = 0x67452301 + let mutable h1 = 0xEFCDAB89 + let mutable h2 = 0x98BADCFE + let mutable h3 = 0x10325476 + let mutable h4 = 0xC3D2E1F0 + let mutable a = 0 + let mutable b = 0 + let mutable c = 0 + let mutable d = 0 + let mutable e = 0 + let w = Array.create 80 0x00 + while (not sha.eof) do + for i = 0 to 15 do + w.[i] <- shaRead32 sha + for t = 16 to 79 do + w.[t] <- rotLeft32 (w.[t-3] ^^^ w.[t-8] ^^^ w.[t-14] ^^^ w.[t-16]) 1 + a <- h0 + b <- h1 + c <- h2 + d <- h3 + e <- h4 + for t = 0 to 79 do + let temp = (rotLeft32 a 5) + f(t, b, c, d) + e + w.[t] + k(t) + e <- d + d <- c + c <- rotLeft32 b 30 + b <- a + a <- temp + h0 <- h0 + a + h1 <- h1 + b + h2 <- h2 + c + h3 <- h3 + d + h4 <- h4 + e + h0, h1, h2, h3, h4 + + let sha1HashBytes s = + let (_h0, _h1, _h2, h3, h4) = sha1Hash { stream = s; pos = 0; eof = false } // the result of the SHA algorithm is stored in registers 3 and 4 + Array.map byte [| b0 h4; b1 h4; b2 h4; b3 h4; b0 h3; b1 h3; b2 h3; b3 h3; |] + + + let sha1HashBytes s = SHA1.sha1HashBytes s + + + [] + type PublicKey = + | PublicKey of byte[] + | PublicKeyToken of byte[] + member x.IsKey=match x with PublicKey _ -> true | _ -> false + member x.IsKeyToken=match x with PublicKeyToken _ -> true | _ -> false + member x.Key=match x with PublicKey b -> b | _ -> failwithf "not a key" + member x.KeyToken=match x with PublicKeyToken b -> b | _ -> failwithf"not a key token" + + member x.ToToken() = + match x with + | PublicKey bytes -> SHA1.sha1HashBytes bytes + | PublicKeyToken token -> token + static member KeyAsToken(k) = PublicKeyToken(PublicKey(k).ToToken()) + + [] + type ILAssemblyRef(name: string, hash: byte[] uoption, publicKey: PublicKey uoption, retargetable: bool, version: Version uoption, locale: string uoption) = + member __.Name=name + member __.Hash=hash + member __.PublicKey=publicKey + member __.Retargetable=retargetable + member __.Version=version + member __.Locale=locale + + member x.ToAssemblyName() = + let asmName = AssemblyName(Name=x.Name) + match x.PublicKey with + | USome bytes -> asmName.SetPublicKeyToken(bytes.ToToken()) + | UNone -> () + match x.Version with + | USome v -> asmName.Version <- v + | UNone -> () + asmName.CultureName <- System.Globalization.CultureInfo.InvariantCulture.Name + asmName + + static member FromAssemblyName (aname:AssemblyName) = + let locale = UNone + let publicKey = + match aname.GetPublicKey() with + | null | [| |] -> + match aname.GetPublicKeyToken() with + | null | [| |] -> UNone + | bytes -> USome (PublicKeyToken bytes) + | bytes -> + USome (PublicKey.KeyAsToken(bytes)) + + let version = + match aname.Version with + | null -> UNone + | v -> USome (Version(v.Major, v.Minor, v.Build, v.Revision)) + + let retargetable = aname.Flags = System.Reflection.AssemblyNameFlags.Retargetable + + ILAssemblyRef(aname.Name, UNone, publicKey, retargetable, version, locale) + + member aref.QualifiedName = + let b = new StringBuilder(100) + let add (s:string) = (b.Append(s) |> ignore) + let addC (s:char) = (b.Append(s) |> ignore) + add(aref.Name); + match aref.Version with + | UNone -> () + | USome v -> + add ", Version="; + add (string v.Major) + add "."; + add (string v.Minor) + add "."; + add (string v.Build) + add "."; + add (string v.Revision) + add ", Culture=" + match aref.Locale with + | UNone -> add "neutral" + | USome b -> add b + add ", PublicKeyToken=" + match aref.PublicKey with + | UNone -> add "null" + | USome pki -> + let pkt = pki.ToToken() + let convDigit(digit) = + let digitc = + if digit < 10 + then System.Convert.ToInt32 '0' + digit + else System.Convert.ToInt32 'a' + (digit - 10) + System.Convert.ToChar(digitc) + for i = 0 to pkt.Length-1 do + let v = pkt.[i] + addC (convDigit(System.Convert.ToInt32(v)/16)) + addC (convDigit(System.Convert.ToInt32(v)%16)) + // retargetable can be true only for system assemblies that definitely have Version + if aref.Retargetable then + add ", Retargetable=Yes" + b.ToString() + override x.ToString() = x.QualifiedName + + override __.GetHashCode() = + + name.GetHashCode() + + 137 * (hash.GetHashCode() + + 137 * (publicKey.GetHashCode() + + 137 * ( retargetable.GetHashCode() + + 137 * ( version.GetHashCode() + + 137 * locale.GetHashCode())))) + + override __.Equals(obj: obj) = + match obj with + | :? ILAssemblyRef as y -> + name = y.Name + && hash = y.Hash + && publicKey = y.PublicKey + && retargetable = y.Retargetable + && version = y.Version + && locale = y.Locale + | _ -> false + + type ILModuleRef(name:string, hasMetadata: bool, hash: byte[] uoption) = + member __.Name=name + member __.HasMetadata=hasMetadata + member __.Hash=hash + override __.ToString() = "module " + name + + override __.GetHashCode() = + name.GetHashCode() + + 137 * (hasMetadata.GetHashCode() + + 137 * hash.GetHashCode()) + + override __.Equals(obj: obj) = + match obj with + | :? ILModuleRef as y -> + name = y.Name + && hasMetadata = y.HasMetadata + && hash = y.Hash + | _ -> false + + + [] + type ILScopeRef = + | Local + | Module of ILModuleRef + | Assembly of ILAssemblyRef + member x.IsLocalRef = match x with ILScopeRef.Local -> true | _ -> false + member x.IsModuleRef = match x with ILScopeRef.Module _ -> true | _ -> false + member x.IsAssemblyRef= match x with ILScopeRef.Assembly _ -> true | _ -> false + member x.ModuleRef = match x with ILScopeRef.Module x -> x | _ -> failwith "not a module reference" + member x.AssemblyRef = match x with ILScopeRef.Assembly x -> x | _ -> failwith "not an assembly reference" + + member x.QualifiedName = + match x with + | ILScopeRef.Local -> "" + | ILScopeRef.Module mref -> "module "+mref.Name + | ILScopeRef.Assembly aref -> aref.QualifiedName + + override x.ToString() = x.QualifiedName + + type ILArrayBound = int32 option + type ILArrayBounds = ILArrayBound * ILArrayBound + + [] + type ILArrayShape = + | ILArrayShape of ILArrayBounds[] (* lobound/size pairs *) + member x.Rank = (let (ILArrayShape l) = x in l.Length) + static member SingleDimensional = ILArrayShapeStatics.SingleDimensional + static member FromRank n = if n = 1 then ILArrayShape.SingleDimensional else ILArrayShape(List.replicate n (Some 0, None) |> List.toArray) + + + and ILArrayShapeStatics() = + static let singleDimensional = ILArrayShape [| (Some 0, None) |] + static member SingleDimensional = singleDimensional + + /// Calling conventions. These are used in method pointer types. + [] + type ILArgConvention = + | Default + | CDecl + | StdCall + | ThisCall + | FastCall + | VarArg + + [] + type ILThisConvention = + | Instance + | InstanceExplicit + | Static + + [] + type ILCallingConv = + | Callconv of ILThisConvention * ILArgConvention + member x.ThisConv = let (Callconv(a, _b)) = x in a + member x.BasicConv = let (Callconv(_a, b)) = x in b + member x.IsInstance = match x.ThisConv with ILThisConvention.Instance -> true | _ -> false + member x.IsInstanceExplicit = match x.ThisConv with ILThisConvention.InstanceExplicit -> true | _ -> false + member x.IsStatic = match x.ThisConv with ILThisConvention.Static -> true | _ -> false + + static member Instance = ILCallingConvStatics.Instance + static member Static = ILCallingConvStatics.Static + + /// Static storage to amortize the allocation of ILCallingConv.Instance and ILCallingConv.Static + and ILCallingConvStatics() = + static let instanceCallConv = Callconv(ILThisConvention.Instance, ILArgConvention.Default) + static let staticCallConv = Callconv(ILThisConvention.Static, ILArgConvention.Default) + static member Instance = instanceCallConv + static member Static = staticCallConv + + type ILBoxity = + | AsObject + | AsValue + + [] + type ILTypeRefScope = + | Top of ILScopeRef + | Nested of ILTypeRef + member x.QualifiedNameExtension = + match x with + | Top scoref -> + let sco = scoref.QualifiedName + if sco = "" then "" else ", " + sco + | Nested tref -> + tref.QualifiedNameExtension + + + // IL type references have a pre-computed hash code to enable quick lookup tables during binary generation. + and ILTypeRef(enc: ILTypeRefScope, nsp: string uoption, name: string) = + let hashCode = hash enc + 137 *( 137 *(hash name) + hash nsp) + + member __.Scope = enc + member __.Name = name + member __.Namespace = nsp + + member tref.FullName = + match enc with + | ILTypeRefScope.Top _ -> joinILTypeName tref.Namespace tref.Name + | ILTypeRefScope.Nested enc -> enc.FullName + "." + tref.Name + + member tref.BasicQualifiedName = + match enc with + | ILTypeRefScope.Top _ -> joinILTypeName tref.Namespace tref.Name + | ILTypeRefScope.Nested enc -> enc.BasicQualifiedName + "+" + tref.Name + + member __.QualifiedNameExtension = enc.QualifiedNameExtension + + member tref.QualifiedName = tref.BasicQualifiedName + enc.QualifiedNameExtension + + override x.ToString() = x.FullName + + override __.GetHashCode() = hashCode + + override __.Equals(obj: obj) = + match obj with + | :? ILTypeRef as y -> + enc = y.Scope + && name = y.Name + && nsp = y.Namespace + | _ -> false + + + and ILTypeSpec(typeRef: ILTypeRef, inst: ILGenericArgs) = + let hashCode = hash typeRef + 137 * (hash inst) + + member __.TypeRef = typeRef + member x.Scope = x.TypeRef.Scope + member x.Name = x.TypeRef.Name + member x.Namespace = x.TypeRef.Namespace + member __.GenericArgs = inst + member x.BasicQualifiedName = + let tc = x.TypeRef.BasicQualifiedName + if x.GenericArgs.Length = 0 then + tc + else + tc + "[" + String.concat ", " (x.GenericArgs |> Array.map (fun arg -> "[" + arg.QualifiedName + "]")) + "]" + + member x.QualifiedNameExtension = + x.TypeRef.QualifiedNameExtension + + member x.FullName = x.TypeRef.FullName + + override x.ToString() = x.TypeRef.ToString() + (if x.GenericArgs.Length = 0 then "" else "<...>") + + override __.GetHashCode() = hashCode + override __.Equals(obj: obj) = + match obj with + | :? ILTypeSpec as y -> + typeRef = y.TypeRef + && inst = y.GenericArgs + | _ -> false + + and [] + ILType = + | Void + | Array of ILArrayShape * ILType + | Value of ILTypeSpec + | Boxed of ILTypeSpec + | Ptr of ILType + | Byref of ILType + | FunctionPointer of ILCallingSignature + | Var of int + | Modified of bool * ILTypeRef * ILType + + member x.BasicQualifiedName = + match x with + | ILType.Var n -> "!" + string n + | ILType.Modified(_, _ty1, ty2) -> ty2.BasicQualifiedName + | ILType.Array (ILArrayShape(s), ty) -> ty.BasicQualifiedName + "[" + System.String(',', s.Length-1) + "]" + | ILType.Value tr | ILType.Boxed tr -> tr.BasicQualifiedName + | ILType.Void -> "void" + | ILType.Ptr _ty -> failwith "unexpected pointer type" + | ILType.Byref _ty -> failwith "unexpected byref type" + | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" + + member x.QualifiedNameExtension = + match x with + | ILType.Var _n -> "" + | ILType.Modified(_, _ty1, ty2) -> ty2.QualifiedNameExtension + | ILType.Array (ILArrayShape(_s), ty) -> ty.QualifiedNameExtension + | ILType.Value tr | ILType.Boxed tr -> tr.QualifiedNameExtension + | ILType.Void -> failwith "void" + | ILType.Ptr _ty -> failwith "unexpected pointer type" + | ILType.Byref _ty -> failwith "unexpected byref type" + | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" + + member x.QualifiedName = + x.BasicQualifiedName + x.QualifiedNameExtension + + member x.TypeSpec = + match x with + | ILType.Boxed tr | ILType.Value tr -> tr + | _ -> failwithf "not a nominal type" + + member x.Boxity = + match x with + | ILType.Boxed _ -> AsObject + | ILType.Value _ -> AsValue + | _ -> failwithf "not a nominal type" + + member x.TypeRef = + match x with + | ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef + | _ -> failwithf "not a nominal type" + + member x.IsNominal = + match x with + | ILType.Boxed _ | ILType.Value _ -> true + | _ -> false + + member x.GenericArgs = + match x with + | ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs + | _ -> [| |] + + member x.IsTyvar = + match x with + | ILType.Var _ -> true | _ -> false + + override x.ToString() = x.QualifiedName + + and ILCallingSignature(callingConv: ILCallingConv, argTypes: ILTypes, returnType: ILType) = + member __.CallingConv = callingConv + member __.ArgTypes = argTypes + member __.ReturnType = returnType + + and ILGenericArgs = ILType[] + and ILTypes = ILType[] + + + type ILMethodRef(parent: ILTypeRef, callconv: ILCallingConv, genericArity: int, name: string, args: ILTypes, ret: ILType) = + member __.EnclosingTypeRef = parent + member __.CallingConv = callconv + member __.Name = name + member __.GenericArity = genericArity + member __.ArgCount = args.Length + member __.ArgTypes = args + member __.ReturnType = ret + + member x.CallingSignature = ILCallingSignature (x.CallingConv, x.ArgTypes, x.ReturnType) + override x.ToString() = x.EnclosingTypeRef.ToString() + "::" + x.Name + "(...)" + + + type ILFieldRef(enclosingTypeRef: ILTypeRef, name: string, typ: ILType) = + member __.EnclosingTypeRef = enclosingTypeRef + member __.Name = name + member __.Type = typ + override x.ToString() = x.EnclosingTypeRef.ToString() + "::" + x.Name + + type ILMethodSpec(methodRef: ILMethodRef, enclosingType: ILType, methodInst: ILGenericArgs) = + member __.MethodRef = methodRef + member __.EnclosingType = enclosingType + member __.GenericArgs = methodInst + member x.Name = x.MethodRef.Name + member x.CallingConv = x.MethodRef.CallingConv + member x.GenericArity = x.MethodRef.GenericArity + member x.FormalArgTypes = x.MethodRef.ArgTypes + member x.FormalReturnType = x.MethodRef.ReturnType + override x.ToString() = x.MethodRef.ToString() + "(...)" + + type ILFieldSpec(fieldRef: ILFieldRef, enclosingType: ILType) = + member __.FieldRef = fieldRef + member __.EnclosingType = enclosingType + member __.FormalType = fieldRef.Type + member __.Name = fieldRef.Name + member __.EnclosingTypeRef = fieldRef.EnclosingTypeRef + override x.ToString() = x.FieldRef.ToString() + + type ILCodeLabel = int + + // -------------------------------------------------------------------- + // Instruction set. + // -------------------------------------------------------------------- + + type ILBasicType = + | DT_R + | DT_I1 + | DT_U1 + | DT_I2 + | DT_U2 + | DT_I4 + | DT_U4 + | DT_I8 + | DT_U8 + | DT_R4 + | DT_R8 + | DT_I + | DT_U + | DT_REF + + [] + type ILToken = + | ILType of ILType + | ILMethod of ILMethodSpec + | ILField of ILFieldSpec + + [] + type ILConst = + | I4 of int32 + | I8 of int64 + | R4 of single + | R8 of double + + type ILTailcall = + | Tailcall + | Normalcall + + type ILAlignment = + | Aligned + | Unaligned1 + | Unaligned2 + | Unaligned4 + + type ILVolatility = + | Volatile + | Nonvolatile + + type ILReadonly = + | ReadonlyAddress + | NormalAddress + + type ILVarArgs = ILTypes option + + [] + type ILComparisonInstr = + | I_beq + | I_bge + | I_bge_un + | I_bgt + | I_bgt_un + | I_ble + | I_ble_un + | I_blt + | I_blt_un + | I_bne_un + | I_brfalse + | I_brtrue + + +#if DEBUG_INFO + type ILSourceMarker = + { sourceDocument: ILSourceDocument; + sourceLine: int; + sourceColumn: int; + sourceEndLine: int; + sourceEndColumn: int } + static member Create(document, line, column, endLine, endColumn) = + { sourceDocument=document; + sourceLine=line; + sourceColumn=column; + sourceEndLine=endLine; + sourceEndColumn=endColumn } + member x.Document=x.sourceDocument + member x.Line=x.sourceLine + member x.Column=x.sourceColumn + member x.EndLine=x.sourceEndLine + member x.EndColumn=x.sourceEndColumn + override x.ToString() = sprintf "(%d, %d)-(%d, %d)" x.Line x.Column x.EndLine x.EndColumn +#endif + + [] + type ILInstr = + | I_add + | I_add_ovf + | I_add_ovf_un + | I_and + | I_div + | I_div_un + | I_ceq + | I_cgt + | I_cgt_un + | I_clt + | I_clt_un + | I_conv of ILBasicType + | I_conv_ovf of ILBasicType + | I_conv_ovf_un of ILBasicType + | I_mul + | I_mul_ovf + | I_mul_ovf_un + | I_rem + | I_rem_un + | I_shl + | I_shr + | I_shr_un + | I_sub + | I_sub_ovf + | I_sub_ovf_un + | I_xor + | I_or + | I_neg + | I_not + | I_ldnull + | I_dup + | I_pop + | I_ckfinite + | I_nop + | I_ldc of ILBasicType * ILConst + | I_ldarg of int + | I_ldarga of int + | I_ldind of ILAlignment * ILVolatility * ILBasicType + | I_ldloc of int + | I_ldloca of int + | I_starg of int + | I_stind of ILAlignment * ILVolatility * ILBasicType + | I_stloc of int + + | I_br of ILCodeLabel + | I_jmp of ILMethodSpec + | I_brcmp of ILComparisonInstr * ILCodeLabel + | I_switch of ILCodeLabel list + | I_ret + + | I_call of ILTailcall * ILMethodSpec * ILVarArgs + | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs + | I_callconstraint of ILTailcall * ILType * ILMethodSpec * ILVarArgs + | I_calli of ILTailcall * ILCallingSignature * ILVarArgs + | I_ldftn of ILMethodSpec + | I_newobj of ILMethodSpec * ILVarArgs + + | I_throw + | I_endfinally + | I_endfilter + | I_leave of ILCodeLabel + | I_rethrow + + | I_ldsfld of ILVolatility * ILFieldSpec + | I_ldfld of ILAlignment * ILVolatility * ILFieldSpec + | I_ldsflda of ILFieldSpec + | I_ldflda of ILFieldSpec + | I_stsfld of ILVolatility * ILFieldSpec + | I_stfld of ILAlignment * ILVolatility * ILFieldSpec + | I_ldstr of string + | I_isinst of ILType + | I_castclass of ILType + | I_ldtoken of ILToken + | I_ldvirtftn of ILMethodSpec + + | I_cpobj of ILType + | I_initobj of ILType + | I_ldobj of ILAlignment * ILVolatility * ILType + | I_stobj of ILAlignment * ILVolatility * ILType + | I_box of ILType + | I_unbox of ILType + | I_unbox_any of ILType + | I_sizeof of ILType + + | I_ldelem of ILBasicType + | I_stelem of ILBasicType + | I_ldelema of ILReadonly * ILArrayShape * ILType + | I_ldelem_any of ILArrayShape * ILType + | I_stelem_any of ILArrayShape * ILType + | I_newarr of ILArrayShape * ILType + | I_ldlen + + | I_mkrefany of ILType + | I_refanytype + | I_refanyval of ILType + + | I_break +#if EMIT_DEBUG_INFO + | I_seqpoint of ILSourceMarker +#endif + | I_arglist + + | I_localloc + | I_cpblk of ILAlignment * ILVolatility + | I_initblk of ILAlignment * ILVolatility + + (* FOR EXTENSIONS, e.g. MS-ILX *) + | EI_ilzero of ILType + | EI_ldlen_multi of int32 * int32 + + + [] + type ILExceptionClause = + | Finally of (ILCodeLabel * ILCodeLabel) + | Fault of (ILCodeLabel * ILCodeLabel) + | FilterCatch of (ILCodeLabel * ILCodeLabel) * (ILCodeLabel * ILCodeLabel) + | TypeCatch of ILType * (ILCodeLabel * ILCodeLabel) + + [] + type ILExceptionSpec = + { Range: (ILCodeLabel * ILCodeLabel); + Clause: ILExceptionClause } + + /// Indicates that a particular local variable has a particular source + /// language name within a given set of ranges. This does not effect local + /// variable numbering, which is global over the whole method. + [] + type ILLocalDebugMapping = + { LocalIndex: int; + LocalName: string; } + + [] + type ILLocalDebugInfo = + { Range: (ILCodeLabel * ILCodeLabel); + DebugMappings: ILLocalDebugMapping[] } + + [] + type ILCode = + { Labels: Dictionary + Instrs:ILInstr[] + Exceptions: ILExceptionSpec[] + Locals: ILLocalDebugInfo[] } + + [] + type ILLocal = + { Type: ILType; + IsPinned: bool; + DebugInfo: (string * int * int) option } + + type ILLocals = ILLocal[] + + [] + type ILMethodBody = + { IsZeroInit: bool + MaxStack: int32 + Locals: ILLocals + Code: ILCode +#if EMIT_DEBUG_INFO + SourceMarker: ILSourceMarker option +#endif + } + + type ILPlatform = + | X86 + | AMD64 + | IA64 + + type ILCustomAttrNamedArg = ILCustomAttrNamedArg of (string * ILType * obj) + + type ILCustomAttribute = + { Method: ILMethodSpec + Data: byte[] + Elements: obj list} + + type ILCustomAttrs = + abstract Entries: ILCustomAttribute[] + + type ILCustomAttrsStatics() = + static let empty = { new ILCustomAttrs with member __.Entries = [| |] } + static member Empty = empty + + [] + type ILMemberAccess = + | Assembly + | CompilerControlled + | FamilyAndAssembly + | FamilyOrAssembly + | Family + | Private + | Public + static member OfFlags (flags: int) = + let f = (flags &&& 0x00000007) + if f = 0x00000001 then ILMemberAccess.Private + elif f = 0x00000006 then ILMemberAccess.Public + elif f = 0x00000004 then ILMemberAccess.Family + elif f = 0x00000002 then ILMemberAccess.FamilyAndAssembly + elif f = 0x00000005 then ILMemberAccess.FamilyOrAssembly + elif f = 0x00000003 then ILMemberAccess.Assembly + else ILMemberAccess.CompilerControlled + + [] + type ILFieldInit = obj + + type ILParameter = + { Name: string uoption + ParameterType: ILType + Default: ILFieldInit uoption + //Marshal: ILNativeType option + Attributes: ParameterAttributes + CustomAttrs: ILCustomAttrs } + member x.IsIn = ((x.Attributes &&& ParameterAttributes.In) <> enum 0) + member x.IsOut = ((x.Attributes &&& ParameterAttributes.Out) <> enum 0) + member x.IsOptional = ((x.Attributes &&& ParameterAttributes.Optional) <> enum 0) + + type ILParameters = ILParameter[] + + type ILReturn = + { //Marshal: ILNativeType option; + Type: ILType; + CustomAttrs: ILCustomAttrs } + + type ILOverridesSpec = + | OverridesSpec of ILMethodRef * ILType + member x.MethodRef = let (OverridesSpec(mr, _ty)) = x in mr + member x.EnclosingType = let (OverridesSpec(_mr, ty)) = x in ty + + [] + type ILGenericVariance = + | NonVariant + | CoVariant + | ContraVariant + + type ILGenericParameterDef = + { Name: string + Constraints: ILTypes + Attributes: GenericParameterAttributes + CustomAttrs: ILCustomAttrs + Token: int } + + member x.HasReferenceTypeConstraint= (x.Attributes &&& GenericParameterAttributes.ReferenceTypeConstraint) <> enum 0 + member x.HasNotNullableValueTypeConstraint= (x.Attributes &&& GenericParameterAttributes.NotNullableValueTypeConstraint) <> enum 0 + member x.HasDefaultConstructorConstraint= (x.Attributes &&& GenericParameterAttributes.DefaultConstructorConstraint) <> enum 0 + member x.IsCovariant = (x.Attributes &&& GenericParameterAttributes.Covariant) <> enum 0 + member x.IsContravariant = (x.Attributes &&& GenericParameterAttributes.Contravariant) <> enum 0 + override x.ToString() = x.Name + + type ILGenericParameterDefs = ILGenericParameterDef[] + + [] + type ILMethodDef = + { Token: int32 + Name: string + CallingConv: ILCallingConv + Parameters: ILParameters + Return: ILReturn + Body: ILMethodBody option + ImplAttributes: MethodImplAttributes + //SecurityDecls: ILPermissions + //HasSecurity: bool + IsEntryPoint:bool + Attributes: MethodAttributes + GenericParams: ILGenericParameterDefs + CustomAttrs: ILCustomAttrs } + member x.ParameterTypes = x.Parameters |> Array.map (fun p -> p.ParameterType) + static member ComputeIsStatic attrs = attrs &&& MethodAttributes.Static <> enum 0 + member x.IsStatic = ILMethodDef.ComputeIsStatic x.Attributes + member x.IsAbstract = x.Attributes &&& MethodAttributes.Abstract <> enum 0 + member x.IsVirtual = x.Attributes &&& MethodAttributes.Virtual <> enum 0 + member x.IsCheckAccessOnOverride = x.Attributes &&& MethodAttributes.CheckAccessOnOverride <> enum 0 + member x.IsNewSlot = x.Attributes &&& MethodAttributes.NewSlot <> enum 0 + member x.IsFinal = x.Attributes &&& MethodAttributes.Final <> enum 0 + member x.IsSpecialName = x.Attributes &&& MethodAttributes.SpecialName <> enum 0 + member x.IsRTSpecialName = x.Attributes &&& MethodAttributes.RTSpecialName <> enum 0 + member x.IsHideBySig = x.Attributes &&& MethodAttributes.HideBySig <> enum 0 + member x.IsClassInitializer = x.Name = ".cctor" + member x.IsConstructor = x.Name = ".ctor" + member x.IsInternalCall = (int x.ImplAttributes &&& 0x1000 <> 0) + member x.IsManaged = (int x.ImplAttributes &&& 0x0004 = 0) + member x.IsForwardRef = (int x.ImplAttributes &&& 0x0010 <> 0) + member x.IsPreserveSig = (int x.ImplAttributes &&& 0x0080 <> 0) + member x.IsMustRun = (int x.ImplAttributes &&& 0x0040 <> 0) + member x.IsSynchronized = (int x.ImplAttributes &&& 0x0020 <> 0) + member x.IsNoInline = (int x.ImplAttributes &&& 0x0008 <> 0) + member x.Access = ILMemberAccess.OfFlags (int x.Attributes) + + member md.CallingSignature = ILCallingSignature (md.CallingConv, md.ParameterTypes, md.Return.Type) + override x.ToString() = "method " + x.Name + + type ILMethodDefs(larr: Lazy) = + + let mutable lmap = null + let getmap() = + if lmap = null then + lmap <- Dictionary() + for y in larr.Force() do + let key = y.Name + if lmap.ContainsKey key then + lmap.[key] <- Array.append [| y |] lmap.[key] + else + lmap.[key] <- [| y |] + lmap + + member __.Entries = larr.Force() + member __.FindByName nm = + let scc, ys = getmap().TryGetValue(nm) + if scc then ys else Array.empty + member x.FindByNameAndArity (nm, arity) = x.FindByName nm |> Array.filter (fun x -> x.Parameters.Length = arity) + member x.TryFindUniqueByName name = + match x.FindByName(name) with + | [| md |] -> Some md + | [| |] -> None + | _ -> failwithf "multiple methods exist with name %s" name + + [] + type ILEventDef = + { //EventHandlerType: ILType option + Name: string + Attributes: System.Reflection.EventAttributes + AddMethod: ILMethodRef + RemoveMethod: ILMethodRef + //FireMethod: ILMethodRef option + //OtherMethods: ILMethodRef[] + CustomAttrs: ILCustomAttrs + Token: int } + member x.EventHandlerType = x.AddMethod.ArgTypes.[0] + member x.IsStatic = x.AddMethod.CallingConv.IsStatic + member x.IsSpecialName = (x.Attributes &&& EventAttributes.SpecialName) <> enum<_>(0) + member x.IsRTSpecialName = (x.Attributes &&& EventAttributes.RTSpecialName) <> enum<_>(0) + override x.ToString() = "event " + x.Name + + type ILEventDefs = + abstract Entries: ILEventDef[] + + [] + type ILPropertyDef = + { Name: string + Attributes: System.Reflection.PropertyAttributes + SetMethod: ILMethodRef option + GetMethod: ILMethodRef option + CallingConv: ILThisConvention + PropertyType: ILType + Init: ILFieldInit option + IndexParameterTypes: ILTypes + CustomAttrs: ILCustomAttrs + Token: int } + member x.IsStatic = (match x.CallingConv with ILThisConvention.Static -> true | _ -> false) + member x.IndexParameters = + x.IndexParameterTypes |> Array.mapi (fun i ty -> + { Name = USome("arg"+string i) + ParameterType = ty + Default = UNone + Attributes = ParameterAttributes.None + CustomAttrs = ILCustomAttrsStatics.Empty }) + member x.IsSpecialName = x.Attributes &&& PropertyAttributes.SpecialName <> enum 0 + member x.IsRTSpecialName = x.Attributes &&& PropertyAttributes.RTSpecialName <> enum 0 + override x.ToString() = "property " + x.Name + + type ILPropertyDefs = + abstract Entries: ILPropertyDef[] + + [] + type ILFieldDef = + { Name: string + FieldType: ILType + Attributes: FieldAttributes + //Data: byte[] option + LiteralValue: ILFieldInit option + Offset: int32 option + //Marshal: ILNativeType option + CustomAttrs: ILCustomAttrs + Token: int } + member x.IsStatic = x.Attributes &&& FieldAttributes.Static <> enum 0 + member x.IsInitOnly = x.Attributes &&& FieldAttributes.InitOnly <> enum 0 + member x.IsLiteral = x.Attributes &&& FieldAttributes.Literal <> enum 0 + member x.NotSerialized = x.Attributes &&& FieldAttributes.NotSerialized <> enum 0 + member x.IsSpecialName = x.Attributes &&& FieldAttributes.SpecialName <> enum 0 + //let isStatic = (flags &&& 0x0010) <> 0 + //{ Name = nm + // FieldType = readBlobHeapAsFieldSig numtypars typeIdx + // IsInitOnly = (flags &&& 0x0020) <> 0 + // IsLiteral = (flags &&& 0x0040) <> 0 + // NotSerialized = (flags &&& 0x0080) <> 0 + // IsSpecialName = (flags &&& 0x0200) <> 0 || (flags &&& 0x0400) <> 0 (* REVIEW: RTSpecialName *) + member x.Access = ILMemberAccess.OfFlags (int x.Attributes) + override x.ToString() = "field " + x.Name + + + type ILFieldDefs = + abstract Entries: ILFieldDef[] + + type ILMethodImplDef = + { Overrides: ILOverridesSpec + OverrideBy: ILMethodSpec } + + // Index table by name and arity. + type ILMethodImplDefs = + abstract Entries: ILMethodImplDef[] + + [] + type ILTypeInit = + | BeforeField + | OnAny + + [] + type ILDefaultPInvokeEncoding = + | Ansi + | Auto + | Unicode + + [] + type ILTypeDefLayout = + | Auto + | Sequential of ILTypeDefLayoutInfo + | Explicit of ILTypeDefLayoutInfo + + and ILTypeDefLayoutInfo = + { Size: int32 option + Pack: uint16 option } + + type ILTypeDefAccess = + | Public + | Private + | Nested of ILMemberAccess + static member OfFlags flags = + let f = (flags &&& 0x00000007) + if f = 0x00000001 then ILTypeDefAccess.Public + elif f = 0x00000002 then ILTypeDefAccess.Nested ILMemberAccess.Public + elif f = 0x00000003 then ILTypeDefAccess.Nested ILMemberAccess.Private + elif f = 0x00000004 then ILTypeDefAccess.Nested ILMemberAccess.Family + elif f = 0x00000006 then ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly + elif f = 0x00000007 then ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly + elif f = 0x00000005 then ILTypeDefAccess.Nested ILMemberAccess.Assembly + else ILTypeDefAccess.Private + + [] + type ILTypeDefKind = + | Class + | ValueType + | Interface + | Enum + | Delegate + + [] + type ILTypeDef = + { Namespace: string uoption + Name: string + GenericParams: ILGenericParameterDefs + Attributes: TypeAttributes + NestedTypes: ILTypeDefs + Layout: ILTypeDefLayout + Implements: ILTypes + Extends: ILType option + Methods: ILMethodDefs + Fields: ILFieldDefs + MethodImpls: ILMethodImplDefs + Events: ILEventDefs + Properties: ILPropertyDefs + CustomAttrs: ILCustomAttrs + Token: int } + static member ComputeKind flags (super: ILType option) (nsp: string uoption) (nm: string) = + if (flags &&& 0x00000020) <> 0x0 then ILTypeDefKind.Interface else + let isEnum = (match super with None -> false | Some ty -> ty.TypeSpec.Namespace = USome "System" && ty.TypeSpec.Name = "Enum") + let isDelegate = (match super with None -> false | Some ty -> ty.TypeSpec.Namespace = USome "System" && ty.TypeSpec.Name = "Delegate") + let isMulticastDelegate = (match super with None -> false | Some ty -> ty.TypeSpec.Namespace = USome "System" && ty.TypeSpec.Name = "MulticastDelegate") + let selfIsMulticastDelegate = (nsp = USome "System" && nm = "MulticastDelegate") + let isValueType = (match super with None -> false | Some ty -> ty.TypeSpec.Namespace = USome "System" && ty.TypeSpec.Name = "ValueType" && not (nsp = USome "System" && nm = "Enum")) + if isEnum then ILTypeDefKind.Enum + elif (isDelegate && not selfIsMulticastDelegate) || isMulticastDelegate then ILTypeDefKind.Delegate + elif isValueType then ILTypeDefKind.ValueType + else ILTypeDefKind.Class + + member x.Kind = ILTypeDef.ComputeKind (int x.Attributes) x.Extends x.Namespace x.Name + member x.IsClass = (match x.Kind with ILTypeDefKind.Class -> true | _ -> false) + member x.IsInterface = (match x.Kind with ILTypeDefKind.Interface -> true | _ -> false) + member x.IsEnum = (match x.Kind with ILTypeDefKind.Enum -> true | _ -> false) + member x.IsDelegate = (match x.Kind with ILTypeDefKind.Delegate -> true | _ -> false) + member x.IsAbstract= (x.Attributes &&& TypeAttributes.Abstract) <> enum 0 + member x.IsSealed= (x.Attributes &&& TypeAttributes.Sealed) <> enum 0 + member x.IsSerializable= (x.Attributes &&& TypeAttributes.Serializable) <> enum 0 + member x.IsComInterop= (x.Attributes &&& TypeAttributes.Import) <> enum 0 + member x.IsSpecialName= (x.Attributes &&& TypeAttributes.SpecialName) <> enum 0 + member x.Access = ILTypeDefAccess.OfFlags (int x.Attributes) + + member x.IsNested = + match x.Access with + | ILTypeDefAccess.Nested _ -> true + | _ -> false + + member tdef.IsStructOrEnum = + match tdef.Kind with + | ILTypeDefKind.ValueType | ILTypeDefKind.Enum -> true + | _ -> false + + member x.Encoding = + let f = (int x.Attributes &&& 0x00030000) + if f = 0x00020000 then ILDefaultPInvokeEncoding.Auto + elif f = 0x00010000 then ILDefaultPInvokeEncoding.Unicode + else ILDefaultPInvokeEncoding.Ansi + + member x.InitSemantics = + if x.Kind = ILTypeDefKind.Interface then ILTypeInit.OnAny + elif (int x.Attributes &&& 0x00100000) <> 0x0 then ILTypeInit.BeforeField + else ILTypeInit.OnAny + + override x.ToString() = "type " + x.Name + + and ILTypeDefs(larr: Lazy<(string uoption * string * Lazy)[]>) = + + let mutable lmap = null + let getmap() = + if lmap = null then + lmap <- Dictionary() + for (nsp, nm, ltd) in larr.Force() do + let key = nsp, nm + lmap.[key] <- ltd + lmap + + member __.Entries = + [| for (_, _, td) in larr.Force() -> td.Force() |] + + member __.TryFindByName (nsp, nm) = + let tdefs = getmap() + let key = (nsp, nm) + if tdefs.ContainsKey key then + Some (tdefs.[key].Force()) + else + None + + type ILNestedExportedType = + { Name: string + Access: ILMemberAccess + Nested: ILNestedExportedTypesAndForwarders + CustomAttrs: ILCustomAttrs } + override x.ToString() = "nested fwd " + x.Name + + and ILNestedExportedTypesAndForwarders(larr:Lazy) = + let lmap = lazy ((Map.empty, larr.Force()) ||> Array.fold (fun m x -> m.Add(x.Name, x))) + member __.Entries = larr.Force() + member __.TryFindByName nm = lmap.Force().TryFind nm + + and [] + ILExportedTypeOrForwarder = + { ScopeRef: ILScopeRef + Namespace: string uoption + Name: string + IsForwarder: bool + Access: ILTypeDefAccess; + Nested: ILNestedExportedTypesAndForwarders; + CustomAttrs: ILCustomAttrs } + override x.ToString() = "fwd " + x.Name + + and ILExportedTypesAndForwarders(larr:Lazy) = + let mutable lmap = null + let getmap() = + if lmap = null then + lmap <- Dictionary() + for ltd in larr.Force() do + let key = ltd.Namespace, ltd.Name + lmap.[key] <- ltd + lmap + member __.Entries = larr.Force() + member __.TryFindByName (nsp, nm) = match getmap().TryGetValue ((nsp, nm)) with true, v -> Some v | false, _ -> None + + [] + type ILResourceAccess = + | Public + | Private + + [] + type ILResourceLocation = + | Local of (unit -> byte[]) + | File of ILModuleRef * int32 + | Assembly of ILAssemblyRef + + type ILResource = + { Name: string + Location: ILResourceLocation + Access: ILResourceAccess + CustomAttrs: ILCustomAttrs } + override x.ToString() = "resource " + x.Name + + type ILResources(larr: Lazy) = + member __.Entries = larr.Force() + + type ILAssemblyManifest = + { Name: string + AuxModuleHashAlgorithm: int32 + PublicKey: byte[] uoption + Version: Version uoption + Locale: string uoption + CustomAttrs: ILCustomAttrs + //AssemblyLongevity: ILAssemblyLongevity + DisableJitOptimizations: bool + JitTracking: bool + IgnoreSymbolStoreSequencePoints: bool + Retargetable: bool + ExportedTypes: ILExportedTypesAndForwarders + EntrypointElsewhere: ILModuleRef option } + + member x.GetName() = + let asmName = AssemblyName(Name=x.Name) + match x.PublicKey with + | USome bytes -> asmName.SetPublicKey(bytes) + | UNone -> () + match x.Version with + | USome v -> asmName.Version <- v + | UNone -> () + asmName.CultureName <- System.Globalization.CultureInfo.InvariantCulture.Name + asmName + + override x.ToString() = "manifest " + x.Name + + type ILModuleDef = + { Manifest: ILAssemblyManifest option + CustomAttrs: ILCustomAttrs + Name: string + TypeDefs: ILTypeDefs + SubsystemVersion: int * int + UseHighEntropyVA: bool + (* Random bits of relatively uninteresting data *) + 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 } + + member x.ManifestOfAssembly = + match x.Manifest with + | Some m -> m + | None -> failwith "no manifest" + + member m.HasManifest = m.Manifest.IsSome + + override x.ToString() = "module " + x.Name + + + [] + type ILGlobals = + { typ_Object: ILType + typ_String: ILType + typ_Void: ILType + typ_Type: ILType + typ_TypedReference: ILType option + typ_SByte: ILType + typ_Int16: ILType + typ_Int32: ILType + typ_Array: ILType + typ_Int64: ILType + typ_Byte: ILType + typ_UInt16: ILType + typ_UInt32: ILType + typ_UInt64: ILType + typ_Single: ILType + typ_Double: ILType + typ_Boolean: ILType + typ_Char: ILType + typ_IntPtr: ILType + typ_UIntPtr: ILType + systemRuntimeScopeRef: ILScopeRef } + override __.ToString() = "" + + [] + + [] + type ILTableName(idx: int) = + member __.Index = idx + static member FromIndex n = ILTableName n + + module ILTableNames = + let Module = ILTableName 0 + let TypeRef = ILTableName 1 + let TypeDef = ILTableName 2 + let FieldPtr = ILTableName 3 + let Field = ILTableName 4 + let MethodPtr = ILTableName 5 + let Method = ILTableName 6 + let ParamPtr = ILTableName 7 + let Param = ILTableName 8 + let InterfaceImpl = ILTableName 9 + let MemberRef = ILTableName 10 + let Constant = ILTableName 11 + let CustomAttribute = ILTableName 12 + let FieldMarshal = ILTableName 13 + let Permission = ILTableName 14 + let ClassLayout = ILTableName 15 + let FieldLayout = ILTableName 16 + let StandAloneSig = ILTableName 17 + let EventMap = ILTableName 18 + let EventPtr = ILTableName 19 + let Event = ILTableName 20 + let PropertyMap = ILTableName 21 + let PropertyPtr = ILTableName 22 + let Property = ILTableName 23 + let MethodSemantics = ILTableName 24 + let MethodImpl = ILTableName 25 + let ModuleRef = ILTableName 26 + let TypeSpec = ILTableName 27 + let ImplMap = ILTableName 28 + let FieldRVA = ILTableName 29 + let ENCLog = ILTableName 30 + let ENCMap = ILTableName 31 + let Assembly = ILTableName 32 + let AssemblyProcessor = ILTableName 33 + let AssemblyOS = ILTableName 34 + let AssemblyRef = ILTableName 35 + let AssemblyRefProcessor = ILTableName 36 + let AssemblyRefOS = ILTableName 37 + let File = ILTableName 38 + let ExportedType = ILTableName 39 + let ManifestResource = ILTableName 40 + let Nested = ILTableName 41 + let GenericParam = ILTableName 42 + let MethodSpec = ILTableName 43 + let GenericParamConstraint = ILTableName 44 + let UserStrings = ILTableName 0x70 (* Special encoding of embedded UserString tokens - See 1.9 Partition III *) + + /// Which tables are sorted and by which column. + // + // Sorted bit-vector as stored by CLR V1: 00fa 0133 0002 0000 + // But what does this mean? The ECMA spec does not say! + // Metainfo -schema reports sorting as shown below. + // But some sorting, e.g. EventMap does not seem to show + let sortedTableInfo = + [ (InterfaceImpl, 0) + (Constant, 1) + (CustomAttribute, 0) + (FieldMarshal, 0) + (Permission, 1) + (ClassLayout, 2) + (FieldLayout, 1) + (MethodSemantics, 2) + (MethodImpl, 0) + (ImplMap, 1) + (FieldRVA, 1) + (Nested, 0) + (GenericParam, 2) + (GenericParamConstraint, 0) ] + + [] + type TypeDefOrRefOrSpecTag(tag: int32) = + member __.Tag = tag + static member TypeDef = TypeDefOrRefOrSpecTag 0x00 + static member TypeRef = TypeDefOrRefOrSpecTag 0x01 + static member TypeSpec = TypeDefOrRefOrSpecTag 0x2 + + [] + type HasConstantTag(tag: int32) = + member __.Tag = tag + static member FieldDef = HasConstantTag 0x0 + static member ParamDef = HasConstantTag 0x1 + static member Property = HasConstantTag 0x2 + + [] + type HasCustomAttributeTag(tag: int32) = + member __.Tag = tag + static member MethodDef = HasCustomAttributeTag 0x0 + static member FieldDef = HasCustomAttributeTag 0x1 + static member TypeRef = HasCustomAttributeTag 0x2 + static member TypeDef = HasCustomAttributeTag 0x3 + static member ParamDef = HasCustomAttributeTag 0x4 + static member InterfaceImpl = HasCustomAttributeTag 0x5 + static member MemberRef = HasCustomAttributeTag 0x6 + static member Module = HasCustomAttributeTag 0x7 + static member Permission = HasCustomAttributeTag 0x8 + static member Property = HasCustomAttributeTag 0x9 + static member Event = HasCustomAttributeTag 0xa + static member StandAloneSig = HasCustomAttributeTag 0xb + static member ModuleRef = HasCustomAttributeTag 0xc + static member TypeSpec = HasCustomAttributeTag 0xd + static member Assembly = HasCustomAttributeTag 0xe + static member AssemblyRef = HasCustomAttributeTag 0xf + static member File = HasCustomAttributeTag 0x10 + static member ExportedType = HasCustomAttributeTag 0x11 + static member ManifestResource = HasCustomAttributeTag 0x12 + static member GenericParam = HasCustomAttributeTag 0x13 + static member GenericParamConstraint = HasCustomAttributeTag 0x14 + static member MethodSpec = HasCustomAttributeTag 0x15 + + [] + type HasFieldMarshalTag(tag: int32) = + member __.Tag = tag + static member FieldDef = HasFieldMarshalTag 0x00 + static member ParamDef = HasFieldMarshalTag 0x01 + + [] + type HasDeclSecurityTag(tag: int32) = + member __.Tag = tag + static member TypeDef = HasDeclSecurityTag 0x00 + static member MethodDef = HasDeclSecurityTag 0x01 + static member Assembly = HasDeclSecurityTag 0x02 + + [] + type MemberRefParentTag(tag: int32) = + member __.Tag = tag + static member TypeRef = MemberRefParentTag 0x01 + static member ModuleRef = MemberRefParentTag 0x02 + static member MethodDef = MemberRefParentTag 0x03 + static member TypeSpec = MemberRefParentTag 0x04 + + [] + type HasSemanticsTag(tag: int32) = + member __.Tag = tag + static member Event = HasSemanticsTag 0x00 + static member Property = HasSemanticsTag 0x01 + + [] + type MethodDefOrRefTag(tag: int32) = + member __.Tag = tag + static member MethodDef = MethodDefOrRefTag 0x00 + static member MemberRef = MethodDefOrRefTag 0x01 + static member MethodSpec = MethodDefOrRefTag 0x02 + + [] + type MemberForwardedTag(tag: int32) = + member __.Tag = tag + static member FieldDef = MemberForwardedTag 0x00 + static member MethodDef = MemberForwardedTag 0x01 + + [] + type ImplementationTag(tag: int32) = + member __.Tag = tag + static member File = ImplementationTag 0x00 + static member AssemblyRef = ImplementationTag 0x01 + static member ExportedType = ImplementationTag 0x02 + + [] + type CustomAttributeTypeTag(tag: int32) = + member __.Tag = tag + static member MethodDef = CustomAttributeTypeTag 0x02 + static member MemberRef = CustomAttributeTypeTag 0x03 + + [] + type ResolutionScopeTag(tag: int32) = + member __.Tag = tag + static member Module = ResolutionScopeTag 0x00 + static member ModuleRef = ResolutionScopeTag 0x01 + static member AssemblyRef = ResolutionScopeTag 0x02 + static member TypeRef = ResolutionScopeTag 0x03 + + [] + type TypeOrMethodDefTag(tag: int32) = + member __.Tag = tag + static member TypeDef = TypeOrMethodDefTag 0x00 + static member MethodDef = TypeOrMethodDefTag 0x01 + + [] + type TaggedIndex<'T> = + val tag: 'T + val index: int32 + new(tag, index) = { tag=tag; index=index } + + + type ILImageChunk = { size: int32; addr: int32 } + + type ILRowElementKind = + | UShort + | ULong + | Byte + | Data + | GGuid + | Blob + | SString + | SimpleIndex of ILTableName + | TypeDefOrRefOrSpec + | TypeOrMethodDef + | HasConstant + | HasCustomAttribute + | HasFieldMarshal + | HasDeclSecurity + | MemberRefParent + | HasSemantics + | MethodDefOrRef + | MemberForwarded + | Implementation + | CustomAttributeType + | ResolutionScope + + type ILRowKind = ILRowKind of ILRowElementKind list + + type TypeDefAsTypIdx = TypeDefAsTypIdx of ILBoxity * ILGenericArgs * int + type TypeRefAsTypIdx = TypeRefAsTypIdx of ILBoxity * ILGenericArgs * int + type BlobAsMethodSigIdx = BlobAsMethodSigIdx of int * int32 + type BlobAsFieldSigIdx = BlobAsFieldSigIdx of int * int32 + type BlobAsPropSigIdx = BlobAsPropSigIdx of int * int32 + type BlobAsLocalSigIdx = BlobAsLocalSigIdx of int * int32 + type MemberRefAsMspecIdx = MemberRefAsMspecIdx of int * int + type MethodSpecAsMspecIdx = MethodSpecAsMspecIdx of int * int + type MemberRefAsFspecIdx = MemberRefAsFspecIdx of int * int + type CustomAttrIdx = CustomAttrIdx of CustomAttributeTypeTag * int * int32 + type SecurityDeclIdx = SecurityDeclIdx of uint16 * int32 + type GenericParamsIdx = GenericParamsIdx of int * TypeOrMethodDefTag * int + + type MethodData = MethodData of ILType * ILCallingConv * string * ILTypes * ILType * ILTypes + type VarArgMethodData = VarArgMethodData of ILType * ILCallingConv * string * ILTypes * ILVarArgs * ILType * ILTypes + + [] + module Constants = + let et_END = 0x00uy + let et_VOID = 0x01uy + let et_BOOLEAN = 0x02uy + let et_CHAR = 0x03uy + let et_I1 = 0x04uy + let et_U1 = 0x05uy + let et_I2 = 0x06uy + let et_U2 = 0x07uy + let et_I4 = 0x08uy + let et_U4 = 0x09uy + let et_I8 = 0x0Auy + let et_U8 = 0x0Buy + let et_R4 = 0x0Cuy + let et_R8 = 0x0Duy + let et_STRING = 0x0Euy + let et_PTR = 0x0Fuy + let et_BYREF = 0x10uy + let et_VALUETYPE = 0x11uy + let et_CLASS = 0x12uy + let et_VAR = 0x13uy + let et_ARRAY = 0x14uy + let et_WITH = 0x15uy + let et_TYPEDBYREF = 0x16uy + let et_I = 0x18uy + let et_U = 0x19uy + let et_FNPTR = 0x1Buy + let et_OBJECT = 0x1Cuy + let et_SZARRAY = 0x1Duy + let et_MVAR = 0x1euy + let et_CMOD_REQD = 0x1Fuy + let et_CMOD_OPT = 0x20uy + + let et_SENTINEL = 0x41uy // sentinel for varargs + let et_PINNED = 0x45uy + + let e_IMAGE_CEE_CS_CALLCONV_FASTCALL = 0x04uy + let e_IMAGE_CEE_CS_CALLCONV_STDCALL = 0x02uy + let e_IMAGE_CEE_CS_CALLCONV_THISCALL = 0x03uy + let e_IMAGE_CEE_CS_CALLCONV_CDECL = 0x01uy + let e_IMAGE_CEE_CS_CALLCONV_VARARG = 0x05uy + let e_IMAGE_CEE_CS_CALLCONV_FIELD = 0x06uy + let e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG = 0x07uy + let e_IMAGE_CEE_CS_CALLCONV_PROPERTY = 0x08uy + + let e_IMAGE_CEE_CS_CALLCONV_GENERICINST = 0x0auy + let e_IMAGE_CEE_CS_CALLCONV_GENERIC = 0x10uy + let e_IMAGE_CEE_CS_CALLCONV_INSTANCE = 0x20uy + let e_IMAGE_CEE_CS_CALLCONV_INSTANCE_EXPLICIT = 0x40uy + + + // Logical shift right treating int32 as unsigned integer. + // Code that uses this should probably be adjusted to use unsigned integer types. + let (>>>&) (x:int32) (n:int32) = int32 (uint32 x >>> n) + + let align alignment n = ((n + alignment - 0x1) / alignment) * alignment + + let uncodedToken (tab:ILTableName) idx = ((tab.Index <<< 24) ||| idx) + + let i32ToUncodedToken tok = + let idx = tok &&& 0xffffff + let tab = tok >>>& 24 + (ILTableName.FromIndex tab, idx) + + + let uncodedTokenToTypeDefOrRefOrSpec (tab, tok) = + let tag = + if tab = ILTableNames.TypeDef then TypeDefOrRefOrSpecTag.TypeDef + elif tab = ILTableNames.TypeRef then TypeDefOrRefOrSpecTag.TypeRef + elif tab = ILTableNames.TypeSpec then TypeDefOrRefOrSpecTag.TypeSpec + else failwith "bad table in uncodedTokenToTypeDefOrRefOrSpec" + TaggedIndex(tag, tok) + + let uncodedTokenToMethodDefOrRef (tab, tok) = + let tag = + if tab = ILTableNames.Method then MethodDefOrRefTag.MethodDef + elif tab = ILTableNames.MemberRef then MethodDefOrRefTag.MemberRef + else failwith "bad table in uncodedTokenToMethodDefOrRef" + TaggedIndex(tag, tok) + + let (|TaggedIndex|) (x:TaggedIndex<'T>) = x.tag, x.index + let tokToTaggedIdx f nbits tok = + let tagmask = + if nbits = 1 then 1 + elif nbits = 2 then 3 + elif nbits = 3 then 7 + elif nbits = 4 then 15 + elif nbits = 5 then 31 + else failwith "too many nbits" + let tag = tok &&& tagmask + let idx = tok >>>& nbits + TaggedIndex(f tag, idx) + + let i_nop = 0x00 + let i_break = 0x01 + let i_ldarg_0 = 0x02 + let i_ldarg_1 = 0x03 + let i_ldarg_2 = 0x04 + let i_ldarg_3 = 0x05 + let i_ldloc_0 = 0x06 + let i_ldloc_1 = 0x07 + let i_ldloc_2 = 0x08 + let i_ldloc_3 = 0x09 + let i_stloc_0 = 0x0a + let i_stloc_1 = 0x0b + let i_stloc_2 = 0x0c + let i_stloc_3 = 0x0d + let i_ldarg_s = 0x0e + let i_ldarga_s = 0x0f + let i_starg_s = 0x10 + let i_ldloc_s = 0x11 + let i_ldloca_s = 0x12 + let i_stloc_s = 0x13 + let i_ldnull = 0x14 + let i_ldc_i4_m1 = 0x15 + let i_ldc_i4_0 = 0x16 + let i_ldc_i4_1 = 0x17 + let i_ldc_i4_2 = 0x18 + let i_ldc_i4_3 = 0x19 + let i_ldc_i4_4 = 0x1a + let i_ldc_i4_5 = 0x1b + let i_ldc_i4_6 = 0x1c + let i_ldc_i4_7 = 0x1d + let i_ldc_i4_8 = 0x1e + let i_ldc_i4_s = 0x1f + let i_ldc_i4 = 0x20 + let i_ldc_i8 = 0x21 + let i_ldc_r4 = 0x22 + let i_ldc_r8 = 0x23 + let i_dup = 0x25 + let i_pop = 0x26 + let i_jmp = 0x27 + let i_call = 0x28 + let i_calli = 0x29 + let i_ret = 0x2a + let i_br_s = 0x2b + let i_brfalse_s = 0x2c + let i_brtrue_s = 0x2d + let i_beq_s = 0x2e + let i_bge_s = 0x2f + let i_bgt_s = 0x30 + let i_ble_s = 0x31 + let i_blt_s = 0x32 + let i_bne_un_s = 0x33 + let i_bge_un_s = 0x34 + let i_bgt_un_s = 0x35 + let i_ble_un_s = 0x36 + let i_blt_un_s = 0x37 + let i_br = 0x38 + let i_brfalse = 0x39 + let i_brtrue = 0x3a + let i_beq = 0x3b + let i_bge = 0x3c + let i_bgt = 0x3d + let i_ble = 0x3e + let i_blt = 0x3f + let i_bne_un = 0x40 + let i_bge_un = 0x41 + let i_bgt_un = 0x42 + let i_ble_un = 0x43 + let i_blt_un = 0x44 + let i_switch = 0x45 + let i_ldind_i1 = 0x46 + let i_ldind_u1 = 0x47 + let i_ldind_i2 = 0x48 + let i_ldind_u2 = 0x49 + let i_ldind_i4 = 0x4a + let i_ldind_u4 = 0x4b + let i_ldind_i8 = 0x4c + let i_ldind_i = 0x4d + let i_ldind_r4 = 0x4e + let i_ldind_r8 = 0x4f + let i_ldind_ref = 0x50 + let i_stind_ref = 0x51 + let i_stind_i1 = 0x52 + let i_stind_i2 = 0x53 + let i_stind_i4 = 0x54 + let i_stind_i8 = 0x55 + let i_stind_r4 = 0x56 + let i_stind_r8 = 0x57 + let i_add = 0x58 + let i_sub = 0x59 + let i_mul = 0x5a + let i_div = 0x5b + let i_div_un = 0x5c + let i_rem = 0x5d + let i_rem_un = 0x5e + let i_and = 0x5f + let i_or = 0x60 + let i_xor = 0x61 + let i_shl = 0x62 + let i_shr = 0x63 + let i_shr_un = 0x64 + let i_neg = 0x65 + let i_not = 0x66 + let i_conv_i1 = 0x67 + let i_conv_i2 = 0x68 + let i_conv_i4 = 0x69 + let i_conv_i8 = 0x6a + let i_conv_r4 = 0x6b + let i_conv_r8 = 0x6c + let i_conv_u4 = 0x6d + let i_conv_u8 = 0x6e + let i_callvirt = 0x6f + let i_cpobj = 0x70 + let i_ldobj = 0x71 + let i_ldstr = 0x72 + let i_newobj = 0x73 + let i_castclass = 0x74 + let i_isinst = 0x75 + let i_conv_r_un = 0x76 + let i_unbox = 0x79 + let i_throw = 0x7a + let i_ldfld = 0x7b + let i_ldflda = 0x7c + let i_stfld = 0x7d + let i_ldsfld = 0x7e + let i_ldsflda = 0x7f + let i_stsfld = 0x80 + let i_stobj = 0x81 + let i_conv_ovf_i1_un= 0x82 + let i_conv_ovf_i2_un= 0x83 + let i_conv_ovf_i4_un= 0x84 + let i_conv_ovf_i8_un= 0x85 + let i_conv_ovf_u1_un= 0x86 + let i_conv_ovf_u2_un= 0x87 + let i_conv_ovf_u4_un= 0x88 + let i_conv_ovf_u8_un= 0x89 + let i_conv_ovf_i_un = 0x8a + let i_conv_ovf_u_un = 0x8b + let i_box = 0x8c + let i_newarr = 0x8d + let i_ldlen = 0x8e + let i_ldelema = 0x8f + let i_ldelem_i1 = 0x90 + let i_ldelem_u1 = 0x91 + let i_ldelem_i2 = 0x92 + let i_ldelem_u2 = 0x93 + let i_ldelem_i4 = 0x94 + let i_ldelem_u4 = 0x95 + let i_ldelem_i8 = 0x96 + let i_ldelem_i = 0x97 + let i_ldelem_r4 = 0x98 + let i_ldelem_r8 = 0x99 + let i_ldelem_ref = 0x9a + let i_stelem_i = 0x9b + let i_stelem_i1 = 0x9c + let i_stelem_i2 = 0x9d + let i_stelem_i4 = 0x9e + let i_stelem_i8 = 0x9f + let i_stelem_r4 = 0xa0 + let i_stelem_r8 = 0xa1 + let i_stelem_ref = 0xa2 + let i_conv_ovf_i1 = 0xb3 + let i_conv_ovf_u1 = 0xb4 + let i_conv_ovf_i2 = 0xb5 + let i_conv_ovf_u2 = 0xb6 + let i_conv_ovf_i4 = 0xb7 + let i_conv_ovf_u4 = 0xb8 + let i_conv_ovf_i8 = 0xb9 + let i_conv_ovf_u8 = 0xba + let i_refanyval = 0xc2 + let i_ckfinite = 0xc3 + let i_mkrefany = 0xc6 + let i_ldtoken = 0xd0 + let i_conv_u2 = 0xd1 + let i_conv_u1 = 0xd2 + let i_conv_i = 0xd3 + let i_conv_ovf_i = 0xd4 + let i_conv_ovf_u = 0xd5 + let i_add_ovf = 0xd6 + let i_add_ovf_un = 0xd7 + let i_mul_ovf = 0xd8 + let i_mul_ovf_un = 0xd9 + let i_sub_ovf = 0xda + let i_sub_ovf_un = 0xdb + let i_endfinally = 0xdc + let i_leave = 0xdd + let i_leave_s = 0xde + let i_stind_i = 0xdf + let i_conv_u = 0xe0 + let i_arglist = 0xfe00 + let i_ceq = 0xfe01 + let i_cgt = 0xfe02 + let i_cgt_un = 0xfe03 + let i_clt = 0xfe04 + let i_clt_un = 0xfe05 + let i_ldftn = 0xfe06 + let i_ldvirtftn = 0xfe07 + let i_ldarg = 0xfe09 + let i_ldarga = 0xfe0a + let i_starg = 0xfe0b + let i_ldloc = 0xfe0c + let i_ldloca = 0xfe0d + let i_stloc = 0xfe0e + let i_localloc = 0xfe0f + let i_endfilter = 0xfe11 + let i_unaligned = 0xfe12 + let i_volatile = 0xfe13 + let i_constrained = 0xfe16 + let i_readonly = 0xfe1e + let i_tail = 0xfe14 + let i_initobj = 0xfe15 + let i_cpblk = 0xfe17 + let i_initblk = 0xfe18 + let i_rethrow = 0xfe1a + let i_sizeof = 0xfe1c + let i_refanytype = 0xfe1d + + let i_ldelem_any = 0xa3 + let i_stelem_any = 0xa4 + let i_unbox_any = 0xa5 + + let mk_ldc i = I_ldc (DT_I4, ILConst.I4 i) + let mk_ldc_i8 i = I_ldc (DT_I8, ILConst.I8 i) + let mkNormalCall mspec = I_call (Normalcall, mspec, None) + let mkILFormalGenericArgs numtypars (n:int) = + Array.init n (fun i -> ILType.Var (numtypars + i)) + + + let noArgInstrs = + lazy [ i_ldc_i4_0, mk_ldc 0 + i_ldc_i4_1, mk_ldc 1 + i_ldc_i4_2, mk_ldc 2 + i_ldc_i4_3, mk_ldc 3 + i_ldc_i4_4, mk_ldc 4 + i_ldc_i4_5, mk_ldc 5 + i_ldc_i4_6, mk_ldc 6 + i_ldc_i4_7, mk_ldc 7 + i_ldc_i4_8, mk_ldc 8 + i_ldc_i4_m1, mk_ldc -1 + 0x0a, I_stloc 0 + 0x0b, I_stloc 1 + 0x0c, I_stloc 2 + 0x0d, I_stloc 3 + 0x06, I_ldloc 0 + 0x07, I_ldloc 1 + 0x08, I_ldloc 2 + 0x09, I_ldloc 3 + 0x02, I_ldarg 0 + 0x03, I_ldarg 1 + 0x04, I_ldarg 2 + 0x05, I_ldarg 3 + 0x2a, I_ret + 0x58, I_add + 0xd6, I_add_ovf + 0xd7, I_add_ovf_un + 0x5f, I_and + 0x5b, I_div + 0x5c, I_div_un + 0xfe01, I_ceq + 0xfe02, I_cgt + 0xfe03, I_cgt_un + 0xfe04, I_clt + 0xfe05, I_clt_un + 0x67, I_conv DT_I1 + 0x68, I_conv DT_I2 + 0x69, I_conv DT_I4 + 0x6a, I_conv DT_I8 + 0xd3, I_conv DT_I + 0x6b, I_conv DT_R4 + 0x6c, I_conv DT_R8 + 0xd2, I_conv DT_U1 + 0xd1, I_conv DT_U2 + 0x6d, I_conv DT_U4 + 0x6e, I_conv DT_U8 + 0xe0, I_conv DT_U + 0x76, I_conv DT_R + 0xb3, I_conv_ovf DT_I1 + 0xb5, I_conv_ovf DT_I2 + 0xb7, I_conv_ovf DT_I4 + 0xb9, I_conv_ovf DT_I8 + 0xd4, I_conv_ovf DT_I + 0xb4, I_conv_ovf DT_U1 + 0xb6, I_conv_ovf DT_U2 + 0xb8, I_conv_ovf DT_U4 + 0xba, I_conv_ovf DT_U8 + 0xd5, I_conv_ovf DT_U + 0x82, I_conv_ovf_un DT_I1 + 0x83, I_conv_ovf_un DT_I2 + 0x84, I_conv_ovf_un DT_I4 + 0x85, I_conv_ovf_un DT_I8 + 0x8a, I_conv_ovf_un DT_I + 0x86, I_conv_ovf_un DT_U1 + 0x87, I_conv_ovf_un DT_U2 + 0x88, I_conv_ovf_un DT_U4 + 0x89, I_conv_ovf_un DT_U8 + 0x8b, I_conv_ovf_un DT_U + 0x9c, I_stelem DT_I1 + 0x9d, I_stelem DT_I2 + 0x9e, I_stelem DT_I4 + 0x9f, I_stelem DT_I8 + 0xa0, I_stelem DT_R4 + 0xa1, I_stelem DT_R8 + 0x9b, I_stelem DT_I + 0xa2, I_stelem DT_REF + 0x90, I_ldelem DT_I1 + 0x92, I_ldelem DT_I2 + 0x94, I_ldelem DT_I4 + 0x96, I_ldelem DT_I8 + 0x91, I_ldelem DT_U1 + 0x93, I_ldelem DT_U2 + 0x95, I_ldelem DT_U4 + 0x98, I_ldelem DT_R4 + 0x99, I_ldelem DT_R8 + 0x97, I_ldelem DT_I + 0x9a, I_ldelem DT_REF + 0x5a, I_mul + 0xd8, I_mul_ovf + 0xd9, I_mul_ovf_un + 0x5d, I_rem + 0x5e, I_rem_un + 0x62, I_shl + 0x63, I_shr + 0x64, I_shr_un + 0x59, I_sub + 0xda, I_sub_ovf + 0xdb, I_sub_ovf_un + 0x61, I_xor + 0x60, I_or + 0x65, I_neg + 0x66, I_not + i_ldnull, I_ldnull + i_dup, I_dup + i_pop, I_pop + i_ckfinite, I_ckfinite + i_nop, I_nop + i_break, I_break + i_arglist, I_arglist + i_endfilter, I_endfilter + i_endfinally, I_endfinally + i_refanytype, I_refanytype + i_localloc, I_localloc + i_throw, I_throw + i_ldlen, I_ldlen + i_rethrow, I_rethrow ] + + let isNoArgInstr i = + match i with + | I_ldc (DT_I4, ILConst.I4 n) when -1 <= n && n <= 8 -> true + | I_stloc n | I_ldloc n | I_ldarg n when n <= 3 -> true + | I_ret + | I_add + | I_add_ovf + | I_add_ovf_un + | I_and + | I_div + | I_div_un + | I_ceq + | I_cgt + | I_cgt_un + | I_clt + | I_clt_un + | I_conv DT_I1 + | I_conv DT_I2 + | I_conv DT_I4 + | I_conv DT_I8 + | I_conv DT_I + | I_conv DT_R4 + | I_conv DT_R8 + | I_conv DT_U1 + | I_conv DT_U2 + | I_conv DT_U4 + | I_conv DT_U8 + | I_conv DT_U + | I_conv DT_R + | I_conv_ovf DT_I1 + | I_conv_ovf DT_I2 + | I_conv_ovf DT_I4 + | I_conv_ovf DT_I8 + | I_conv_ovf DT_I + | I_conv_ovf DT_U1 + | I_conv_ovf DT_U2 + | I_conv_ovf DT_U4 + | I_conv_ovf DT_U8 + | I_conv_ovf DT_U + | I_conv_ovf_un DT_I1 + | I_conv_ovf_un DT_I2 + | I_conv_ovf_un DT_I4 + | I_conv_ovf_un DT_I8 + | I_conv_ovf_un DT_I + | I_conv_ovf_un DT_U1 + | I_conv_ovf_un DT_U2 + | I_conv_ovf_un DT_U4 + | I_conv_ovf_un DT_U8 + | I_conv_ovf_un DT_U + | I_stelem DT_I1 + | I_stelem DT_I2 + | I_stelem DT_I4 + | I_stelem DT_I8 + | I_stelem DT_R4 + | I_stelem DT_R8 + | I_stelem DT_I + | I_stelem DT_REF + | I_ldelem DT_I1 + | I_ldelem DT_I2 + | I_ldelem DT_I4 + | I_ldelem DT_I8 + | I_ldelem DT_U1 + | I_ldelem DT_U2 + | I_ldelem DT_U4 + | I_ldelem DT_R4 + | I_ldelem DT_R8 + | I_ldelem DT_I + | I_ldelem DT_REF + | I_mul + | I_mul_ovf + | I_mul_ovf_un + | I_rem + | I_rem_un + | I_shl + | I_shr + | I_shr_un + | I_sub + | I_sub_ovf + | I_sub_ovf_un + | I_xor + | I_or + | I_neg + | I_not + | I_ldnull + | I_dup + | I_pop + | I_ckfinite + | I_nop + | I_break + | I_arglist + | I_endfilter + | I_endfinally + | I_refanytype + | I_localloc + | I_throw + | I_ldlen + | I_rethrow -> true + | _ -> false + + let ILCmpInstrMap = + lazy ( + let dict = Dictionary 12 + dict.Add (I_beq , i_beq ) + dict.Add (I_bgt , i_bgt ) + dict.Add (I_bgt_un , i_bgt_un ) + dict.Add (I_bge , i_bge ) + dict.Add (I_bge_un , i_bge_un ) + dict.Add (I_ble , i_ble ) + dict.Add (I_ble_un , i_ble_un ) + dict.Add (I_blt , i_blt ) + dict.Add (I_blt_un , i_blt_un ) + dict.Add (I_bne_un , i_bne_un ) + dict.Add (I_brfalse , i_brfalse ) + dict.Add (I_brtrue , i_brtrue ) + dict + ) + + let ILCmpInstrRevMap = + lazy ( + let dict = Dictionary 12 + dict.Add ( I_beq , i_beq_s ) + dict.Add ( I_bgt , i_bgt_s ) + dict.Add ( I_bgt_un , i_bgt_un_s ) + dict.Add ( I_bge , i_bge_s ) + dict.Add ( I_bge_un , i_bge_un_s ) + dict.Add ( I_ble , i_ble_s ) + dict.Add ( I_ble_un , i_ble_un_s ) + dict.Add ( I_blt , i_blt_s ) + dict.Add ( I_blt_un , i_blt_un_s ) + dict.Add ( I_bne_un , i_bne_un_s ) + dict.Add ( I_brfalse , i_brfalse_s ) + dict.Add ( I_brtrue , i_brtrue_s ) + dict + ) + + // From corhdr.h + + let nt_VOID = 0x1uy + let nt_BOOLEAN = 0x2uy + let nt_I1 = 0x3uy + let nt_U1 = 0x4uy + let nt_I2 = 0x5uy + let nt_U2 = 0x6uy + let nt_I4 = 0x7uy + let nt_U4 = 0x8uy + let nt_I8 = 0x9uy + let nt_U8 = 0xAuy + let nt_R4 = 0xBuy + let nt_R8 = 0xCuy + let nt_SYSCHAR = 0xDuy + let nt_VARIANT = 0xEuy + let nt_CURRENCY = 0xFuy + let nt_PTR = 0x10uy + let nt_DECIMAL = 0x11uy + let nt_DATE = 0x12uy + let nt_BSTR = 0x13uy + let nt_LPSTR = 0x14uy + let nt_LPWSTR = 0x15uy + let nt_LPTSTR = 0x16uy + let nt_FIXEDSYSSTRING = 0x17uy + let nt_OBJECTREF = 0x18uy + let nt_IUNKNOWN = 0x19uy + let nt_IDISPATCH = 0x1Auy + let nt_STRUCT = 0x1Buy + let nt_INTF = 0x1Cuy + let nt_SAFEARRAY = 0x1Duy + let nt_FIXEDARRAY = 0x1Euy + let nt_INT = 0x1Fuy + let nt_UINT = 0x20uy + let nt_NESTEDSTRUCT = 0x21uy + let nt_BYVALSTR = 0x22uy + let nt_ANSIBSTR = 0x23uy + let nt_TBSTR = 0x24uy + let nt_VARIANTBOOL = 0x25uy + let nt_FUNC = 0x26uy + let nt_ASANY = 0x28uy + let nt_ARRAY = 0x2Auy + let nt_LPSTRUCT = 0x2Buy + let nt_CUSTOMMARSHALER = 0x2Cuy + let nt_ERROR = 0x2Duy + let nt_MAX = 0x50uy + + // From c:/clrenv.i386/Crt/Inc/i386/hs.h + + let vt_EMPTY = 0 + let vt_NULL = 1 + let vt_I2 = 2 + let vt_I4 = 3 + let vt_R4 = 4 + let vt_R8 = 5 + let vt_CY = 6 + let vt_DATE = 7 + let vt_BSTR = 8 + let vt_DISPATCH = 9 + let vt_ERROR = 10 + let vt_BOOL = 11 + let vt_VARIANT = 12 + let vt_UNKNOWN = 13 + let vt_DECIMAL = 14 + let vt_I1 = 16 + let vt_UI1 = 17 + let vt_UI2 = 18 + let vt_UI4 = 19 + let vt_I8 = 20 + let vt_UI8 = 21 + let vt_INT = 22 + let vt_UINT = 23 + let vt_VOID = 24 + let vt_HRESULT = 25 + let vt_PTR = 26 + let vt_SAFEARRAY = 27 + let vt_CARRAY = 28 + let vt_USERDEFINED = 29 + let vt_LPSTR = 30 + let vt_LPWSTR = 31 + let vt_RECORD = 36 + let vt_FILETIME = 64 + let vt_BLOB = 65 + let vt_STREAM = 66 + let vt_STORAGE = 67 + let vt_STREAMED_OBJECT = 68 + let vt_STORED_OBJECT = 69 + let vt_BLOB_OBJECT = 70 + let vt_CF = 71 + let vt_CLSID = 72 + let vt_VECTOR = 0x1000 + let vt_ARRAY = 0x2000 + let vt_BYREF = 0x4000 + + + + let e_CorILMethod_TinyFormat = 0x02uy + let e_CorILMethod_FatFormat = 0x03uy + let e_CorILMethod_FormatMask = 0x03uy + let e_CorILMethod_MoreSects = 0x08uy + let e_CorILMethod_InitLocals = 0x10uy + + + let e_CorILMethod_Sect_EHTable = 0x1uy + let e_CorILMethod_Sect_FatFormat = 0x40uy + let e_CorILMethod_Sect_MoreSects = 0x80uy + + let e_COR_ILEXCEPTION_CLAUSE_EXCEPTION = 0x0 + let e_COR_ILEXCEPTION_CLAUSE_FILTER = 0x1 + let e_COR_ILEXCEPTION_CLAUSE_FINALLY = 0x2 + let e_COR_ILEXCEPTION_CLAUSE_FAULT = 0x4 + + + module Bytes = + + let dWw1 n = int32 ((n >>> 32) &&& 0xFFFFFFFFL) + let dWw0 n = int32 (n &&& 0xFFFFFFFFL) + + let get (b:byte[]) n = int32 (Array.get b n) + let zeroCreate n: byte[] = Array.zeroCreate n + + let sub ( b:byte[]) s l = Array.sub b s l + let blit (a:byte[]) b c d e = Array.blit a b c d e + + let ofInt32Array (arr:int[]) = Array.init arr.Length (fun i -> byte arr.[i]) + + let stringAsUtf8NullTerminated (s:string) = + Array.append (Encoding.UTF8.GetBytes s) (ofInt32Array [| 0x0 |]) + + let stringAsUnicodeNullTerminated (s:string) = + Array.append (Encoding.Unicode.GetBytes s) (ofInt32Array [| 0x0;0x0 |]) + + type ByteStream = + { bytes: byte[] + mutable pos: int + max: int } + member b.ReadByte() = + if b.pos >= b.max then failwith "end of stream" + let res = b.bytes.[b.pos] + b.pos <- b.pos + 1 + res + member b.ReadUtf8String n = + let res = Encoding.UTF8.GetString(b.bytes, b.pos, n) + b.pos <- b.pos + n; res + + static member FromBytes (b:byte[], n, len) = + if n < 0 || (n+len) > b.Length then failwith "FromBytes" + { bytes = b; pos = n; max = n+len } + + member b.ReadBytes n = + if b.pos + n > b.max then failwith "ReadBytes: end of stream" + let res = Bytes.sub b.bytes b.pos n + b.pos <- b.pos + n + res + + member b.Position = b.pos + + + type ByteBuffer = + { mutable bbArray: byte[] + mutable bbCurrent: int } + + member buf.Ensure newSize = + let oldBufSize = buf.bbArray.Length + if newSize > oldBufSize then + let old = buf.bbArray + buf.bbArray <- Bytes.zeroCreate (max newSize (oldBufSize * 2)) + Bytes.blit old 0 buf.bbArray 0 buf.bbCurrent + + member buf.Close () = Bytes.sub buf.bbArray 0 buf.bbCurrent + + member buf.EmitIntAsByte (i:int) = + let newSize = buf.bbCurrent + 1 + buf.Ensure newSize + buf.bbArray.[buf.bbCurrent] <- byte i + buf.bbCurrent <- newSize + + member buf.EmitByte (b:byte) = buf.EmitIntAsByte (int b) + + member buf.EmitIntsAsBytes (arr:int[]) = + let n = arr.Length + let newSize = buf.bbCurrent + n + buf.Ensure newSize + let bbarr = buf.bbArray + let bbbase = buf.bbCurrent + for i = 0 to n - 1 do + bbarr.[bbbase + i] <- byte arr.[i] + buf.bbCurrent <- newSize + + member bb.FixupInt32 pos n = + bb.bbArray.[pos] <- (b0 n |> byte) + bb.bbArray.[pos + 1] <- (b1 n |> byte) + bb.bbArray.[pos + 2] <- (b2 n |> byte) + bb.bbArray.[pos + 3] <- (b3 n |> byte) + + member buf.EmitInt32 n = + let newSize = buf.bbCurrent + 4 + buf.Ensure newSize + buf.FixupInt32 buf.bbCurrent n + buf.bbCurrent <- newSize + + member buf.EmitBytes (i:byte[]) = + let n = i.Length + let newSize = buf.bbCurrent + n + buf.Ensure newSize + Bytes.blit i 0 buf.bbArray buf.bbCurrent n + buf.bbCurrent <- newSize + + member buf.EmitInt32AsUInt16 n = + let newSize = buf.bbCurrent + 2 + buf.Ensure newSize + buf.bbArray.[buf.bbCurrent] <- (b0 n |> byte) + buf.bbArray.[buf.bbCurrent + 1] <- (b1 n |> byte) + buf.bbCurrent <- newSize + + member buf.EmitBoolAsByte (b:bool) = buf.EmitIntAsByte (if b then 1 else 0) + + member buf.EmitUInt16 (x:uint16) = buf.EmitInt32AsUInt16 (int32 x) + + member buf.EmitInt64 x = + buf.EmitInt32 (Bytes.dWw0 x) + buf.EmitInt32 (Bytes.dWw1 x) + + member buf.Position = buf.bbCurrent + + static member Create sz = + { bbArray=Bytes.zeroCreate sz + bbCurrent = 0 } + + /// Z32 = compressed unsigned integer + static member Z32Size n = + if n <= 0x7F then 1 + elif n <= 0x3FFF then 2 + else 4 + + /// Emit int32 as compressed unsigned integer + member buf.EmitZ32 n = + if n >= 0 && n <= 0x7F then + buf.EmitIntAsByte n + elif n >= 0x80 && n <= 0x3FFF then + buf.EmitIntAsByte (0x80 ||| (n >>> 8)) + buf.EmitIntAsByte (n &&& 0xFF) + else + buf.EmitIntAsByte (0xc0l ||| ((n >>> 24) &&& 0xFF)) + buf.EmitIntAsByte ( (n >>> 16) &&& 0xFF) + buf.EmitIntAsByte ( (n >>> 8) &&& 0xFF) + buf.EmitIntAsByte ( n &&& 0xFF) + + static member Z32 n = let bb = ByteBuffer.Create (ByteBuffer.Z32Size n) in bb.EmitZ32 n; bb.Close() + + member buf.EmitPadding n = + for i = 0 to n-1 do + buf.EmitByte 0x0uy + + // Emit compressed untagged integer + member buf.EmitZUntaggedIndex big idx = + if big then buf.EmitInt32 idx + elif idx > 0xffff then failwith "EmitZUntaggedIndex: too big for small address or simple index" + else buf.EmitInt32AsUInt16 idx + + // Emit compressed tagged integer + member buf.EmitZTaggedIndex tag nbits big idx = + let idx2 = (idx <<< nbits) ||| tag + if big then buf.EmitInt32 idx2 + else buf.EmitInt32AsUInt16 idx2 + + //--------------------------------------------------------------------- + // Byte, byte array fragments and other concrete representations + // manipulations. + //--------------------------------------------------------------------- + + let bitsOfSingle (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x), 0) + let bitsOfDouble (x:float) = System.BitConverter.DoubleToInt64Bits(x) + + type ByteFile(bytes:byte[]) = + + member __.ReadByte addr = bytes.[addr] + + member __.ReadBytes addr len = Array.sub bytes addr len + + member __.CountUtf8String addr = + let mutable p = addr + while bytes.[p] <> 0uy do + p <- p + 1 + p - addr + + member m.ReadUTF8String addr = + let n = m.CountUtf8String addr + Encoding.UTF8.GetString (bytes, addr, n) + + member is.ReadInt32 addr = + let b0 = is.ReadByte addr + let b1 = is.ReadByte (addr+1) + let b2 = is.ReadByte (addr+2) + let b3 = is.ReadByte (addr+3) + int b0 ||| (int b1 <<< 8) ||| (int b2 <<< 16) ||| (int b3 <<< 24) + + member is.ReadUInt16 addr = + let b0 = is.ReadByte addr + let b1 = is.ReadByte (addr+1) + uint16 b0 ||| (uint16 b1 <<< 8) + + [] + module Reader = + let seekReadByte (is:ByteFile) addr = is.ReadByte addr + let seekReadBytes (is:ByteFile) addr len = is.ReadBytes addr len + let seekReadInt32 (is:ByteFile) addr = is.ReadInt32 addr + let seekReadUInt16 (is:ByteFile) addr = is.ReadUInt16 addr + + let seekReadByteAsInt32 is addr = int32 (seekReadByte is addr) + + let seekReadInt64 is addr = + let b0 = seekReadByte is addr + let b1 = seekReadByte is (addr+1) + let b2 = seekReadByte is (addr+2) + let b3 = seekReadByte is (addr+3) + let b4 = seekReadByte is (addr+4) + let b5 = seekReadByte is (addr+5) + let b6 = seekReadByte is (addr+6) + let b7 = seekReadByte is (addr+7) + int64 b0 ||| (int64 b1 <<< 8) ||| (int64 b2 <<< 16) ||| (int64 b3 <<< 24) ||| + (int64 b4 <<< 32) ||| (int64 b5 <<< 40) ||| (int64 b6 <<< 48) ||| (int64 b7 <<< 56) + + let seekReadUInt16AsInt32 is addr = int32 (seekReadUInt16 is addr) + + let seekReadCompressedUInt32 is addr = + let b0 = seekReadByte is addr + if b0 <= 0x7Fuy then int b0, addr+1 + elif b0 <= 0xBFuy then + let b0 = b0 &&& 0x7Fuy + let b1 = seekReadByteAsInt32 is (addr+1) + (int b0 <<< 8) ||| int b1, addr+2 + else + let b0 = b0 &&& 0x3Fuy + let b1 = seekReadByteAsInt32 is (addr+1) + let b2 = seekReadByteAsInt32 is (addr+2) + let b3 = seekReadByteAsInt32 is (addr+3) + (int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, addr+4 + + let seekReadSByte is addr = sbyte (seekReadByte is addr) + + let rec seekCountUtf8String is addr n = + let c = seekReadByteAsInt32 is addr + if c = 0 then n + else seekCountUtf8String is (addr+1) (n+1) + + let seekReadUTF8String is addr = + let n = seekCountUtf8String is addr 0 + let bytes = seekReadBytes is addr n + Encoding.UTF8.GetString (bytes, 0, bytes.Length) + + let seekReadBlob is addr = + let len, addr = seekReadCompressedUInt32 is addr + seekReadBytes is addr len + + let seekReadUserString is addr = + let len, addr = seekReadCompressedUInt32 is addr + let bytes = seekReadBytes is addr (len - 1) + Encoding.Unicode.GetString(bytes, 0, bytes.Length) + + let seekReadGuid is addr = seekReadBytes is addr 0x10 + + let seekReadUncodedToken is addr = + i32ToUncodedToken (seekReadInt32 is addr) + + let sigptrGetByte (bytes:byte[]) sigptr = + bytes.[sigptr], sigptr + 1 + + let sigptrGetBool bytes sigptr = + let b0, sigptr = sigptrGetByte bytes sigptr + (b0 = 0x01uy) , sigptr + + let sigptrGetSByte bytes sigptr = + let i, sigptr = sigptrGetByte bytes sigptr + sbyte i, sigptr + + let sigptrGetUInt16 bytes sigptr = + let b0, sigptr = sigptrGetByte bytes sigptr + let b1, sigptr = sigptrGetByte bytes sigptr + uint16 (int b0 ||| (int b1 <<< 8)), sigptr + + let sigptrGetInt16 bytes sigptr = + let u, sigptr = sigptrGetUInt16 bytes sigptr + int16 u, sigptr + + let sigptrGetInt32 (bytes: byte[]) sigptr = + let b0 = bytes.[sigptr] + let b1 = bytes.[sigptr+1] + let b2 = bytes.[sigptr+2] + let b3 = bytes.[sigptr+3] + let res = int b0 ||| (int b1 <<< 8) ||| (int b2 <<< 16) ||| (int b3 <<< 24) + res, sigptr + 4 + + let sigptrGetUInt32 bytes sigptr = + let u, sigptr = sigptrGetInt32 bytes sigptr + uint32 u, sigptr + + let sigptrGetUInt64 bytes sigptr = + let u0, sigptr = sigptrGetUInt32 bytes sigptr + let u1, sigptr = sigptrGetUInt32 bytes sigptr + (uint64 u0 ||| (uint64 u1 <<< 32)), sigptr + + let sigptrGetInt64 bytes sigptr = + let u, sigptr = sigptrGetUInt64 bytes sigptr + int64 u, sigptr + + let sigptrGetSingle bytes sigptr = + let u, sigptr = sigptrGetInt32 bytes sigptr + singleOfBits u, sigptr + + let sigptrGetDouble bytes sigptr = + let u, sigptr = sigptrGetInt64 bytes sigptr + doubleOfBits u, sigptr + + let sigptrGetZInt32 bytes sigptr = + let b0, sigptr = sigptrGetByte bytes sigptr + if b0 <= 0x7Fuy then int b0, sigptr + elif b0 <= 0xBFuy then + let b0 = b0 &&& 0x7Fuy + let b1, sigptr = sigptrGetByte bytes sigptr + (int b0 <<< 8) ||| int b1, sigptr + else + let b0 = b0 &&& 0x3Fuy + let b1, sigptr = sigptrGetByte bytes sigptr + let b2, sigptr = sigptrGetByte bytes sigptr + let b3, sigptr = sigptrGetByte bytes sigptr + (int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, sigptr + + let rec sigptrFoldAcc f n (bytes:byte[]) (sigptr:int) i acc = + if i < n then + let x, sp = f bytes sigptr + sigptrFoldAcc f n bytes sp (i+1) (x::acc) + else + Array.ofList (List.rev acc), sigptr + + let sigptrFold f n (bytes:byte[]) (sigptr:int) = + sigptrFoldAcc f n bytes sigptr 0 [] + + let sigptrGetBytes n (bytes:byte[]) sigptr = + let res = Array.zeroCreate n + for i = 0 to (n - 1) do + res.[i] <- bytes.[sigptr + i] + res, sigptr + n + + let sigptrGetString n bytes sigptr = + let bytearray, sigptr = sigptrGetBytes n bytes sigptr + (Encoding.UTF8.GetString(bytearray, 0, bytearray.Length)), sigptr + + let chunk sz next = ({addr=next; size=sz}, next + sz) + let nochunk next = ({addr= 0x0;size= 0x0; } , next) + + + let kindAssemblyRef = ILRowKind [ UShort; UShort; UShort; UShort; ULong; Blob; SString; SString; Blob; ] + let kindModuleRef = ILRowKind [ SString ] + let kindFileRef = ILRowKind [ ULong; SString; Blob ] + let kindTypeRef = ILRowKind [ ResolutionScope; SString; SString ] + let kindTypeSpec = ILRowKind [ Blob ] + let kindTypeDef = ILRowKind [ ULong; SString; SString; TypeDefOrRefOrSpec; SimpleIndex ILTableNames.Field; SimpleIndex ILTableNames.Method ] + let kindPropertyMap = ILRowKind [ SimpleIndex ILTableNames.TypeDef; SimpleIndex ILTableNames.Property ] + let kindEventMap = ILRowKind [ SimpleIndex ILTableNames.TypeDef; SimpleIndex ILTableNames.Event ] + let kindInterfaceImpl = ILRowKind [ SimpleIndex ILTableNames.TypeDef; TypeDefOrRefOrSpec ] + let kindNested = ILRowKind [ SimpleIndex ILTableNames.TypeDef; SimpleIndex ILTableNames.TypeDef ] + let kindCustomAttribute = ILRowKind [ HasCustomAttribute; CustomAttributeType; Blob ] + let kindDeclSecurity = ILRowKind [ UShort; HasDeclSecurity; Blob ] + let kindMemberRef = ILRowKind [ MemberRefParent; SString; Blob ] + let kindStandAloneSig = ILRowKind [ Blob ] + let kindFieldDef = ILRowKind [ UShort; SString; Blob ] + let kindFieldRVA = ILRowKind [ Data; SimpleIndex ILTableNames.Field ] + let kindFieldMarshal = ILRowKind [ HasFieldMarshal; Blob ] + let kindConstant = ILRowKind [ UShort;HasConstant; Blob ] + let kindFieldLayout = ILRowKind [ ULong; SimpleIndex ILTableNames.Field ] + let kindParam = ILRowKind [ UShort; UShort; SString ] + let kindMethodDef = ILRowKind [ ULong; UShort; UShort; SString; Blob; SimpleIndex ILTableNames.Param ] + let kindMethodImpl = ILRowKind [ SimpleIndex ILTableNames.TypeDef; MethodDefOrRef; MethodDefOrRef ] + let kindImplMap = ILRowKind [ UShort; MemberForwarded; SString; SimpleIndex ILTableNames.ModuleRef ] + let kindMethodSemantics = ILRowKind [ UShort; SimpleIndex ILTableNames.Method; HasSemantics ] + let kindProperty = ILRowKind [ UShort; SString; Blob ] + let kindEvent = ILRowKind [ UShort; SString; TypeDefOrRefOrSpec ] + let kindManifestResource = ILRowKind [ ULong; ULong; SString; Implementation ] + let kindClassLayout = ILRowKind [ UShort; ULong; SimpleIndex ILTableNames.TypeDef ] + let kindExportedType = ILRowKind [ ULong; ULong; SString; SString; Implementation ] + let kindAssembly = ILRowKind [ ULong; UShort; UShort; UShort; UShort; ULong; Blob; SString; SString ] + let kindGenericParam_v1_1 = ILRowKind [ UShort; UShort; TypeOrMethodDef; SString; TypeDefOrRefOrSpec ] + let kindGenericParam_v2_0 = ILRowKind [ UShort; UShort; TypeOrMethodDef; SString ] + let kindMethodSpec = ILRowKind [ MethodDefOrRef; Blob ] + let kindGenericParamConstraint = ILRowKind [ SimpleIndex ILTableNames.GenericParam; TypeDefOrRefOrSpec ] + let kindModule = ILRowKind [ UShort; SString; GGuid; GGuid; GGuid ] + let kindIllegal = ILRowKind [ ] + + let hcCompare (TaggedIndex((t1: HasConstantTag), (idx1:int))) (TaggedIndex((t2: HasConstantTag), idx2)) = + if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag + + let hsCompare (TaggedIndex((t1:HasSemanticsTag), (idx1:int))) (TaggedIndex((t2:HasSemanticsTag), idx2)) = + if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag + + let hcaCompare (TaggedIndex((t1:HasCustomAttributeTag), (idx1:int))) (TaggedIndex((t2:HasCustomAttributeTag), idx2)) = + if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag + + let mfCompare (TaggedIndex((t1:MemberForwardedTag), (idx1:int))) (TaggedIndex((t2:MemberForwardedTag), idx2)) = + if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag + + let hdsCompare (TaggedIndex((t1:HasDeclSecurityTag), (idx1:int))) (TaggedIndex((t2:HasDeclSecurityTag), idx2)) = + if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag + + let hfmCompare (TaggedIndex((t1:HasFieldMarshalTag), idx1)) (TaggedIndex((t2:HasFieldMarshalTag), idx2)) = + if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag + + let tomdCompare (TaggedIndex((t1:TypeOrMethodDefTag), idx1)) (TaggedIndex((t2:TypeOrMethodDefTag), idx2)) = + if idx1 < idx2 then -1 elif idx1 > idx2 then 1 else compare t1.Tag t2.Tag + + let simpleIndexCompare (idx1:int) (idx2:int) = + compare idx1 idx2 + + let mkCacheInt32 lowMem _infile _nm _sz = + if lowMem then (fun f x -> f x) else + let cache = ref null + fun f (idx:int32) -> + let cache = + match !cache with + | null -> cache := new Dictionary(11) + | _ -> () + !cache + let mutable res = Unchecked.defaultof<_> + let ok = cache.TryGetValue(idx, &res) + if ok then + res + else + let res = f idx + cache.[idx] <- res; + res + + let mkCacheGeneric lowMem _inbase _nm _sz = + if lowMem then (fun f x -> f x) else + let cache = ref null + fun f (idx :'T) -> + let cache = + match !cache with + | null -> cache := new Dictionary<_, _>(11 (* sz:int *) ) + | _ -> () + !cache + if cache.ContainsKey idx then cache.[idx] + else let res = f idx in cache.[idx] <- res; res + + let seekFindRow numRows rowChooser = + let mutable i = 1 + while (i <= numRows && not (rowChooser i)) do + i <- i + 1; + i + + // search for rows satisfying predicate + let seekReadIndexedRows (numRows, rowReader, keyFunc, keyComparer, binaryChop, rowConverter) = + if binaryChop then + let mutable low = 0 + let mutable high = numRows + 1 + begin + let mutable fin = false + while not fin do + if high - low <= 1 then + fin <- true + else + let mid = (low + high) / 2 + let midrow = rowReader mid + let c = keyComparer (keyFunc midrow) + if c > 0 then + low <- mid + elif c < 0 then + high <- mid + else + fin <- true + end; + let mutable res = [] + if high - low > 1 then + // now read off rows, forward and backwards + let mid = (low + high) / 2 + // read forward + begin + let mutable fin = false + let mutable curr = mid + while not fin do + if curr > numRows then + fin <- true; + else + let currrow = rowReader curr + if keyComparer (keyFunc currrow) = 0 then + res <- rowConverter currrow :: res; + else + fin <- true; + curr <- curr + 1; + done; + end; + res <- List.rev res; + // read backwards + begin + let mutable fin = false + let mutable curr = mid - 1 + while not fin do + if curr = 0 then + fin <- true + else + let currrow = rowReader curr + if keyComparer (keyFunc currrow) = 0 then + res <- rowConverter currrow :: res; + else + fin <- true; + curr <- curr - 1; + end; + res |> List.toArray + else + let res = ref [] + for i = 1 to numRows do + let rowinfo = rowReader i + if keyComparer (keyFunc rowinfo) = 0 then + res := rowConverter rowinfo :: !res; + List.rev !res |> List.toArray + + + let seekReadOptionalIndexedRow (info) = + match seekReadIndexedRows info with + | [| |] -> None + | xs -> Some xs.[0] + + let seekReadIndexedRow (info) = + match seekReadOptionalIndexedRow info with + | Some row -> row + | None -> failwith ("no row found for key when indexing table") + + let getName (ltd: Lazy) = + let td = ltd.Force() + (td.Name, ltd) + + let emptyILEvents = { new ILEventDefs with member __.Entries = [| |] } + let emptyILProperties = { new ILPropertyDefs with member __.Entries = [| |] } + let emptyILTypeDefs = ILTypeDefs (lazy [| |]) + let emptyILCustomAttrs = { new ILCustomAttrs with member __.Entries = [| |] } + let mkILCustomAttrs x = { new ILCustomAttrs with member __.Entries = x } + let emptyILMethodImpls = { new ILMethodImplDefs with member __.Entries = [| |] } + let emptyILMethods = ILMethodDefs (lazy [| |]) + let emptyILFields = { new ILFieldDefs with member __.Entries = [| |] } + + let mkILTy boxed tspec = + match boxed with + | AsObject -> ILType.Boxed tspec + | _ -> ILType.Value tspec + + let mkILArr1DTy ty = ILType.Array (ILArrayShape.SingleDimensional, ty) + + let typeNameForGlobalFunctions = "" + + let mkILNonGenericTySpec tref = ILTypeSpec (tref, [| |]) + let mkILTypeForGlobalFunctions scoref = ILType.Boxed (mkILNonGenericTySpec (ILTypeRef(ILTypeRefScope.Top scoref, UNone, typeNameForGlobalFunctions))) + let mkILArrTy (ty, shape) = ILType.Array(shape, ty) + + let mkILMethSpecInTyRaw (typ:ILType, cc, nm, args, rty, minst:ILGenericArgs) = + ILMethodSpec (ILMethodRef (typ.TypeRef, cc, minst.Length, nm, args, rty), typ, minst) + + let mkILFieldSpecInTy (typ:ILType, nm, fty) = + ILFieldSpec (ILFieldRef (typ.TypeRef, nm, fty), typ) + + let mkILGlobals systemRuntimeScopeRef = + let mkILTyspec nsp nm = mkILNonGenericTySpec(ILTypeRef(ILTypeRefScope.Top(systemRuntimeScopeRef), USome nsp, nm)) + { typ_Object = ILType.Boxed (mkILTyspec "System" "Object") + typ_String = ILType.Boxed (mkILTyspec "System" "String") + typ_Void = ILType.Value (mkILTyspec "System" "Void") + typ_Type = ILType.Boxed (mkILTyspec "System" "Type") + typ_Int64 = ILType.Value (mkILTyspec "System" "Int64") + typ_UInt64 = ILType.Value (mkILTyspec "System" "UInt64") + typ_Int32 = ILType.Value (mkILTyspec "System" "Int32") + typ_Array = ILType.Boxed (mkILTyspec "System" "Array") + typ_UInt32 = ILType.Value (mkILTyspec "System" "UInt32") + typ_Int16 = ILType.Value (mkILTyspec "System" "Int16") + typ_UInt16 = ILType.Value (mkILTyspec "System" "UInt16") + typ_SByte = ILType.Value (mkILTyspec "System" "SByte") + typ_Byte = ILType.Value (mkILTyspec "System" "Byte") + typ_Single = ILType.Value (mkILTyspec "System" "Single") + typ_Double = ILType.Value (mkILTyspec "System" "Double") + typ_Boolean = ILType.Value (mkILTyspec "System" "Boolean") + typ_Char = ILType.Value (mkILTyspec "System" "Char") + typ_IntPtr = ILType.Value (mkILTyspec "System" "IntPtr") + typ_TypedReference = Some (ILType.Value (mkILTyspec "System" "TypedReference")) + typ_UIntPtr = ILType.Value (mkILTyspec "System" "UIntPtr") + systemRuntimeScopeRef = systemRuntimeScopeRef } + + type PEReader(fileName: string, is: ByteFile) = + + //----------------------------------------------------------------------- + // Crack the binary headers, build a reader context and return the lazy + // read of the AbsIL module. + // ---------------------------------------------------------------------- + + (* MSDOS HEADER *) + let peSignaturePhysLoc = seekReadInt32 is 0x3c + + (* PE HEADER *) + let peFileHeaderPhysLoc = peSignaturePhysLoc + 0x04 + let peOptionalHeaderPhysLoc = peFileHeaderPhysLoc + 0x14 + let peSignature = seekReadInt32 is (peSignaturePhysLoc + 0) + do if peSignature <> 0x4550 then failwithf "not a PE file - bad magic PE number 0x%08x, is = %A" peSignature is; + + + (* PE SIGNATURE *) + let machine = seekReadUInt16AsInt32 is (peFileHeaderPhysLoc + 0) + let numSections = seekReadUInt16AsInt32 is (peFileHeaderPhysLoc + 2) + let optHeaderSize = seekReadUInt16AsInt32 is (peFileHeaderPhysLoc + 16) + do if optHeaderSize <> 0xe0 && + optHeaderSize <> 0xf0 then failwith "not a PE file - bad optional header size"; + let x64adjust = optHeaderSize - 0xe0 + let only64 = (optHeaderSize = 0xf0) (* May want to read in the optional header Magic number and check that as well... *) + let platform = match machine with | 0x8664 -> Some(AMD64) | 0x200 -> Some(IA64) | _ -> Some(X86) + let sectionHeadersStartPhysLoc = peOptionalHeaderPhysLoc + optHeaderSize + + let flags = seekReadUInt16AsInt32 is (peFileHeaderPhysLoc + 18) + let isDll = (flags &&& 0x2000) <> 0x0 + + (* OPTIONAL PE HEADER *) + (* x86: 000000a0 *) + (* x86: 000000b0 *) + let dataSegmentAddr = seekReadInt32 is (peOptionalHeaderPhysLoc + 24) (* e.g. 0x0000c000 *) + let imageBaseReal = if only64 then dataSegmentAddr else seekReadInt32 is (peOptionalHeaderPhysLoc + 28) (* Image Base Always 0x400000 (see Section 23.1). - QUERY: no it's not always 0x400000, e.g. 0x034f0000 *) + let alignVirt = seekReadInt32 is (peOptionalHeaderPhysLoc + 32) (* Section Alignment Always 0x2000 (see Section 23.1). *) + let alignPhys = seekReadInt32 is (peOptionalHeaderPhysLoc + 36) (* File Alignment Either 0x200 or 0x1000. *) + (* x86: 000000c0 *) + let subsysMajor = seekReadUInt16AsInt32 is (peOptionalHeaderPhysLoc + 48) (* SubSys Major Always 4 (see Section 23.1). *) + let subsysMinor = seekReadUInt16AsInt32 is (peOptionalHeaderPhysLoc + 50) (* SubSys Minor Always 0 (see Section 23.1). *) + (* x86: 000000d0 *) + let subsys = seekReadUInt16 is (peOptionalHeaderPhysLoc + 68) (* SubSystem Subsystem required to run this image. Shall be either IMAGE_SUBSYSTEM_WINDOWS_CE_GUI (!0x3) or IMAGE_SUBSYSTEM_WINDOWS_GUI (!0x2). QUERY: Why is this 3 on the images ILASM produces??? *) + let useHighEntropyVA = + let n = seekReadUInt16 is (peOptionalHeaderPhysLoc + 70) + let highEnthropyVA = 0x20us + (n &&& highEnthropyVA) = highEnthropyVA + + (* x86: 000000e0 *) + (* x86: 000000f0, x64: 00000100 *) + (* x86: 00000100 - these addresses are for x86 - for the x64 location, add x64adjust (0x10) *) + (* x86: 00000110 *) + (* x86: 00000120 *) + (* x86: 00000130 *) + (* x86: 00000140 *) + (* x86: 00000150 *) + (* x86: 00000160 *) + let cliHeaderAddr = seekReadInt32 is (peOptionalHeaderPhysLoc + 208 + x64adjust) + + let anyV2P (n, v) = + let rec look i pos = + if i >= numSections then (failwith (fileName + ": bad "+n+", rva "+string v); 0x0) + else + let virtSize = seekReadInt32 is (pos + 8) + let virtAddr = seekReadInt32 is (pos + 12) + let physLoc = seekReadInt32 is (pos + 20) + if (v >= virtAddr && (v < virtAddr + virtSize)) then (v - virtAddr) + physLoc + else look (i+1) (pos + 0x28) + look 0 sectionHeadersStartPhysLoc + + let cliHeaderPhysLoc = anyV2P ("cli header", cliHeaderAddr) + + let metadataAddr = seekReadInt32 is (cliHeaderPhysLoc + 8) + let metadataSize = seekReadInt32 is (cliHeaderPhysLoc + 12) + let cliFlags = seekReadInt32 is (cliHeaderPhysLoc + 16) + let ilOnly = (cliFlags &&& 0x01) <> 0x00 + let only32 = (cliFlags &&& 0x02) <> 0x00 + let is32bitpreferred = (cliFlags &&& 0x00020003) <> 0x00 + + let entryPointToken = seekReadUncodedToken is (cliHeaderPhysLoc + 20) + let resourcesAddr = seekReadInt32 is (cliHeaderPhysLoc + 24) + + let metadataPhysLoc = anyV2P ("metadata", metadataAddr) + let resourcePhysLoc offset = anyV2P ("resource", offset + resourcesAddr) + + member __.MetadataPhysLoc = metadataPhysLoc + member __.MetadataSize = metadataSize + member __.ResourcePhysLoc offset = resourcePhysLoc offset + + type ILModuleReader(fileName: string, is: ByteFile, ilg: ILGlobals, lowMem: bool) = + + let metadataPhysLoc = 0 + let magic = seekReadUInt16AsInt32 is metadataPhysLoc + do if magic <> 0x5342 then failwith (fileName + ": bad metadata magic number: " + string magic); + let magic2 = seekReadUInt16AsInt32 is (metadataPhysLoc + 2) + do if magic2 <> 0x424a then failwith "bad metadata magic number"; + + let versionLength = seekReadInt32 is (metadataPhysLoc + 12) + let ilMetadataVersion = seekReadBytes is (metadataPhysLoc + 16) versionLength |> Array.filter (fun b -> b <> 0uy) + let x = align 0x04 (16 + versionLength) + let numStreams = seekReadUInt16AsInt32 is (metadataPhysLoc + x + 2) + let streamHeadersStart = (metadataPhysLoc + x + 4) + + (* Crack stream headers *) + + let tryFindStream name = + let rec look i pos = + if i >= numStreams then None + else + let offset = seekReadInt32 is (pos + 0) + let length = seekReadInt32 is (pos + 4) + let res = ref true + let fin = ref false + let n = ref 0 + // read and compare the stream name byte by byte + while (not !fin) do + let c= seekReadByteAsInt32 is (pos + 8 + (!n)) + if c = 0 then + fin := true + elif !n >= Array.length name || c <> name.[!n] then + res := false; + incr n + if !res then Some(offset + metadataPhysLoc, length) + else look (i+1) (align 0x04 (pos + 8 + (!n))) + look 0 streamHeadersStart + + let findStream name = + match tryFindStream name with + | None -> (0x0, 0x0) + | Some positions -> positions + + let (tablesStreamPhysLoc, _tablesStreamSize) = + match tryFindStream [| 0x23; 0x7e |] (* #~ *) with + | Some res -> res + | None -> + match tryFindStream [| 0x23; 0x2d |] (* #-: at least one DLL I've seen uses this! *) with + | Some res -> res + | None -> + let firstStreamOffset = seekReadInt32 is (streamHeadersStart + 0) + let firstStreamLength = seekReadInt32 is (streamHeadersStart + 4) + firstStreamOffset, firstStreamLength + + let (stringsStreamPhysicalLoc, stringsStreamSize) = findStream [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; |] (* #Strings *) + let (blobsStreamPhysicalLoc, blobsStreamSize) = findStream [| 0x23; 0x42; 0x6c; 0x6f; 0x62; |] (* #Blob *) + + let tablesStreamMajorVersion = seekReadByteAsInt32 is (tablesStreamPhysLoc + 4) + let tablesStreamMinorVersion = seekReadByteAsInt32 is (tablesStreamPhysLoc + 5) + + let usingWhidbeyBeta1TableSchemeForGenericParam = (tablesStreamMajorVersion = 1) && (tablesStreamMinorVersion = 1) + + let tableKinds = + [|kindModule (* Table 0 *); + kindTypeRef (* Table 1 *); + kindTypeDef (* Table 2 *); + kindIllegal (* kindFieldPtr *) (* Table 3 *); + kindFieldDef (* Table 4 *); + kindIllegal (* kindMethodPtr *) (* Table 5 *); + kindMethodDef (* Table 6 *); + kindIllegal (* kindParamPtr *) (* Table 7 *); + kindParam (* Table 8 *); + kindInterfaceImpl (* Table 9 *); + kindMemberRef (* Table 10 *); + kindConstant (* Table 11 *); + kindCustomAttribute (* Table 12 *); + kindFieldMarshal (* Table 13 *); + kindDeclSecurity (* Table 14 *); + kindClassLayout (* Table 15 *); + kindFieldLayout (* Table 16 *); + kindStandAloneSig (* Table 17 *); + kindEventMap (* Table 18 *); + kindIllegal (* kindEventPtr *) (* Table 19 *); + kindEvent (* Table 20 *); + kindPropertyMap (* Table 21 *); + kindIllegal (* kindPropertyPtr *) (* Table 22 *); + kindProperty (* Table 23 *); + kindMethodSemantics (* Table 24 *); + kindMethodImpl (* Table 25 *); + kindModuleRef (* Table 26 *); + kindTypeSpec (* Table 27 *); + kindImplMap (* Table 28 *); + kindFieldRVA (* Table 29 *); + kindIllegal (* kindENCLog *) (* Table 30 *); + kindIllegal (* kindENCMap *) (* Table 31 *); + kindAssembly (* Table 32 *); + kindIllegal (* kindAssemblyProcessor *) (* Table 33 *); + kindIllegal (* kindAssemblyOS *) (* Table 34 *); + kindAssemblyRef (* Table 35 *); + kindIllegal (* kindAssemblyRefProcessor *) (* Table 36 *); + kindIllegal (* kindAssemblyRefOS *) (* Table 37 *); + kindFileRef (* Table 38 *); + kindExportedType (* Table 39 *); + kindManifestResource (* Table 40 *); + kindNested (* Table 41 *); + (if usingWhidbeyBeta1TableSchemeForGenericParam then kindGenericParam_v1_1 else kindGenericParam_v2_0); (* Table 42 *) + kindMethodSpec (* Table 43 *); + kindGenericParamConstraint (* Table 44 *); + kindIllegal (* Table 45 *); + kindIllegal (* Table 46 *); + kindIllegal (* Table 47 *); + kindIllegal (* Table 48 *); + kindIllegal (* Table 49 *); + kindIllegal (* Table 50 *); + kindIllegal (* Table 51 *); + kindIllegal (* Table 52 *); + kindIllegal (* Table 53 *); + kindIllegal (* Table 54 *); + kindIllegal (* Table 55 *); + kindIllegal (* Table 56 *); + kindIllegal (* Table 57 *); + kindIllegal (* Table 58 *); + kindIllegal (* Table 59 *); + kindIllegal (* Table 60 *); + kindIllegal (* Table 61 *); + kindIllegal (* Table 62 *); + kindIllegal (* Table 63 *); + |] + + let heapSizes = seekReadByteAsInt32 is (tablesStreamPhysLoc + 6) + let valid = seekReadInt64 is (tablesStreamPhysLoc + 8) + let sorted = seekReadInt64 is (tablesStreamPhysLoc + 16) + let tableRowCount, startOfTables = + let numRows = Array.create 64 0 + let prevNumRowIdx = ref (tablesStreamPhysLoc + 24) + for i = 0 to 63 do + if (valid &&& (int64 1 <<< i)) <> int64 0 then + numRows.[i] <- (seekReadInt32 is !prevNumRowIdx); + prevNumRowIdx := !prevNumRowIdx + 4 + numRows, !prevNumRowIdx + + let getNumRows (tab:ILTableName) = tableRowCount.[tab.Index] + let stringsBigness = (heapSizes &&& 1) <> 0 + let guidsBigness = (heapSizes &&& 2) <> 0 + let blobsBigness = (heapSizes &&& 4) <> 0 + + let tableBigness = Array.map (fun n -> n >= 0x10000) tableRowCount + + let codedBigness nbits tab = + let rows = getNumRows tab + rows >= (0x10000 >>>& nbits) + + let tdorBigness = + codedBigness 2 ILTableNames.TypeDef || + codedBigness 2 ILTableNames.TypeRef || + codedBigness 2 ILTableNames.TypeSpec + + let tomdBigness = + codedBigness 1 ILTableNames.TypeDef || + codedBigness 1 ILTableNames.Method + + let hcBigness = + codedBigness 2 ILTableNames.Field || + codedBigness 2 ILTableNames.Param || + codedBigness 2 ILTableNames.Property + + let hcaBigness = + codedBigness 5 ILTableNames.Method || + codedBigness 5 ILTableNames.Field || + codedBigness 5 ILTableNames.TypeRef || + codedBigness 5 ILTableNames.TypeDef || + codedBigness 5 ILTableNames.Param || + codedBigness 5 ILTableNames.InterfaceImpl || + codedBigness 5 ILTableNames.MemberRef || + codedBigness 5 ILTableNames.Module || + codedBigness 5 ILTableNames.Permission || + codedBigness 5 ILTableNames.Property || + codedBigness 5 ILTableNames.Event || + codedBigness 5 ILTableNames.StandAloneSig || + codedBigness 5 ILTableNames.ModuleRef || + codedBigness 5 ILTableNames.TypeSpec || + codedBigness 5 ILTableNames.Assembly || + codedBigness 5 ILTableNames.AssemblyRef || + codedBigness 5 ILTableNames.File || + codedBigness 5 ILTableNames.ExportedType || + codedBigness 5 ILTableNames.ManifestResource || + codedBigness 5 ILTableNames.GenericParam || + codedBigness 5 ILTableNames.GenericParamConstraint || + codedBigness 5 ILTableNames.MethodSpec + + + let hfmBigness = + codedBigness 1 ILTableNames.Field || + codedBigness 1 ILTableNames.Param + + let hdsBigness = + codedBigness 2 ILTableNames.TypeDef || + codedBigness 2 ILTableNames.Method || + codedBigness 2 ILTableNames.Assembly + + let mrpBigness = + codedBigness 3 ILTableNames.TypeRef || + codedBigness 3 ILTableNames.ModuleRef || + codedBigness 3 ILTableNames.Method || + codedBigness 3 ILTableNames.TypeSpec + + let hsBigness = + codedBigness 1 ILTableNames.Event || + codedBigness 1 ILTableNames.Property + + let mdorBigness = + codedBigness 1 ILTableNames.Method || + codedBigness 1 ILTableNames.MemberRef + + let mfBigness = + codedBigness 1 ILTableNames.Field || + codedBigness 1 ILTableNames.Method + + let iBigness = + codedBigness 2 ILTableNames.File || + codedBigness 2 ILTableNames.AssemblyRef || + codedBigness 2 ILTableNames.ExportedType + + let catBigness = + codedBigness 3 ILTableNames.Method || + codedBigness 3 ILTableNames.MemberRef + + let rsBigness = + codedBigness 2 ILTableNames.Module || + codedBigness 2 ILTableNames.ModuleRef || + codedBigness 2 ILTableNames.AssemblyRef || + codedBigness 2 ILTableNames.TypeRef + + let rowKindSize (ILRowKind kinds) = + kinds |> List.sumBy (fun x -> + match x with + | UShort -> 2 + | ULong -> 4 + | Byte -> 1 + | Data -> 4 + | GGuid -> (if guidsBigness then 4 else 2) + | Blob -> (if blobsBigness then 4 else 2) + | SString -> (if stringsBigness then 4 else 2) + | SimpleIndex tab -> (if tableBigness.[tab.Index] then 4 else 2) + | TypeDefOrRefOrSpec -> (if tdorBigness then 4 else 2) + | TypeOrMethodDef -> (if tomdBigness then 4 else 2) + | HasConstant -> (if hcBigness then 4 else 2) + | HasCustomAttribute -> (if hcaBigness then 4 else 2) + | HasFieldMarshal -> (if hfmBigness then 4 else 2) + | HasDeclSecurity -> (if hdsBigness then 4 else 2) + | MemberRefParent -> (if mrpBigness then 4 else 2) + | HasSemantics -> (if hsBigness then 4 else 2) + | MethodDefOrRef -> (if mdorBigness then 4 else 2) + | MemberForwarded -> (if mfBigness then 4 else 2) + | Implementation -> (if iBigness then 4 else 2) + | CustomAttributeType -> (if catBigness then 4 else 2) + | ResolutionScope -> (if rsBigness then 4 else 2)) + + let tableRowSizes = tableKinds |> Array.map rowKindSize + + let tablePhysLocations = + let res = Array.create 64 0x0 + let prevTablePhysLoc = ref startOfTables + for i = 0 to 63 do + res.[i] <- !prevTablePhysLoc; + prevTablePhysLoc := !prevTablePhysLoc + (tableRowCount.[i] * tableRowSizes.[i]); + res + + // All the caches. The sizes are guesstimates for the rough sharing-density of the assembly + let cacheAssemblyRef = mkCacheInt32 lowMem fileName "ILAssemblyRef" (getNumRows ILTableNames.AssemblyRef) + let cacheMemberRefAsMemberData = mkCacheGeneric lowMem fileName "MemberRefAsMemberData" (getNumRows ILTableNames.MemberRef / 20 + 1) + let cacheTypeRef = mkCacheInt32 lowMem fileName "ILTypeRef" (getNumRows ILTableNames.TypeRef / 20 + 1) + let cacheTypeRefAsType = mkCacheGeneric lowMem fileName "TypeRefAsType" (getNumRows ILTableNames.TypeRef / 20 + 1) + let cacheBlobHeapAsPropertySig = mkCacheGeneric lowMem fileName "BlobHeapAsPropertySig" (getNumRows ILTableNames.Property / 20 + 1) + let cacheBlobHeapAsFieldSig = mkCacheGeneric lowMem fileName "BlobHeapAsFieldSig" (getNumRows ILTableNames.Field / 20 + 1) + let cacheBlobHeapAsMethodSig = mkCacheGeneric lowMem fileName "BlobHeapAsMethodSig" (getNumRows ILTableNames.Method / 20 + 1) + let cacheTypeDefAsType = mkCacheGeneric lowMem fileName "TypeDefAsType" (getNumRows ILTableNames.TypeDef / 20 + 1) + let cacheMethodDefAsMethodData = mkCacheInt32 lowMem fileName "MethodDefAsMethodData" (getNumRows ILTableNames.Method / 20 + 1) + // nb. Lots and lots of cache hits on this cache, hence never optimize cache away + let cacheStringHeap = mkCacheInt32 false fileName "string heap" ( stringsStreamSize / 50 + 1) + let cacheBlobHeap = mkCacheInt32 lowMem fileName "blob heap" ( blobsStreamSize / 50 + 1) + + //----------------------------------------------------------------------- + + let rowAddr (tab:ILTableName) idx = tablePhysLocations.[tab.Index] + (idx - 1) * tableRowSizes.[tab.Index] + + let seekReadUInt16Adv (addr: byref) = + let res = seekReadUInt16 is addr + addr <- addr + 2 + res + + let seekReadInt32Adv (addr: byref) = + let res = seekReadInt32 is addr + addr <- addr+4 + res + + let seekReadUInt16AsInt32Adv (addr: byref) = + let res = seekReadUInt16AsInt32 is addr + addr <- addr+2 + res + + let seekReadTaggedIdx f nbits big (addr: byref) = + let tok = if big then seekReadInt32Adv &addr else seekReadUInt16AsInt32Adv &addr + tokToTaggedIdx f nbits tok + + + let seekReadIdx big (addr: byref) = + if big then seekReadInt32Adv &addr else seekReadUInt16AsInt32Adv &addr + + let seekReadUntaggedIdx (tab:ILTableName) (addr: byref) = + seekReadIdx tableBigness.[tab.Index] &addr + + + let seekReadResolutionScopeIdx (addr: byref) = seekReadTaggedIdx (fun idx -> ResolutionScopeTag idx) 2 rsBigness &addr + let seekReadTypeDefOrRefOrSpecIdx (addr: byref) = seekReadTaggedIdx (fun idx -> TypeDefOrRefOrSpecTag idx) 2 tdorBigness &addr + let seekReadTypeOrMethodDefIdx (addr: byref) = seekReadTaggedIdx (fun idx -> TypeOrMethodDefTag idx) 1 tomdBigness &addr + let seekReadHasConstantIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasConstantTag idx) 2 hcBigness &addr + let seekReadHasCustomAttributeIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasCustomAttributeTag idx) 5 hcaBigness &addr + //let seekReadHasFieldMarshalIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasFieldMarshalTag idx) 1 hfmBigness &addr + //let seekReadHasDeclSecurityIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasDeclSecurityTag idx) 2 hdsBigness &addr + let seekReadMemberRefParentIdx (addr: byref) = seekReadTaggedIdx (fun idx -> MemberRefParentTag idx) 3 mrpBigness &addr + let seekReadHasSemanticsIdx (addr: byref) = seekReadTaggedIdx (fun idx -> HasSemanticsTag idx) 1 hsBigness &addr + let seekReadMethodDefOrRefIdx (addr: byref) = seekReadTaggedIdx (fun idx -> MethodDefOrRefTag idx) 1 mdorBigness &addr + let seekReadImplementationIdx (addr: byref) = seekReadTaggedIdx (fun idx -> ImplementationTag idx) 2 iBigness &addr + let seekReadCustomAttributeTypeIdx (addr: byref) = seekReadTaggedIdx (fun idx -> CustomAttributeTypeTag idx) 3 catBigness &addr + let seekReadStringIdx (addr: byref) = seekReadIdx stringsBigness &addr + let seekReadGuidIdx (addr: byref) = seekReadIdx guidsBigness &addr + let seekReadBlobIdx (addr: byref) = seekReadIdx blobsBigness &addr + + let seekReadModuleRow idx = + if idx = 0 then failwith "cannot read Module table row 0"; + let mutable addr = rowAddr ILTableNames.Module idx + let generation = seekReadUInt16Adv &addr + let nameIdx = seekReadStringIdx &addr + let mvidIdx = seekReadGuidIdx &addr + let encidIdx = seekReadGuidIdx &addr + let encbaseidIdx = seekReadGuidIdx &addr + (generation, nameIdx, mvidIdx, encidIdx, encbaseidIdx) + + /// Read Table ILTypeRef + let seekReadTypeRefRow idx = + let mutable addr = rowAddr ILTableNames.TypeRef idx + let scopeIdx = seekReadResolutionScopeIdx &addr + let nameIdx = seekReadStringIdx &addr + let namespaceIdx = seekReadStringIdx &addr + (scopeIdx, nameIdx, namespaceIdx) + + /// Read Table ILTypeDef + let seekReadTypeDefRow idx = + let mutable addr = rowAddr ILTableNames.TypeDef idx + let flags = seekReadInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + let namespaceIdx = seekReadStringIdx &addr + let extendsIdx = seekReadTypeDefOrRefOrSpecIdx &addr + let fieldsIdx = seekReadUntaggedIdx ILTableNames.Field &addr + let methodsIdx = seekReadUntaggedIdx ILTableNames.Method &addr + (flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) + + /// Read Table Field + let seekReadFieldRow idx = + let mutable addr = rowAddr ILTableNames.Field idx + let flags = seekReadUInt16AsInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + let typeIdx = seekReadBlobIdx &addr + (flags, nameIdx, typeIdx) + + /// Read Table Method + let seekReadMethodRow idx = + let mutable addr = rowAddr ILTableNames.Method idx + let codeRVA = seekReadInt32Adv &addr + let implflags = seekReadUInt16AsInt32Adv &addr + let flags = seekReadUInt16AsInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + let typeIdx = seekReadBlobIdx &addr + let paramIdx = seekReadUntaggedIdx ILTableNames.Param &addr + (codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) + + /// Read Table Param + let seekReadParamRow idx = + let mutable addr = rowAddr ILTableNames.Param idx + let flags = seekReadUInt16AsInt32Adv &addr + let seq = seekReadUInt16AsInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + (flags, seq, nameIdx) + + let seekReadInterfaceImplRow idx = + let mutable addr = rowAddr ILTableNames.InterfaceImpl idx + let tidx = seekReadUntaggedIdx ILTableNames.TypeDef &addr + let intfIdx = seekReadTypeDefOrRefOrSpecIdx &addr + (tidx, intfIdx) + + /// Read Table MemberRef + let seekReadMemberRefRow idx = + let mutable addr = rowAddr ILTableNames.MemberRef idx + let mrpIdx = seekReadMemberRefParentIdx &addr + let nameIdx = seekReadStringIdx &addr + let typeIdx = seekReadBlobIdx &addr + (mrpIdx, nameIdx, typeIdx) + + /// Read Table Constant + let seekReadConstantRow idx = + let mutable addr = rowAddr ILTableNames.Constant idx + let kind = seekReadUInt16Adv &addr + let parentIdx = seekReadHasConstantIdx &addr + let valIdx = seekReadBlobIdx &addr + (kind, parentIdx, valIdx) + + /// Read Table CustomAttribute + let seekReadCustomAttributeRow idx = + let mutable addr = rowAddr ILTableNames.CustomAttribute idx + let parentIdx = seekReadHasCustomAttributeIdx &addr + let typeIdx = seekReadCustomAttributeTypeIdx &addr + let valIdx = seekReadBlobIdx &addr + (parentIdx, typeIdx, valIdx) + + //let seekReadFieldMarshalRow idx = + // let mutable addr = rowAddr TableNames.FieldMarshal idx + // let parentIdx = seekReadHasFieldMarshalIdx &addr + // let typeIdx = seekReadBlobIdx &addr + // (parentIdx, typeIdx) + + /// Read Table ClassLayout. + let seekReadClassLayoutRow idx = + let mutable addr = rowAddr ILTableNames.ClassLayout idx + let pack = seekReadUInt16Adv &addr + let size = seekReadInt32Adv &addr + let tidx = seekReadUntaggedIdx ILTableNames.TypeDef &addr + (pack, size, tidx) + + /// Read Table FieldLayout. + let seekReadFieldLayoutRow idx = + let mutable addr = rowAddr ILTableNames.FieldLayout idx + let offset = seekReadInt32Adv &addr + let fidx = seekReadUntaggedIdx ILTableNames.Field &addr + (offset, fidx) + + /// Read Table EventMap + let seekReadEventMapRow idx = + let mutable addr = rowAddr ILTableNames.EventMap idx + let tidx = seekReadUntaggedIdx ILTableNames.TypeDef &addr + let eventsIdx = seekReadUntaggedIdx ILTableNames.Event &addr + (tidx, eventsIdx) + + /// Read Table Event + let seekReadEventRow idx = + let mutable addr = rowAddr ILTableNames.Event idx + let flags = seekReadUInt16AsInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + let typIdx = seekReadTypeDefOrRefOrSpecIdx &addr + (flags, nameIdx, typIdx) + + /// Read Table PropertyMap + let seekReadPropertyMapRow idx = + let mutable addr = rowAddr ILTableNames.PropertyMap idx + let tidx = seekReadUntaggedIdx ILTableNames.TypeDef &addr + let propsIdx = seekReadUntaggedIdx ILTableNames.Property &addr + (tidx, propsIdx) + + /// Read Table Property + let seekReadPropertyRow idx = + let mutable addr = rowAddr ILTableNames.Property idx + let flags = seekReadUInt16AsInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + let typIdx = seekReadBlobIdx &addr + (flags, nameIdx, typIdx) + + /// Read Table MethodSemantics + let seekReadMethodSemanticsRow idx = + let mutable addr = rowAddr ILTableNames.MethodSemantics idx + let flags = seekReadUInt16AsInt32Adv &addr + let midx = seekReadUntaggedIdx ILTableNames.Method &addr + let assocIdx = seekReadHasSemanticsIdx &addr + (flags, midx, assocIdx) + + let seekReadMethodImplRow idx = + let mutable addr = rowAddr ILTableNames.MethodImpl idx + let tidx = seekReadUntaggedIdx ILTableNames.TypeDef &addr + let mbodyIdx = seekReadMethodDefOrRefIdx &addr + let mdeclIdx = seekReadMethodDefOrRefIdx &addr + (tidx, mbodyIdx, mdeclIdx) + + /// Read Table ILModuleRef + let seekReadModuleRefRow idx = + let mutable addr = rowAddr ILTableNames.ModuleRef idx + let nameIdx = seekReadStringIdx &addr + nameIdx + + /// Read Table ILTypeSpec + let seekReadTypeSpecRow idx = + let mutable addr = rowAddr ILTableNames.TypeSpec idx + let blobIdx = seekReadBlobIdx &addr + blobIdx + + /// Read Table Assembly + let seekReadAssemblyRow idx = + let mutable addr = rowAddr ILTableNames.Assembly idx + let hash = seekReadInt32Adv &addr + let v1 = seekReadUInt16Adv &addr + let v2 = seekReadUInt16Adv &addr + let v3 = seekReadUInt16Adv &addr + let v4 = seekReadUInt16Adv &addr + let flags = seekReadInt32Adv &addr + let publicKeyIdx = seekReadBlobIdx &addr + let nameIdx = seekReadStringIdx &addr + let localeIdx = seekReadStringIdx &addr + (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) + + /// Read Table ILAssemblyRef + let seekReadAssemblyRefRow idx = + let mutable addr = rowAddr ILTableNames.AssemblyRef idx + let v1 = seekReadUInt16Adv &addr + let v2 = seekReadUInt16Adv &addr + let v3 = seekReadUInt16Adv &addr + let v4 = seekReadUInt16Adv &addr + let flags = seekReadInt32Adv &addr + let publicKeyOrTokenIdx = seekReadBlobIdx &addr + let nameIdx = seekReadStringIdx &addr + let localeIdx = seekReadStringIdx &addr + let hashValueIdx = seekReadBlobIdx &addr + (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) + + /// Read Table File + let seekReadFileRow idx = + let mutable addr = rowAddr ILTableNames.File idx + let flags = seekReadInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + let hashValueIdx = seekReadBlobIdx &addr + (flags, nameIdx, hashValueIdx) + + /// Read Table ILExportedTypeOrForwarder + let seekReadExportedTypeRow idx = + let mutable addr = rowAddr ILTableNames.ExportedType idx + let flags = seekReadInt32Adv &addr + let tok = seekReadInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + let namespaceIdx = seekReadStringIdx &addr + let implIdx = seekReadImplementationIdx &addr + (flags, tok, nameIdx, namespaceIdx, implIdx) + + /// Read Table ManifestResource + let seekReadManifestResourceRow idx = + let mutable addr = rowAddr ILTableNames.ManifestResource idx + let offset = seekReadInt32Adv &addr + let flags = seekReadInt32Adv &addr + let nameIdx = seekReadStringIdx &addr + let implIdx = seekReadImplementationIdx &addr + (offset, flags, nameIdx, implIdx) + + /// Read Table Nested + let seekReadNestedRow idx = + let mutable addr = rowAddr ILTableNames.Nested idx + let nestedIdx = seekReadUntaggedIdx ILTableNames.TypeDef &addr + let enclIdx = seekReadUntaggedIdx ILTableNames.TypeDef &addr + (nestedIdx, enclIdx) + + /// Read Table GenericParam + let seekReadGenericParamRow idx = + let mutable addr = rowAddr ILTableNames.GenericParam idx + let seq = seekReadUInt16Adv &addr + let flags = seekReadUInt16Adv &addr + let ownerIdx = seekReadTypeOrMethodDefIdx &addr + let nameIdx = seekReadStringIdx &addr + (idx, seq, flags, ownerIdx, nameIdx) + + // Read Table GenericParamConstraint + let seekReadGenericParamConstraintRow idx = + let mutable addr = rowAddr ILTableNames.GenericParamConstraint idx + let pidx = seekReadUntaggedIdx ILTableNames.GenericParam &addr + let constraintIdx = seekReadTypeDefOrRefOrSpecIdx &addr + (pidx, constraintIdx) + + //let readUserStringHeapUncached idx = seekReadUserString is (userStringsStreamPhysicalLoc + idx) + //let readUserStringHeap = cacheUserStringHeap readUserStringHeapUncached + + let readStringHeapUncached idx = seekReadUTF8String is (stringsStreamPhysicalLoc + idx) + let readStringHeap = cacheStringHeap readStringHeapUncached + let readStringHeapOption idx = if idx = 0 then UNone else USome (readStringHeap idx) + + let emptyByteArray: byte[] = [||] + let readBlobHeapUncached idx = + // valid index lies in range [1..streamSize) + // NOTE: idx cannot be 0 - Blob\String heap has first empty element that is one byte 0 + if idx <= 0 || idx >= blobsStreamSize then emptyByteArray + else seekReadBlob is (blobsStreamPhysicalLoc + idx) + let readBlobHeap = cacheBlobHeap readBlobHeapUncached + let readBlobHeapOption idx = if idx = 0 then UNone else USome (readBlobHeap idx) + + //let readGuidHeap idx = seekReadGuid is (guidsStreamPhysicalLoc + idx) + + // read a single value out of a blob heap using the given function + let readBlobHeapAsBool vidx = fst (sigptrGetBool (readBlobHeap vidx) 0) + let readBlobHeapAsSByte vidx = fst (sigptrGetSByte (readBlobHeap vidx) 0) + let readBlobHeapAsInt16 vidx = fst (sigptrGetInt16 (readBlobHeap vidx) 0) + let readBlobHeapAsInt32 vidx = fst (sigptrGetInt32 (readBlobHeap vidx) 0) + let readBlobHeapAsInt64 vidx = fst (sigptrGetInt64 (readBlobHeap vidx) 0) + let readBlobHeapAsByte vidx = fst (sigptrGetByte (readBlobHeap vidx) 0) + let readBlobHeapAsUInt16 vidx = fst (sigptrGetUInt16 (readBlobHeap vidx) 0) + let readBlobHeapAsUInt32 vidx = fst (sigptrGetUInt32 (readBlobHeap vidx) 0) + let readBlobHeapAsUInt64 vidx = fst (sigptrGetUInt64 (readBlobHeap vidx) 0) + let readBlobHeapAsSingle vidx = fst (sigptrGetSingle (readBlobHeap vidx) 0) + let readBlobHeapAsDouble vidx = fst (sigptrGetDouble (readBlobHeap vidx) 0) + + //----------------------------------------------------------------------- + // Read the AbsIL structure (lazily) by reading off the relevant rows. + // ---------------------------------------------------------------------- + + let isSorted (tab:ILTableName) = ((sorted &&& (int64 1 <<< tab.Index)) <> int64 0x0) + + //let subsysversion = (subsysMajor, subsysMinor) + let ilMetadataVersion = Encoding.UTF8.GetString (ilMetadataVersion, 0, ilMetadataVersion.Length) + + let rec seekReadModule (ilMetadataVersion) idx = + let (_generation, nameIdx, _mvidIdx, _encidIdx, _encbaseidIdx) = seekReadModuleRow idx + let ilModuleName = readStringHeap nameIdx + //let nativeResources = readNativeResources tgt + + { Manifest = + if getNumRows (ILTableNames.Assembly) > 0 then Some (seekReadAssemblyManifest 1) + else None; + CustomAttrs = seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.Module, idx)); + Name = ilModuleName; + //NativeResources=nativeResources; + TypeDefs = ILTypeDefs (lazy (seekReadTopTypeDefs ())); + SubsystemVersion = (4, 0) + UseHighEntropyVA = false + SubSystemFlags=3 + IsDLL=true + IsILOnly=true + Platform=None + StackReserveSize=None + Is32Bit=false + Is32BitPreferred=false + Is64Bit=false + PhysicalAlignment=512 + VirtualAlignment=0x2000 + ImageBase=0x034f0000 + MetadataVersion="" + Resources = seekReadManifestResources () + } + + and seekReadAssemblyManifest idx = + let (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) = seekReadAssemblyRow idx + let name = readStringHeap nameIdx + let pubkey = readBlobHeapOption publicKeyIdx + { Name= name; + AuxModuleHashAlgorithm=hash + PublicKey= pubkey + Version= USome (Version(int v1, int v2, int v3, int v4)) + Locale= readStringHeapOption localeIdx + CustomAttrs = seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.Assembly, idx)) + ExportedTypes= seekReadTopExportedTypes () + EntrypointElsewhere=None + Retargetable = 0 <> (flags &&& 0x100); + DisableJitOptimizations = 0 <> (flags &&& 0x4000); + JitTracking = 0 <> (flags &&& 0x8000) + IgnoreSymbolStoreSequencePoints = 0 <> (flags &&& 0x2000) + } + + and seekReadAssemblyRef idx = cacheAssemblyRef seekReadAssemblyRefUncached idx + and seekReadAssemblyRefUncached idx = + let (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) = seekReadAssemblyRefRow idx + let nm = readStringHeap nameIdx + let publicKey = + match readBlobHeapOption publicKeyOrTokenIdx with + | UNone -> UNone + | USome blob -> USome (if (flags &&& 0x0001) <> 0x0 then PublicKey blob else PublicKeyToken blob) + + ILAssemblyRef + (name=nm, + hash=readBlobHeapOption hashValueIdx, + publicKey=publicKey, + retargetable=((flags &&& 0x0100) <> 0x0), + version=USome(Version(int v1, int v2, int v3, int v4)), + locale=readStringHeapOption localeIdx;) + + and seekReadModuleRef idx = + let nameIdx = seekReadModuleRefRow idx + ILModuleRef(name=readStringHeap nameIdx, hasMetadata=true, hash=UNone) + + and seekReadFile idx = + let (flags, nameIdx, hashValueIdx) = seekReadFileRow idx + ILModuleRef(name = readStringHeap nameIdx, + hasMetadata= ((flags &&& 0x0001) = 0x0), + hash= readBlobHeapOption hashValueIdx) + + and seekReadClassLayout idx = + match seekReadOptionalIndexedRow (getNumRows ILTableNames.ClassLayout, seekReadClassLayoutRow, (fun (_, _, tidx) -> tidx), simpleIndexCompare idx, isSorted ILTableNames.ClassLayout, (fun (pack, size, _) -> pack, size)) with + | None -> { Size = None; Pack = None } + | Some (pack, size) -> { Size = Some size; Pack = Some pack; } + + + and typeLayoutOfFlags flags tidx = + let f = (flags &&& 0x00000018) + if f = 0x00000008 then ILTypeDefLayout.Sequential (seekReadClassLayout tidx) + elif f = 0x00000010 then ILTypeDefLayout.Explicit (seekReadClassLayout tidx) + else ILTypeDefLayout.Auto + + and isTopTypeDef flags = + (ILTypeDefAccess.OfFlags flags = ILTypeDefAccess.Private) || + ILTypeDefAccess.OfFlags flags = ILTypeDefAccess.Public + + and seekIsTopTypeDefOfIdx idx = + let (flags, _, _, _, _, _) = seekReadTypeDefRow idx + isTopTypeDef flags + + and readStringHeapAsTypeName (nameIdx, namespaceIdx) = + let name = readStringHeap nameIdx + let nspace = readStringHeapOption namespaceIdx + nspace, name + + and seekReadTypeDefRowExtents _info (idx:int) = + if idx >= getNumRows ILTableNames.TypeDef then + getNumRows ILTableNames.Field + 1, + getNumRows ILTableNames.Method + 1 + else + let (_, _, _, _, fieldsIdx, methodsIdx) = seekReadTypeDefRow (idx + 1) + fieldsIdx, methodsIdx + + and seekReadTypeDefRowWithExtents (idx:int) = + let info= seekReadTypeDefRow idx + info, seekReadTypeDefRowExtents info idx + + and seekReadTypeDef toponly (idx:int) = + let (flags, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow idx + if toponly && not (isTopTypeDef flags) then None + else + + let name = readStringHeap nameIdx + let nspace = readStringHeapOption namespaceIdx + let rest = + lazy + let ((flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) as info) = seekReadTypeDefRow idx + let name = readStringHeap nameIdx + let nspace = readStringHeapOption namespaceIdx + let (endFieldsIdx, endMethodsIdx) = seekReadTypeDefRowExtents info idx + let typars = seekReadGenericParams 0 (TypeOrMethodDefTag.TypeDef, idx) + let numtypars = typars.Length + let super = seekReadOptionalTypeDefOrRef numtypars AsObject extendsIdx + let layout = typeLayoutOfFlags flags idx + //let hasLayout = (match layout with ILTypeDefLayout.Explicit _ -> true | _ -> false) + let hasLayout = false + let mdefs = seekReadMethods numtypars methodsIdx endMethodsIdx + let fdefs = seekReadFields (numtypars, hasLayout) fieldsIdx endFieldsIdx + let nested = seekReadNestedTypeDefs idx + let intfs = seekReadInterfaceImpls numtypars idx + //let sdecls = seekReadSecurityDecls (TaggedIndex(hds_TypeDef, idx)) + let mimpls = seekReadMethodImpls numtypars idx + let props = seekReadProperties numtypars idx + let events = seekReadEvents numtypars idx + let cas = seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.TypeDef, idx)) + { Namespace=nspace + Name=name + GenericParams=typars + Attributes = enum flags + Layout = layout + NestedTypes= nested + Implements = intfs + Extends = super + Methods = mdefs + + //SecurityDecls = sdecls + //HasSecurity=(flags &&& 0x00040000) <> 0x0 + Fields=fdefs + MethodImpls=mimpls + Events= events + Properties=props + CustomAttrs=cas + Token = idx } + Some (nspace, name, rest) + + and seekReadTopTypeDefs () = + [| for i = 1 to getNumRows ILTableNames.TypeDef do + match seekReadTypeDef true i with + | None -> () + | Some td -> yield td |] + + and seekReadNestedTypeDefs tidx = + ILTypeDefs + (lazy + let nestedIdxs = seekReadIndexedRows (getNumRows ILTableNames.Nested, seekReadNestedRow, snd, simpleIndexCompare tidx, false, fst) + [| for i in nestedIdxs do + match seekReadTypeDef false i with + | None -> () + | Some td -> yield td |]) + + and seekReadInterfaceImpls numtypars tidx = + seekReadIndexedRows (getNumRows ILTableNames.InterfaceImpl, seekReadInterfaceImplRow , fst, simpleIndexCompare tidx, isSorted ILTableNames.InterfaceImpl, (snd >> seekReadTypeDefOrRef numtypars AsObject [| |])) + + and seekReadGenericParams numtypars (a, b): ILGenericParameterDefs = + let pars = + seekReadIndexedRows + (getNumRows ILTableNames.GenericParam, seekReadGenericParamRow, + (fun (_, _, _, tomd, _) -> tomd), + tomdCompare (TaggedIndex(a, b)), + isSorted ILTableNames.GenericParam, + (fun (gpidx, seq, flags, _, nameIdx) -> + let constraints = seekReadGenericParamConstraintsUncached numtypars gpidx + let cas = seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.GenericParam, gpidx)) + seq, {Name=readStringHeap nameIdx + Constraints= constraints + CustomAttrs=cas + Attributes = enum (int32 flags) + Token=gpidx })) + pars |> Array.sortBy fst |> Array.map snd + + and seekReadGenericParamConstraintsUncached numtypars gpidx = + seekReadIndexedRows + (getNumRows ILTableNames.GenericParamConstraint, + seekReadGenericParamConstraintRow, + fst, + simpleIndexCompare gpidx, + isSorted ILTableNames.GenericParamConstraint, + (snd >> seekReadTypeDefOrRef numtypars AsObject (*ok*) [| |])) + + and seekReadTypeDefAsType boxity (ginst:ILTypes) idx = cacheTypeDefAsType seekReadTypeDefAsTypeUncached (TypeDefAsTypIdx (boxity, ginst, idx)) + + and seekReadTypeDefAsTypeUncached (TypeDefAsTypIdx (boxity, ginst, idx)) = + mkILTy boxity (ILTypeSpec(seekReadTypeDefAsTypeRef idx, ginst)) + + and seekReadTypeDefAsTypeRef idx = + let enc = + if seekIsTopTypeDefOfIdx idx then ILTypeRefScope.Top ILScopeRef.Local + else + let enclIdx = seekReadIndexedRow (getNumRows ILTableNames.Nested, seekReadNestedRow, fst, simpleIndexCompare idx, isSorted ILTableNames.Nested, snd) + let tref = seekReadTypeDefAsTypeRef enclIdx + ILTypeRefScope.Nested tref + let (_, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow idx + let nsp, nm = readStringHeapAsTypeName (nameIdx, namespaceIdx) + ILTypeRef(enc=enc, nsp = nsp, name = nm ) + + and seekReadTypeRef idx = cacheTypeRef seekReadTypeRefUncached idx + and seekReadTypeRefUncached idx = + let scopeIdx, nameIdx, namespaceIdx = seekReadTypeRefRow idx + let enc = seekReadTypeRefScope scopeIdx + let nsp, nm = readStringHeapAsTypeName (nameIdx, namespaceIdx) + ILTypeRef(enc, nsp, nm) + + and seekReadTypeRefAsType boxity ginst idx = cacheTypeRefAsType seekReadTypeRefAsTypeUncached (TypeRefAsTypIdx (boxity, ginst, idx)) + and seekReadTypeRefAsTypeUncached (TypeRefAsTypIdx (boxity, ginst, idx)) = + mkILTy boxity (ILTypeSpec(seekReadTypeRef idx, ginst)) + + and seekReadTypeDefOrRef numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, idx) ) = + match tag with + | tag when tag = TypeDefOrRefOrSpecTag.TypeDef -> seekReadTypeDefAsType boxity ginst idx + | tag when tag = TypeDefOrRefOrSpecTag.TypeRef -> seekReadTypeRefAsType boxity ginst idx + | tag when tag = TypeDefOrRefOrSpecTag.TypeSpec -> readBlobHeapAsType numtypars (seekReadTypeSpecRow idx) + | _ -> failwith "seekReadTypeDefOrRef" + + and seekReadTypeDefOrRefAsTypeRef (TaggedIndex(tag, idx) ) = + match tag with + | tag when tag = TypeDefOrRefOrSpecTag.TypeDef -> seekReadTypeDefAsTypeRef idx + | tag when tag = TypeDefOrRefOrSpecTag.TypeRef -> seekReadTypeRef idx + | tag when tag = TypeDefOrRefOrSpecTag.TypeSpec -> ilg.typ_Object.TypeRef + | _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec" + + and seekReadMethodRefParent numtypars (TaggedIndex(tag, idx)) = + match tag with + | tag when tag = MemberRefParentTag.TypeRef -> seekReadTypeRefAsType AsObject (* not ok - no way to tell if a member ref parent is a value type or not *) [| |] idx + | tag when tag = MemberRefParentTag.ModuleRef -> mkILTypeForGlobalFunctions (ILScopeRef.Module (seekReadModuleRef idx)) + | tag when tag = MemberRefParentTag.MethodDef -> + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData idx + let mspec = mkILMethSpecInTyRaw(enclTyp, cc, nm, argtys, retty, minst) + mspec.EnclosingType + | tag when tag = MemberRefParentTag.TypeSpec -> readBlobHeapAsType numtypars (seekReadTypeSpecRow idx) + | _ -> failwith "seekReadMethodRefParent" + + + and seekReadMethodDefOrRef numtypars (TaggedIndex(tag, idx)) = + match tag with + | tag when tag = MethodDefOrRefTag.MethodDef -> + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData idx + VarArgMethodData(enclTyp, cc, nm, argtys, None, retty, minst) + | tag when tag = MethodDefOrRefTag.MemberRef -> + seekReadMemberRefAsMethodData numtypars idx + | _ -> failwith "seekReadMethodDefOrRef ctxt" + + and seekReadMethodDefOrRefNoVarargs numtypars x = + let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) = seekReadMethodDefOrRef numtypars x + MethodData(enclTyp, cc, nm, argtys, retty, minst) + + and seekReadCustomAttrType (TaggedIndex(tag, idx) ) = + match tag with + | tag when tag = CustomAttributeTypeTag.MethodDef -> + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData idx + mkILMethSpecInTyRaw (enclTyp, cc, nm, argtys, retty, minst) + | tag when tag = CustomAttributeTypeTag.MemberRef -> + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMemberRefAsMethDataNoVarArgs 0 idx + mkILMethSpecInTyRaw (enclTyp, cc, nm, argtys, retty, minst) + | _ -> failwith "seekReadCustomAttrType" + + and seekReadImplAsScopeRef (TaggedIndex(tag, idx) ) = + if idx = 0 then ILScopeRef.Local + else + match tag with + | tag when tag = ImplementationTag.File -> ILScopeRef.Module (seekReadFile idx) + | tag when tag = ImplementationTag.AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef idx) + | tag when tag = ImplementationTag.ExportedType -> failwith "seekReadImplAsScopeRef" + | _ -> failwith "seekReadImplAsScopeRef" + + and seekReadTypeRefScope (TaggedIndex(tag, idx) ): ILTypeRefScope = + match tag with + | tag when tag = ResolutionScopeTag.Module -> ILTypeRefScope.Top(ILScopeRef.Local) + | tag when tag = ResolutionScopeTag.ModuleRef -> ILTypeRefScope.Top(ILScopeRef.Module (seekReadModuleRef idx)) + | tag when tag = ResolutionScopeTag.AssemblyRef -> ILTypeRefScope.Top(ILScopeRef.Assembly (seekReadAssemblyRef idx)) + | tag when tag = ResolutionScopeTag.TypeRef -> ILTypeRefScope.Nested (seekReadTypeRef idx) + | _ -> failwith "seekReadTypeRefScope" + + and seekReadOptionalTypeDefOrRef numtypars boxity idx = + if idx = TaggedIndex(TypeDefOrRefOrSpecTag.TypeDef, 0) then None + else Some (seekReadTypeDefOrRef numtypars boxity [| |] idx) + + and seekReadField (numtypars, hasLayout) (idx:int) = + let (flags, nameIdx, typeIdx) = seekReadFieldRow idx + let nm = readStringHeap nameIdx + let isStatic = (flags &&& 0x0010) <> 0 + { Name = nm + FieldType = readBlobHeapAsFieldSig numtypars typeIdx + LiteralValue = if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant (TaggedIndex(HasConstantTag.FieldDef, idx))) + //Marshal = + // if (flags &&& 0x1000) = 0 then None else + // Some (seekReadIndexedRow (getNumRows ILTableNames.FieldMarshal, seekReadFieldMarshalRow, + // fst, hfmCompare (TaggedIndex(hfm_FieldDef, idx)), + // isSorted ILTableNames.FieldMarshal, + // (snd >> readBlobHeapAsNativeType ctxt))) + //Data = + // if (flags &&& 0x0100) = 0 then None + // else + // let rva = seekReadIndexedRow (getNumRows ILTableNames.FieldRVA, seekReadFieldRVARow, + // snd, simpleIndexCompare idx, isSorted ILTableNames.FieldRVA, fst) + // Some (rvaToData "field" rva) + Attributes = enum(flags) + Offset = + if hasLayout && not isStatic then + Some (seekReadIndexedRow (getNumRows ILTableNames.FieldLayout, seekReadFieldLayoutRow, + snd, simpleIndexCompare idx, isSorted ILTableNames.FieldLayout, fst)) else None + CustomAttrs=seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.FieldDef, idx)) + Token = idx } + + and seekReadFields (numtypars, hasLayout) fidx1 fidx2 = + { new ILFieldDefs with + member __.Entries = + [| for i = fidx1 to fidx2 - 1 do + yield seekReadField (numtypars, hasLayout) i |] } + + and seekReadMethods numtypars midx1 midx2 = + ILMethodDefs + (lazy + [| for i = midx1 to midx2 - 1 do + yield seekReadMethod numtypars i |]) + + and sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr = + let n, sigptr = sigptrGetZInt32 bytes sigptr + if (n &&& 0x01) = 0x0 then (* Type Def *) + TaggedIndex(TypeDefOrRefOrSpecTag.TypeDef, (n >>>& 2)), sigptr + else (* Type Ref *) + TaggedIndex(TypeDefOrRefOrSpecTag.TypeRef, (n >>>& 2)), sigptr + + and sigptrGetTy numtypars bytes sigptr = + let b0, sigptr = sigptrGetByte bytes sigptr + if b0 = et_OBJECT then ilg.typ_Object , sigptr + elif b0 = et_STRING then ilg.typ_String, sigptr + elif b0 = et_I1 then ilg.typ_SByte, sigptr + elif b0 = et_I2 then ilg.typ_Int16, sigptr + elif b0 = et_I4 then ilg.typ_Int32, sigptr + elif b0 = et_I8 then ilg.typ_Int64, sigptr + elif b0 = et_I then ilg.typ_IntPtr, sigptr + elif b0 = et_U1 then ilg.typ_Byte, sigptr + elif b0 = et_U2 then ilg.typ_UInt16, sigptr + elif b0 = et_U4 then ilg.typ_UInt32, sigptr + elif b0 = et_U8 then ilg.typ_UInt64, sigptr + elif b0 = et_U then ilg.typ_UIntPtr, sigptr + elif b0 = et_R4 then ilg.typ_Single, sigptr + elif b0 = et_R8 then ilg.typ_Double, sigptr + elif b0 = et_CHAR then ilg.typ_Char, sigptr + elif b0 = et_BOOLEAN then ilg.typ_Boolean, sigptr + elif b0 = et_WITH then + let b0, sigptr = sigptrGetByte bytes sigptr + let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr + let n, sigptr = sigptrGetZInt32 bytes sigptr + let argtys, sigptr = sigptrFold (sigptrGetTy numtypars) n bytes sigptr + seekReadTypeDefOrRef numtypars (if b0 = et_CLASS then AsObject else AsValue) argtys tdorIdx, + sigptr + + elif b0 = et_CLASS then + let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr + seekReadTypeDefOrRef numtypars AsObject [| |] tdorIdx, sigptr + elif b0 = et_VALUETYPE then + let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr + seekReadTypeDefOrRef numtypars AsValue [| |] tdorIdx, sigptr + elif b0 = et_VAR then + let n, sigptr = sigptrGetZInt32 bytes sigptr + ILType.Var n, sigptr + elif b0 = et_MVAR then + let n, sigptr = sigptrGetZInt32 bytes sigptr + ILType.Var (n + numtypars), sigptr + elif b0 = et_BYREF then + let typ, sigptr = sigptrGetTy numtypars bytes sigptr + ILType.Byref typ, sigptr + elif b0 = et_PTR then + let typ, sigptr = sigptrGetTy numtypars bytes sigptr + ILType.Ptr typ, sigptr + elif b0 = et_SZARRAY then + let typ, sigptr = sigptrGetTy numtypars bytes sigptr + mkILArr1DTy typ, sigptr + elif b0 = et_ARRAY then + let typ, sigptr = sigptrGetTy numtypars bytes sigptr + let rank, sigptr = sigptrGetZInt32 bytes sigptr + let numSized, sigptr = sigptrGetZInt32 bytes sigptr + let sizes, sigptr = sigptrFold sigptrGetZInt32 numSized bytes sigptr + let numLoBounded, sigptr = sigptrGetZInt32 bytes sigptr + let lobounds, sigptr = sigptrFold sigptrGetZInt32 numLoBounded bytes sigptr + let shape = + let dim i = + (if i < numLoBounded then Some lobounds.[i] else None), + (if i < numSized then Some sizes.[i] else None) + ILArrayShape (Array.init rank dim) + ILType.Array (shape, typ), sigptr + + elif b0 = et_VOID then ILType.Void, sigptr + elif b0 = et_TYPEDBYREF then + match ilg.typ_TypedReference with + | Some t -> t, sigptr + | _ -> failwith "system runtime doesn't contain System.TypedReference" + elif b0 = et_CMOD_REQD || b0 = et_CMOD_OPT then + let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr + let typ, sigptr = sigptrGetTy numtypars bytes sigptr + ILType.Modified((b0 = et_CMOD_REQD), seekReadTypeDefOrRefAsTypeRef tdorIdx, typ), sigptr + elif b0 = et_FNPTR then + let ccByte, sigptr = sigptrGetByte bytes sigptr + let generic, cc = byteAsCallConv ccByte + if generic then failwith "fptr sig may not be generic" + let numparams, sigptr = sigptrGetZInt32 bytes sigptr + let retty, sigptr = sigptrGetTy numtypars bytes sigptr + let argtys, sigptr = sigptrFold (sigptrGetTy numtypars) ( numparams) bytes sigptr + ILType.FunctionPointer (ILCallingSignature(cc, argtys, retty)), sigptr + elif b0 = et_SENTINEL then failwith "varargs NYI" + else ILType.Void , sigptr + + and sigptrGetVarArgTys n numtypars bytes sigptr = + sigptrFold (sigptrGetTy numtypars) n bytes sigptr + + and sigptrGetArgTys n numtypars bytes sigptr acc = + if n <= 0 then (Array.ofList (List.rev acc), None), sigptr + else + let b0, sigptr2 = sigptrGetByte bytes sigptr + if b0 = et_SENTINEL then + let varargs, sigptr = sigptrGetVarArgTys n numtypars bytes sigptr2 + (Array.ofList (List.rev acc), Some( varargs)), sigptr + else + let x, sigptr = sigptrGetTy numtypars bytes sigptr + sigptrGetArgTys (n-1) numtypars bytes sigptr (x::acc) + + and readBlobHeapAsMethodSig numtypars blobIdx = cacheBlobHeapAsMethodSig readBlobHeapAsMethodSigUncached (BlobAsMethodSigIdx (numtypars, blobIdx)) + + and readBlobHeapAsMethodSigUncached (BlobAsMethodSigIdx (numtypars, blobIdx)) = + let bytes = readBlobHeap blobIdx + let sigptr = 0 + let ccByte, sigptr = sigptrGetByte bytes sigptr + let generic, cc = byteAsCallConv ccByte + let genarity, sigptr = if generic then sigptrGetZInt32 bytes sigptr else 0x0, sigptr + let numparams, sigptr = sigptrGetZInt32 bytes sigptr + let retty, sigptr = sigptrGetTy numtypars bytes sigptr + let (argtys, varargs), _sigptr = sigptrGetArgTys ( numparams) numtypars bytes sigptr [] + generic, genarity, cc, retty, argtys, varargs + + and readBlobHeapAsType numtypars blobIdx = + let bytes = readBlobHeap blobIdx + let ty, _sigptr = sigptrGetTy numtypars bytes 0 + ty + + and readBlobHeapAsFieldSig numtypars blobIdx = cacheBlobHeapAsFieldSig readBlobHeapAsFieldSigUncached (BlobAsFieldSigIdx (numtypars, blobIdx)) + + and readBlobHeapAsFieldSigUncached (BlobAsFieldSigIdx (numtypars, blobIdx)) = + let bytes = readBlobHeap blobIdx + let sigptr = 0 + let _ccByte, sigptr = sigptrGetByte bytes sigptr + let retty, _sigptr = sigptrGetTy numtypars bytes sigptr + retty + + + and readBlobHeapAsPropertySig numtypars blobIdx = cacheBlobHeapAsPropertySig readBlobHeapAsPropertySigUncached (BlobAsPropSigIdx (numtypars, blobIdx)) + and readBlobHeapAsPropertySigUncached (BlobAsPropSigIdx (numtypars, blobIdx)) = + let bytes = readBlobHeap blobIdx + let sigptr = 0 + let ccByte, sigptr = sigptrGetByte bytes sigptr + let hasthis = byteAsHasThis ccByte + let numparams, sigptr = sigptrGetZInt32 bytes sigptr + let retty, sigptr = sigptrGetTy numtypars bytes sigptr + let argtys, _sigptr = sigptrFold (sigptrGetTy numtypars) ( numparams) bytes sigptr + hasthis, retty, argtys + + and byteAsHasThis b = + let hasthis_masked = b &&& 0x60uy + if hasthis_masked = e_IMAGE_CEE_CS_CALLCONV_INSTANCE then ILThisConvention.Instance + elif hasthis_masked = e_IMAGE_CEE_CS_CALLCONV_INSTANCE_EXPLICIT then ILThisConvention.InstanceExplicit + else ILThisConvention.Static + + and byteAsCallConv b = + let cc = + let ccMaxked = b &&& 0x0Fuy + if ccMaxked = e_IMAGE_CEE_CS_CALLCONV_FASTCALL then ILArgConvention.FastCall + elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_STDCALL then ILArgConvention.StdCall + elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_THISCALL then ILArgConvention.ThisCall + elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_CDECL then ILArgConvention.CDecl + elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_VARARG then ILArgConvention.VarArg + else ILArgConvention.Default + let generic = (b &&& e_IMAGE_CEE_CS_CALLCONV_GENERIC) <> 0x0uy + generic, Callconv (byteAsHasThis b, cc) + + and seekReadMemberRefAsMethodData numtypars idx: VarArgMethodData = cacheMemberRefAsMemberData seekReadMemberRefAsMethodDataUncached (MemberRefAsMspecIdx (numtypars, idx)) + + and seekReadMemberRefAsMethodDataUncached (MemberRefAsMspecIdx (numtypars, idx)) = + let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow idx + let nm = readStringHeap nameIdx + let enclTyp = seekReadMethodRefParent numtypars mrpIdx + let _generic, genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig enclTyp.GenericArgs.Length typeIdx + let minst = Array.init genarity (fun n -> ILType.Var (numtypars+n)) + (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) + + and seekReadMemberRefAsMethDataNoVarArgs numtypars idx: MethodData = + let (VarArgMethodData(enclTyp, cc, nm, argtys, _varargs, retty, minst)) = seekReadMemberRefAsMethodData numtypars idx + (MethodData(enclTyp, cc, nm, argtys, retty, minst)) + + // One extremely annoying aspect of the MD format is that given a + // ILMethodDef token it is non-trivial to find which ILTypeDef it belongs + // to. So we do a binary chop through the ILTypeDef table + // looking for which ILTypeDef has the ILMethodDef within its range. + // Although the ILTypeDef table is not "sorted", it is effectively sorted by + // method-range and field-range start/finish indexes + and seekReadMethodDefAsMethodData idx = cacheMethodDefAsMethodData seekReadMethodDefAsMethodDataUncached idx + and seekReadMethodDefAsMethodDataUncached idx = + let (_code_rva, _implflags, _flags, nameIdx, typeIdx, _paramIdx) = seekReadMethodRow idx + let nm = readStringHeap nameIdx + // Look for the method def parent. + let tidx = + seekReadIndexedRow (getNumRows ILTableNames.TypeDef, + (fun i -> i, seekReadTypeDefRowWithExtents i), + (fun r -> r), + (fun (_, ((_, _, _, _, _, methodsIdx), + (_, endMethodsIdx))) -> + if endMethodsIdx <= idx then 1 + elif methodsIdx <= idx && idx < endMethodsIdx then 0 + else -1), + true, fst) + let _generic, _genarity, cc, retty, argtys, _varargs = readBlobHeapAsMethodSig 0 typeIdx + let ctps = seekReadGenericParams 0 (TypeOrMethodDefTag.TypeDef, tidx) + let mtps = seekReadGenericParams ctps.Length (TypeOrMethodDefTag.MethodDef, idx) + let finst = mkILFormalGenericArgs 0 ctps.Length + let minst = mkILFormalGenericArgs ctps.Length mtps.Length + let enclTyp = seekReadTypeDefAsType AsObject finst tidx + MethodData(enclTyp, cc, nm, argtys, retty, minst) + + and seekReadMethod numtypars (idx:int) = + let (_codeRVA, implflags, flags, nameIdx, typeIdx, paramIdx) = seekReadMethodRow idx + let nm = readStringHeap nameIdx + let _generic, _genarity, cc, retty, argtys, _varargs = readBlobHeapAsMethodSig numtypars typeIdx + + let endParamIdx = + if idx >= getNumRows ILTableNames.Method then + getNumRows ILTableNames.Param + 1 + else + let (_, _, _, _, _, paramIdx) = seekReadMethodRow (idx + 1) + paramIdx + + let ret, ilParams = seekReadParams (retty, argtys) paramIdx endParamIdx + + { Token=idx // This value is not a strict metadata token but it's good enough (if needed we could get the real one pretty easily) + Name=nm + Attributes = enum(flags) + //SecurityDecls=seekReadSecurityDecls (TaggedIndex(hds_MethodDef, idx)) + //IsEntryPoint= (fst entryPointToken = ILTableNames.Method && snd entryPointToken = idx) + ImplAttributes= enum implflags + GenericParams=seekReadGenericParams numtypars (TypeOrMethodDefTag.MethodDef, idx) + CustomAttrs=seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.MethodDef, idx)) + Parameters= ilParams + CallingConv=cc + Return=ret + Body= None + //SecurityDecls + //HasSecurity= false + IsEntryPoint= false (* unused by reader *) + } + + + and seekReadParams (retty, argtys) pidx1 pidx2 = + let retRes: ILReturn ref = ref { (* Marshal=None *) Type=retty; CustomAttrs=ILCustomAttrsStatics.Empty } + let paramsRes = + argtys + |> Array.map (fun ty -> + { Name=UNone + Default=UNone + //Marshal=None + Attributes= ParameterAttributes.None + ParameterType=ty + CustomAttrs=ILCustomAttrsStatics.Empty }) + for i = pidx1 to pidx2 - 1 do + seekReadParamExtras (retRes, paramsRes) i + !retRes, paramsRes + + and seekReadParamExtras (retRes, paramsRes) (idx:int) = + let (flags, seq, nameIdx) = seekReadParamRow idx + //let _hasMarshal = (flags &&& 0x2000) <> 0x0 + let hasDefault = (flags &&& 0x1000) <> 0x0 + //let fmReader idx = seekReadIndexedRow (getNumRows ILTableNames.FieldMarshal, seekReadFieldMarshalRow, fst, hfmCompare idx, isSorted ILTableNames.FieldMarshal, (snd >> readBlobHeapAsNativeType ctxt)) + let cas = seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.ParamDef, idx)) + if seq = 0 then + retRes := { !retRes with + //Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None); + CustomAttrs = cas } + else + paramsRes.[seq - 1] <- + { paramsRes.[seq - 1] with + //Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None) + Default = (if hasDefault then USome (seekReadConstant (TaggedIndex(HasConstantTag.ParamDef, idx))) else UNone) + Name = readStringHeapOption nameIdx + Attributes = enum flags + CustomAttrs = cas } + + and seekReadMethodImpls numtypars tidx = + { new ILMethodImplDefs with + member __.Entries = + let mimpls = seekReadIndexedRows (getNumRows ILTableNames.MethodImpl, seekReadMethodImplRow, (fun (a, _, _) -> a), simpleIndexCompare tidx, isSorted ILTableNames.MethodImpl, (fun (_, b, c) -> b, c)) + mimpls |> Array.map (fun (b, c) -> + { OverrideBy= + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs numtypars b + mkILMethSpecInTyRaw (enclTyp, cc, nm, argtys, retty, minst); + Overrides= + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs numtypars c + let mspec = mkILMethSpecInTyRaw (enclTyp, cc, nm, argtys, retty, minst) + OverridesSpec(mspec.MethodRef, mspec.EnclosingType) }) } + + and seekReadMultipleMethodSemantics (flags, id) = + seekReadIndexedRows + (getNumRows ILTableNames.MethodSemantics , + seekReadMethodSemanticsRow, + (fun (_flags, _, c) -> c), + hsCompare id, + isSorted ILTableNames.MethodSemantics, + (fun (a, b, _c) -> + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData b + a, (mkILMethSpecInTyRaw (enclTyp, cc, nm, argtys, retty, minst)).MethodRef)) + |> Array.filter (fun (flags2, _) -> flags = flags2) + |> Array.map snd + + + and seekReadOptionalMethodSemantics id = + match seekReadMultipleMethodSemantics id with + | [| |] -> None + | xs -> Some xs.[0] + + and seekReadMethodSemantics id = + match seekReadOptionalMethodSemantics id with + | None -> failwith "seekReadMethodSemantics ctxt: no method found" + | Some x -> x + + and seekReadEvent _numtypars idx = + let (flags, nameIdx, _typIdx) = seekReadEventRow idx + { Name = readStringHeap nameIdx + //EventHandlerType = seekReadOptionalTypeDefOrRef numtypars AsObject typIdx + Attributes = enum(flags) + AddMethod= seekReadMethodSemantics (0x0008, TaggedIndex(HasSemanticsTag.Event, idx)) + RemoveMethod=seekReadMethodSemantics (0x0010, TaggedIndex(HasSemanticsTag.Event, idx)) + //FireMethod=seekReadOptionalMethodSemantics (0x0020, TaggedIndex(HasSemanticsTag.Event, idx)) + //OtherMethods = seekReadMultipleMethodSemantics (0x0004, TaggedIndex(HasSemanticsTag.Event, idx)) + CustomAttrs=seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.Event, idx)) + Token = idx} + + and seekReadEvents numtypars tidx = + { new ILEventDefs with + member __.Entries = + match seekReadOptionalIndexedRow (getNumRows ILTableNames.EventMap, (fun i -> i, seekReadEventMapRow i), (fun (_, row) -> fst row), compare tidx, false, (fun (i, row) -> (i, snd row))) with + | None -> [| |] + | Some (rowNum, beginEventIdx) -> + let endEventIdx = + if rowNum >= getNumRows ILTableNames.EventMap then + getNumRows ILTableNames.Event + 1 + else + let (_, endEventIdx) = seekReadEventMapRow (rowNum + 1) + endEventIdx + + [| for i in beginEventIdx .. endEventIdx - 1 do + yield seekReadEvent numtypars i |] } + + and seekReadProperty numtypars idx = + let (flags, nameIdx, typIdx) = seekReadPropertyRow idx + let cc, retty, argtys = readBlobHeapAsPropertySig numtypars typIdx + let setter= seekReadOptionalMethodSemantics (0x0001, TaggedIndex(HasSemanticsTag.Property, idx)) + let getter = seekReadOptionalMethodSemantics (0x0002, TaggedIndex(HasSemanticsTag.Property, idx)) + let cc2 = + match getter with + | Some mref -> mref.CallingConv.ThisConv + | None -> + match setter with + | Some mref -> mref.CallingConv .ThisConv + | None -> cc + { Name=readStringHeap nameIdx + CallingConv = cc2 + Attributes = enum(flags) + SetMethod=setter; + GetMethod=getter; + PropertyType=retty; + Init= if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant (TaggedIndex(HasConstantTag.Property, idx))); + IndexParameterTypes=argtys; + CustomAttrs=seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.Property, idx)) + Token = idx } + + and seekReadProperties numtypars tidx = + { new ILPropertyDefs with + member __.Entries = + match seekReadOptionalIndexedRow (getNumRows ILTableNames.PropertyMap, (fun i -> i, seekReadPropertyMapRow i), (fun (_, row) -> fst row), compare tidx, false, (fun (i, row) -> (i, snd row))) with + | None -> [| |] + | Some (rowNum, beginPropIdx) -> + let endPropIdx = + if rowNum >= getNumRows ILTableNames.PropertyMap then + getNumRows ILTableNames.Property + 1 + else + let (_, endPropIdx) = seekReadPropertyMapRow (rowNum + 1) + endPropIdx + [| for i in beginPropIdx .. endPropIdx - 1 do + yield seekReadProperty numtypars i |] } + + + and seekReadCustomAttrs idx = + { new ILCustomAttrs with + member __.Entries = + seekReadIndexedRows (getNumRows ILTableNames.CustomAttribute, + seekReadCustomAttributeRow, (fun (a, _, _) -> a), + hcaCompare idx, + isSorted ILTableNames.CustomAttribute, + (fun (_, b, c) -> seekReadCustomAttr (b, c))) } + + and seekReadCustomAttr (catIdx, valIdx) = + let data = + match readBlobHeapOption valIdx with + | USome bytes -> bytes + | UNone -> [| |] + { Method=seekReadCustomAttrType catIdx; + Data= data + Elements = [] } + + (* + and seekReadSecurityDecls idx = + mkILLazySecurityDecls + (lazy + seekReadIndexedRows (getNumRows ILTableNames.Permission, + seekReadPermissionRow, + (fun (_, par, _) -> par), + hdsCompare idx, + isSorted ILTableNames.Permission, + (fun (act, _, ty) -> seekReadSecurityDecl (act, ty)))) + + and seekReadSecurityDecl (a, b) = + ctxt.seekReadSecurityDecl (SecurityDeclIdx (a, b)) + + and seekReadSecurityDeclUncached ctxtH (SecurityDeclIdx (act, ty)) = + PermissionSet ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"), + readBlobHeap ty) + + *) + + and seekReadConstant idx = + let kind, vidx = seekReadIndexedRow (getNumRows ILTableNames.Constant, + seekReadConstantRow, + (fun (_, key, _) -> key), + hcCompare idx, isSorted ILTableNames.Constant, (fun (kind, _, v) -> kind, v)) + match kind with + | x when x = uint16 et_STRING -> + let blobHeap = readBlobHeap vidx + let s = Encoding.Unicode.GetString(blobHeap, 0, blobHeap.Length) + box s + | x when x = uint16 et_BOOLEAN -> box (readBlobHeapAsBool vidx) + | x when x = uint16 et_CHAR -> box (readBlobHeapAsUInt16 vidx) + | x when x = uint16 et_I1 -> box (readBlobHeapAsSByte vidx) + | x when x = uint16 et_I2 -> box (readBlobHeapAsInt16 vidx) + | x when x = uint16 et_I4 -> box (readBlobHeapAsInt32 vidx) + | x when x = uint16 et_I8 -> box (readBlobHeapAsInt64 vidx) + | x when x = uint16 et_U1 -> box (readBlobHeapAsByte vidx) + | x when x = uint16 et_U2 -> box (readBlobHeapAsUInt16 vidx) + | x when x = uint16 et_U4 -> box (readBlobHeapAsUInt32 vidx) + | x when x = uint16 et_U8 -> box (readBlobHeapAsUInt64 vidx) + | x when x = uint16 et_R4 -> box (readBlobHeapAsSingle vidx) + | x when x = uint16 et_R8 -> box (readBlobHeapAsDouble vidx) + | x when x = uint16 et_CLASS || x = uint16 et_OBJECT -> null + | _ -> null + + and seekReadManifestResources () = + ILResources + (lazy + [| for i = 1 to getNumRows ILTableNames.ManifestResource do + let (offset, flags, nameIdx, implIdx) = seekReadManifestResourceRow i + let scoref = seekReadImplAsScopeRef implIdx + let datalab = + match scoref with + | ILScopeRef.Local -> + ILResourceLocation.Local (fun () -> + // We re-crack the PE file on each resource read, which is a bit dodgy + let bytes = File.ReadAllBytes fileName + let is = ByteFile(bytes) + let pe = PEReader(fileName, is) + let start = pe.ResourcePhysLoc offset + let len = seekReadInt32 is start + seekReadBytes is (start + 4) len) + | ILScopeRef.Module mref -> ILResourceLocation.File (mref, offset) + | ILScopeRef.Assembly aref -> ILResourceLocation.Assembly aref + + let r = + { Name= readStringHeap nameIdx; + Location = datalab; + Access = (if (flags &&& 0x01) <> 0x0 then ILResourceAccess.Public else ILResourceAccess.Private); + CustomAttrs = seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.ManifestResource, i)) } + yield r |]) + + and seekReadNestedExportedTypes parentIdx = + ILNestedExportedTypesAndForwarders + (lazy + [| for i = 1 to getNumRows ILTableNames.ExportedType do + let (flags, _tok, nameIdx, namespaceIdx, implIdx) = seekReadExportedTypeRow i + if not (isTopTypeDef flags) then + let (TaggedIndex(tag, idx) ) = implIdx + match tag with + | tag when tag = ImplementationTag.ExportedType && idx = parentIdx -> + let _nsp, nm = readStringHeapAsTypeName (nameIdx, namespaceIdx) + yield + { Name=nm + Access=(match ILTypeDefAccess.OfFlags flags with ILTypeDefAccess.Nested n -> n | _ -> failwith "non-nested access for a nested type described as being in an auxiliary module") + Nested=seekReadNestedExportedTypes i + CustomAttrs=seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.ExportedType, i)) } + | _ -> () |]) + + and seekReadTopExportedTypes () = + ILExportedTypesAndForwarders + (lazy + [| for i = 1 to getNumRows ILTableNames.ExportedType do + let (flags, _tok, nameIdx, namespaceIdx, implIdx) = seekReadExportedTypeRow i + if isTopTypeDef flags then + let (TaggedIndex(tag, _idx) ) = implIdx + + // the nested types will be picked up by their enclosing types + if tag <> ImplementationTag.ExportedType then + let nsp, nm = readStringHeapAsTypeName (nameIdx, namespaceIdx) + + let scoref = seekReadImplAsScopeRef implIdx + + let entry = + { ScopeRef=scoref + Namespace=nsp + Name=nm + IsForwarder = ((flags &&& 0x00200000) <> 0) + Access=ILTypeDefAccess.OfFlags flags + Nested=seekReadNestedExportedTypes i + CustomAttrs=seekReadCustomAttrs (TaggedIndex(HasCustomAttributeTag.ExportedType, i)) } + yield entry |]) + + + let ilModule = seekReadModule (ilMetadataVersion) 1 + let ilAssemblyRefs = [ for i in 1 .. getNumRows ILTableNames.AssemblyRef do yield seekReadAssemblyRef i ] + + member __.ILGlobals = ilg + member __.ILModuleDef = ilModule + member __.ILAssemblyRefs = ilAssemblyRefs + + let sigptr_get_byte (bytes: byte[]) sigptr = + int bytes.[sigptr], sigptr + 1 + + let sigptr_get_u8 bytes sigptr = + let b0, sigptr = sigptr_get_byte bytes sigptr + byte b0, sigptr + + let sigptr_get_bool bytes sigptr = + let b0, sigptr = sigptr_get_byte bytes sigptr + (b0 = 0x01) , sigptr + + let sigptr_get_i8 bytes sigptr = + let i, sigptr = sigptr_get_u8 bytes sigptr + sbyte i, sigptr + + let sigptr_get_u16 bytes sigptr = + let b0, sigptr = sigptr_get_byte bytes sigptr + let b1, sigptr = sigptr_get_byte bytes sigptr + uint16 (b0 ||| (b1 <<< 8)), sigptr + + let sigptr_get_i16 bytes sigptr = + let u, sigptr = sigptr_get_u16 bytes sigptr + int16 u, sigptr + + let sigptr_get_i32 bytes sigptr = + let b0, sigptr = sigptr_get_byte bytes sigptr + let b1, sigptr = sigptr_get_byte bytes sigptr + let b2, sigptr = sigptr_get_byte bytes sigptr + let b3, sigptr = sigptr_get_byte bytes sigptr + b0 ||| (b1 <<< 8) ||| (b2 <<< 16) ||| (b3 <<< 24), sigptr + + let sigptr_get_u32 bytes sigptr = + let u, sigptr = sigptr_get_i32 bytes sigptr + uint32 u, sigptr + + let sigptr_get_i64 bytes sigptr = + let b0, sigptr = sigptr_get_byte bytes sigptr + let b1, sigptr = sigptr_get_byte bytes sigptr + let b2, sigptr = sigptr_get_byte bytes sigptr + let b3, sigptr = sigptr_get_byte bytes sigptr + let b4, sigptr = sigptr_get_byte bytes sigptr + let b5, sigptr = sigptr_get_byte bytes sigptr + let b6, sigptr = sigptr_get_byte bytes sigptr + let b7, sigptr = sigptr_get_byte bytes sigptr + int64 b0 ||| (int64 b1 <<< 8) ||| (int64 b2 <<< 16) ||| (int64 b3 <<< 24) ||| + (int64 b4 <<< 32) ||| (int64 b5 <<< 40) ||| (int64 b6 <<< 48) ||| (int64 b7 <<< 56), + sigptr + + let sigptr_get_u64 bytes sigptr = + let u, sigptr = sigptr_get_i64 bytes sigptr + uint64 u, sigptr + + + let ieee32_of_bits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) + let ieee64_of_bits (x:int64) = System.BitConverter.Int64BitsToDouble(x) + + let sigptr_get_ieee32 bytes sigptr = + let u, sigptr = sigptr_get_i32 bytes sigptr + ieee32_of_bits u, sigptr + + let sigptr_get_ieee64 bytes sigptr = + let u, sigptr = sigptr_get_i64 bytes sigptr + ieee64_of_bits u, sigptr + + let u8AsBytes (i:byte) = [| i |] + let u16AsBytes x = let n = (int x) in [| b0 n; b1 n |] + let i32AsBytes i = [| b0 i; b1 i; b2 i; b3 i |] + let i64AsBytes i = [| dw0 i; dw1 i; dw2 i; dw3 i; dw4 i; dw5 i; dw6 i; dw7 i |] + + let i8AsBytes (i:sbyte) = u8AsBytes (byte i) + let i16AsBytes (i:int16) = u16AsBytes (uint16 i) + let u32AsBytes (i:uint32) = i32AsBytes (int32 i) + let u64AsBytes (i:uint64) = i64AsBytes (int64 i) + let bits_of_float32 (x:float32) = BitConverter.ToInt32(BitConverter.GetBytes(x), 0) + let bits_of_float (x:float) = BitConverter.DoubleToInt64Bits(x) + + let ieee32AsBytes i = i32AsBytes (bits_of_float32 i) + let ieee64AsBytes i = i64AsBytes (bits_of_float i) + + + let (|ElementType|_|) (ty: ILType) = + match ty with + | ILType.Boxed tspec -> + match tspec.Namespace, tspec.Name with + | USome "System", "String"-> Some et_STRING + | USome "System", "Object"-> Some et_OBJECT + | _ -> None + | ILType.Value tspec -> + match tspec.Namespace, tspec.Name with + | USome "System", "Int32" -> Some et_I4 + | USome "System", "SByte" -> Some et_I1 + | USome "System", "Int16"-> Some et_I2 + | USome "System", "Int64" -> Some et_I8 + | USome "System", "IntPtr" -> Some et_I + | USome "System", "Byte" -> Some et_U1 + | USome "System", "UInt16"-> Some et_U2 + | USome "System", "UInt32" -> Some et_U4 + | USome "System", "UInt64" -> Some et_U8 + | USome "System", "UIntPtr" -> Some et_U + | USome "System", "Double" -> Some et_R8 + | USome "System", "Single" -> Some et_R4 + | USome "System", "Char" -> Some et_CHAR + | USome "System", "Boolean" -> Some et_BOOLEAN + | USome "System", "TypedReference" -> Some et_TYPEDBYREF + | _ -> None + | _ -> None + + let encodeCustomAttrString (s: string) = + let arr = Encoding.UTF8.GetBytes s + Array.concat [ ByteBuffer.Z32 arr.Length; arr ] + + let rec encodeCustomAttrElemType x = + match x with + | ILType.Boxed tspec when tspec.Namespace = USome "System" && tspec.Name = "Object" -> [| 0x51uy |] + | ILType.Boxed tspec when tspec.Namespace = USome "System" && tspec.Name = "Type" -> [| 0x50uy |] + | ElementType et -> [| et |] + | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedName) + | ILType.Array (shape, elemType) when shape = ILArrayShape.SingleDimensional -> + Array.append [| et_SZARRAY |] (encodeCustomAttrElemType elemType) + | _ -> failwith "encodeCustomAttrElemType: unrecognized custom element type" + + /// Given a custom attribute element, work out the type of the .NET argument for that element. + let rec encodeCustomAttrElemTypeForObject (x: obj) = + match x with + | :? string -> [| et_STRING |] + | :? bool -> [| et_BOOLEAN |] + | :? char -> [| et_CHAR |] + | :? sbyte -> [| et_I1 |] + | :? int16 -> [| et_I2 |] + | :? int32 -> [| et_I4 |] + | :? int64 -> [| et_I8 |] + | :? byte -> [| et_U1 |] + | :? uint16 -> [| et_U2 |] + | :? uint32 -> [| et_U4 |] + | :? uint64 -> [| et_U8 |] + | :? ILType -> [| 0x50uy |] + | :? Type -> [| 0x50uy |] + | null -> [| et_STRING |]// yes, the 0xe prefix is used when passing a "null" to a property or argument of type "object" here + | :? single -> [| et_R4 |] + | :? double -> [| et_R8 |] + | :? (obj[]) -> failwith "TODO: can't yet emit arrays in attrs" // [| yield et_SZARRAY; yield! encodeCustomAttrElemType elemTy |] + | _ -> failwith "unexpected value in custom attribute" + + /// Given a custom attribute element, encode it to a binary representation according to the rules in Ecma 335 Partition II. + let rec encodeCustomAttrPrimValue (c: obj) = + match c with + | :? bool as b -> [| (if b then 0x01uy else 0x00uy) |] + | null -> [| 0xFFuy |] + | :? string as s -> encodeCustomAttrString s + | :? char as x -> u16AsBytes (uint16 x) + | :? SByte as x -> i8AsBytes x + | :? Int16 as x -> i16AsBytes x + | :? Int32 as x -> i32AsBytes x + | :? Int64 as x -> i64AsBytes x + | :? Byte as x -> u8AsBytes x + | :? UInt16 as x -> u16AsBytes x + | :? UInt32 as x -> u32AsBytes x + | :? UInt64 as x -> u64AsBytes x + | :? Single as x -> ieee32AsBytes x + | :? Double as x -> ieee64AsBytes x + | :? ILType as ty -> encodeCustomAttrString ty.QualifiedName + | :? Type as ty -> encodeCustomAttrString ty.FullName + | :? (obj[]) as elems -> + [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrPrimValue elem |] + | _ -> failwith "unexpected value in custom attribute" + + and encodeCustomAttrValue ty (c: obj) = + match ty, c with + | ILType.Boxed tspec, _ when tspec.Namespace = USome "System" && tspec.Name = "Object" -> + [| yield! encodeCustomAttrElemTypeForObject c; yield! encodeCustomAttrPrimValue c |] + | ILType.Array (shape, _), null when shape = ILArrayShape.SingleDimensional -> + [| yield! i32AsBytes 0xFFFFFFFF |] + | ILType.Array (shape, elemType), (:? (obj[]) as elems) when shape = ILArrayShape.SingleDimensional -> + [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrValue elemType elem |] + | _ -> + encodeCustomAttrPrimValue c + + let encodeCustomAttrNamedArg prop (ILCustomAttrNamedArg (nm, ty, elem)) = + [| yield (if prop then 0x54uy else 0x53uy) + yield! encodeCustomAttrElemType ty + yield! encodeCustomAttrString nm + yield! encodeCustomAttrValue ty elem |] + + let mkILCustomAttribMethRef (mspec:ILMethodSpec, fixedArgs: obj list, propArgs: ILCustomAttrNamedArg list, fieldArgs: ILCustomAttrNamedArg list) = + let argtys = mspec.MethodRef.ArgTypes + let nnamed = propArgs.Length + fieldArgs.Length + let data = + [| yield! [| 0x01uy; 0x00uy; |] + for (argty, fixedArg) in Seq.zip argtys fixedArgs do + yield! encodeCustomAttrValue argty fixedArg + yield! u16AsBytes (uint16 nnamed ) + for arg in propArgs do + yield! encodeCustomAttrNamedArg true arg + for arg in fieldArgs do + yield! encodeCustomAttrNamedArg false arg |] + //printfn "mkILCustomAttribMethRef, nnamed = %d, data.Length = %d, data = %A" nnamed data.Length data + { Method = mspec; + Data = data; + Elements = fixedArgs @ (propArgs |> List.map(fun (ILCustomAttrNamedArg(_, _, e)) -> e)) @ (fieldArgs |> List.map(fun (ILCustomAttrNamedArg(_, _, e)) -> e)) } + + let rec decodeCustomAttrElemType ilg bytes sigptr x = + match x with + | x when x = et_I1 -> ilg.typ_SByte, sigptr + | x when x = et_U1 -> ilg.typ_Byte, sigptr + | x when x = et_I2 -> ilg.typ_Int16, sigptr + | x when x = et_U2 -> ilg.typ_UInt16, sigptr + | x when x = et_I4 -> ilg.typ_Int32, sigptr + | x when x = et_U4 -> ilg.typ_UInt32, sigptr + | x when x = et_I8 -> ilg.typ_Int64, sigptr + | x when x = et_U8 -> ilg.typ_UInt64, sigptr + | x when x = et_R8 -> ilg.typ_Double, sigptr + | x when x = et_R4 -> ilg.typ_Single, sigptr + | x when x = et_CHAR -> ilg.typ_Char, sigptr + | x when x = et_BOOLEAN -> ilg.typ_Boolean, sigptr + | x when x = et_STRING -> ilg.typ_String, sigptr + | x when x = et_OBJECT -> ilg.typ_Object, sigptr + | x when x = et_SZARRAY -> + let et, sigptr = sigptr_get_u8 bytes sigptr + let elemTy, sigptr = decodeCustomAttrElemType ilg bytes sigptr et + mkILArr1DTy elemTy, sigptr + | x when x = 0x50uy -> ilg.typ_Type, sigptr + | _ -> failwithf "decodeCustomAttrElemType ilg: sigptr = %d, unrecognized custom element type: %A, bytes = %A" sigptr x bytes + + // Parse an IL type signature argument within a custom attribute blob + type ILTypeSigParser(tstring: string) = + + let mutable startPos = 0 + let mutable currentPos = 0 + + //let reset() = startPos <- 0 ; currentPos <- 0 + let nil = '\r' // cannot appear in a type sig + + // take a look at the next value, but don't advance + let peek() = if currentPos < (tstring.Length-1) then tstring.[currentPos+1] else nil + let peekN(skip) = if currentPos < (tstring.Length - skip) then tstring.[currentPos+skip] else nil + // take a look at the current value, but don't advance + let here() = if currentPos < tstring.Length then tstring.[currentPos] else nil + // move on to the next character + let step() = currentPos <- currentPos+1 + // ignore the current lexeme + let skip() = startPos <- currentPos + // ignore the current lexeme, advance + let drop() = skip() ; step() ; skip() + // return the current lexeme, advance + let take() = + let s = if currentPos < tstring.Length then tstring.[startPos..currentPos] else "" + drop() + s + + // The format we accept is + // "{`[, +]}{}{}" E.g., + // + // System.Collections.Generic.Dictionary + // `2[ + // [System.Int32, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089], + // dev.virtualearth.net.webservices.v1.search.CategorySpecificPropertySet], + // mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" + // + // Note that + // � Since we're only reading valid IL, we assume that the signature is properly formed + // � For type parameters, if the type is non-local, it will be wrapped in brackets ([]) + member x.ParseType() = + + // Does the type name start with a leading '['? If so, ignore it + // (if the specialization type is in another module, it will be wrapped in bracket) + if here() = '[' then drop() + + // 1. Iterate over beginning of type, grabbing the type name and determining if it's generic or an array + let typeName = + while (peek() <> '`') && (peek() <> '[') && (peek() <> ']') && (peek() <> ',') && (peek() <> nil) do step() + take() + + // 2. Classify the type + + // Is the type generic? + let typeName, specializations = + if here() = '`' then + drop() // step to the number + // fetch the arity + let arity = + while (int(here()) >= (int('0'))) && (int(here()) <= ((int('9')))) && (int(peek()) >= (int('0'))) && (int(peek()) <= ((int('9')))) do step() + System.Int32.Parse(take()) + + // typically types are saturated, i.e. if generic they have arguments. However, assembly metadata for reflectedDefinitions they occur free. + // this code takes care of exactly this case. + if here () = '[' then + // skip the '[' + drop() + // get the specializations + typeName+"`"+(arity.ToString()), Some(([| for _i in 0..arity-1 do yield x.ParseType() |])) + else + typeName+"`"+(arity.ToString()), None + else + typeName, None + + // Is the type an array? + let rank = + if here() = '[' then + let mutable rank = 0 + + while here() <> ']' do + rank <- rank + 1 + step() + drop() + + Some(ILArrayShape(Array.create rank (Some 0, None))) + else + None + + // Is there a scope? + let scope = + if (here() = ',' || here() = ' ') && (peek() <> '[' && peekN(2) <> '[') then + let grabScopeComponent() = + if here() = ',' then drop() // ditch the ',' + if here() = ' ' then drop() // ditch the ' ' + + while (peek() <> ',' && peek() <> ']' && peek() <> nil) do step() + take() + + let scope = + [ yield grabScopeComponent() // assembly + yield grabScopeComponent() // version + yield grabScopeComponent() // culture + yield grabScopeComponent() // public key token + ] |> String.concat "," + ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(System.Reflection.AssemblyName(scope))) + else + ILScopeRef.Local + + // strip any extraneous trailing brackets or commas + if (here() = ']') then drop() + if (here() = ',') then drop() + + // build the IL type + let tref = + let nsp, nm = splitILTypeName typeName + ILTypeRef(ILTypeRefScope.Top scope, nsp, nm) + + let genericArgs = + match specializations with + | None -> [| |] + | Some(genericArgs) -> genericArgs + let tspec = ILTypeSpec(tref, genericArgs) + let ilty = + match tspec.Name with + | "System.SByte" + | "System.Byte" + | "System.Int16" + | "System.UInt16" + | "System.Int32" + | "System.UInt32" + | "System.Int64" + | "System.UInt64" + | "System.Char" + | "System.Double" + | "System.Single" + | "System.Boolean" -> ILType.Value(tspec) + | _ -> ILType.Boxed(tspec) + + // if it's an array, wrap it - otherwise, just return the IL type + match rank with + | Some(r) -> ILType.Array(r, ilty) + | _ -> ilty + + + let sigptr_get_bytes n (bytes:byte[]) sigptr = + let res = Array.zeroCreate n + for i = 0 to n - 1 do + res.[i] <- bytes.[sigptr + i] + res, sigptr + n + + let sigptr_get_string n bytes sigptr = + let intarray, sigptr = sigptr_get_bytes n bytes sigptr + Encoding.UTF8.GetString(intarray , 0, intarray.Length), sigptr + + let sigptr_get_serstring bytes sigptr = + let len, sigptr = sigptrGetZInt32 bytes sigptr + sigptr_get_string len bytes sigptr + + let sigptr_get_serstring_possibly_null bytes sigptr = + let b0, new_sigptr = sigptr_get_byte bytes sigptr + if b0 = 0xFF then // null case + None, new_sigptr + else // throw away new_sigptr, getting length & text advance + let len, sigptr = sigptrGetZInt32 bytes sigptr + let s, sigptr = sigptr_get_string len bytes sigptr + Some(s), sigptr + + let decodeILCustomAttribData ilg (ca: ILCustomAttribute) = + let bytes = ca.Data + let sigptr = 0 + let bb0, sigptr = sigptr_get_byte bytes sigptr + let bb1, sigptr = sigptr_get_byte bytes sigptr + if not (bb0 = 0x01 && bb1 = 0x00) then failwith "decodeILCustomAttribData: invalid data"; + + let rec parseVal argty sigptr = + match argty with + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "SByte" -> + let n, sigptr = sigptr_get_i8 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Byte" -> + let n, sigptr = sigptr_get_u8 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Int16" -> + let n, sigptr = sigptr_get_i16 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "UInt16" -> + let n, sigptr = sigptr_get_u16 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Int32" -> + let n, sigptr = sigptr_get_i32 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "UInt32" -> + let n, sigptr = sigptr_get_u32 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Int64" -> + let n, sigptr = sigptr_get_i64 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "UInt64" -> + let n, sigptr = sigptr_get_u64 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Double" -> + let n, sigptr = sigptr_get_ieee64 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Single" -> + let n, sigptr = sigptr_get_ieee32 bytes sigptr + (argty, box n), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Char" -> + let n, sigptr = sigptr_get_u16 bytes sigptr + (argty, box (char n)), sigptr + | ILType.Value tspec when tspec.Namespace = USome "System" && tspec.Name = "Boolean" -> + let n, sigptr = sigptr_get_byte bytes sigptr + (argty, box (not (n = 0))), sigptr + | ILType.Boxed tspec when tspec.Namespace = USome "System" && tspec.Name = "String" -> + //printfn "parsing string, sigptr = %d" sigptr + let n, sigptr = sigptr_get_serstring_possibly_null bytes sigptr + //printfn "got string, sigptr = %d" sigptr + (argty, box (match n with None -> null | Some s -> s)), sigptr + | ILType.Boxed tspec when tspec.Namespace = USome "System" && tspec.Name = "Type" -> + let nOpt, sigptr = sigptr_get_serstring_possibly_null bytes sigptr + match nOpt with + | None -> (argty, box null) , sigptr // TODO: read System.Type attrs + | Some n -> + try + let parser = ILTypeSigParser(n) + parser.ParseType() |> ignore + (argty, box null) , sigptr // TODO: read System.Type attributes + with e -> + failwithf "decodeILCustomAttribData: error parsing type in custom attribute blob: %s" e.Message + | ILType.Boxed tspec when tspec.Namespace = USome "System" && tspec.Name = "Object" -> + let et, sigptr = sigptr_get_u8 bytes sigptr + if et = 0xFFuy then + (argty, null), sigptr + else + let ty, sigptr = decodeCustomAttrElemType ilg bytes sigptr et + parseVal ty sigptr + | ILType.Array(shape, elemTy) when shape = ILArrayShape.SingleDimensional -> + let n, sigptr = sigptr_get_i32 bytes sigptr + if n = 0xFFFFFFFF then (argty, null), sigptr else + let rec parseElems acc n sigptr = + if n = 0 then List.rev acc, sigptr else + let v, sigptr = parseVal elemTy sigptr + parseElems (v ::acc) (n-1) sigptr + let elems, sigptr = parseElems [] n sigptr + let elems = elems |> List.map snd |> List.toArray + (argty, box elems), sigptr + | ILType.Value _ -> (* assume it is an enumeration *) + let n, sigptr = sigptr_get_i32 bytes sigptr + (argty, box n), sigptr + | _ -> failwith "decodeILCustomAttribData: attribute data involves an enum or System.Type value" + + let rec parseFixed argtys sigptr = + match argtys with + | [] -> [], sigptr + | h::t -> + let nh, sigptr = parseVal h sigptr + let nt, sigptr = parseFixed t sigptr + nh ::nt, sigptr + + let fixedArgs, sigptr = parseFixed (List.ofArray ca.Method.FormalArgTypes) sigptr + let nnamed, sigptr = sigptr_get_u16 bytes sigptr + //printfn "nnamed = %d" nnamed + + try + let rec parseNamed acc n sigptr = + if n = 0 then List.rev acc else + let isPropByte, sigptr = sigptr_get_u8 bytes sigptr + let isProp = (int isPropByte = 0x54) + let et, sigptr = sigptr_get_u8 bytes sigptr + // We have a named value + let ty, sigptr = + if ((* 0x50 = (int et) || *) 0x55 = (int et)) then + let qualified_tname, sigptr = sigptr_get_serstring bytes sigptr + let unqualified_tname, rest = + let pieces = qualified_tname.Split(',') + if pieces.Length > 1 then + pieces.[0], Some (String.concat "," pieces.[1..]) + else + pieces.[0], None + let scoref = + match rest with + | Some aname -> ILTypeRefScope.Top(ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(System.Reflection.AssemblyName(aname)))) + | None -> ilg.typ_Boolean.TypeSpec.Scope + + let nsp, nm = splitILTypeName unqualified_tname + let tref = ILTypeRef (scoref, nsp, nm) + let tspec = mkILNonGenericTySpec tref + ILType.Value(tspec), sigptr + else + decodeCustomAttrElemType ilg bytes sigptr et + let nm, sigptr = sigptr_get_serstring bytes sigptr + let (_, v), sigptr = parseVal ty sigptr + parseNamed ((nm, ty, isProp, v) :: acc) (n-1) sigptr + let named = parseNamed [] (int nnamed) sigptr + fixedArgs, named + + with err -> + failwithf "FAILED decodeILCustomAttribData, data.Length = %d, data = %A, meth = %A, argtypes = %A, fixedArgs=%A, nnamed = %A, sigptr before named = %A, innerError = %A" bytes.Length bytes ca.Method.EnclosingType ca.Method.FormalArgTypes fixedArgs nnamed sigptr (err.ToString()) + + // Share DLLs within a provider by weak-caching them. + let readerWeakCache = ConcurrentDictionary<(string * string), DateTime * WeakReference>(HashIdentity.Structural) + + // Share DLLs across providers by strong-caching them, but flushing regularly + let readerStrongCache = ConcurrentDictionary<(string * string), DateTime * int * ILModuleReader>(HashIdentity.Structural) + + type File with + static member ReadBinaryChunk (fileName: string, start, len) = + use stream = new FileStream(fileName, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) + stream.Seek(int64 start, SeekOrigin.Begin) |> ignore + let buffer = Array.zeroCreate len + let mutable n = 0 + while n < len do + n <- n + stream.Read(buffer, n, len-n) + buffer + + let createReader ilGlobals (fileName: string) = + let bytes = File.ReadAllBytes fileName + let is = ByteFile(bytes) + let pe = PEReader(fileName, is) + let mdchunk = File.ReadBinaryChunk (fileName, pe.MetadataPhysLoc, pe.MetadataSize) + let mdfile = ByteFile(mdchunk) + let reader = ILModuleReader(fileName, mdfile, ilGlobals, true) + reader + + let GetWeakReaderCache () = readerWeakCache + let GetStrongReaderCache () = readerStrongCache + + // Auto-clear the cache every 30.0 seconds. + // We would use System.Runtime.Caching but some version constraints make this difficult. + let enableAutoClear = try Environment.GetEnvironmentVariable("FSHARP_TPREADER_AUTOCLEAR_OFF") = null with _ -> true + let clearSpanDefault = 30000 + let clearSpan = try (match Environment.GetEnvironmentVariable("FSHARP_TPREADER_AUTOCLEAR_SPAN") with null -> clearSpanDefault | s -> int32 s) with _ -> clearSpanDefault + let lastAccessLock = obj() + let mutable lastAccess = DateTime.Now + + let StartClearReaderCache() = + if enableAutoClear then + async { + while true do + do! Async.Sleep clearSpan + let timeSinceLastAccess = DateTime.Now - lock lastAccessLock (fun () -> lastAccess) + if timeSinceLastAccess > TimeSpan.FromMilliseconds(float clearSpan) then + readerStrongCache.Clear() + } + |> Async.Start + + do StartClearReaderCache() + + let (|WeakReference|_|) (x: WeakReference<'T>) = + match x.TryGetTarget() with + | true, v -> Some v + | _ -> None + + let ILModuleReaderAfterReadingAllBytes (file:string, ilGlobals: ILGlobals) = + let key = (file, ilGlobals.systemRuntimeScopeRef.QualifiedName) + lock lastAccessLock (fun () -> lastAccess <- DateTime.Now) + + // Check the weak cache, to enable sharing within a provider, even if the strong cache is flushed. + match readerWeakCache.TryGetValue(key) with + | true, (currentLastWriteTime, WeakReference(reader)) when + let lastWriteTime = File.GetLastWriteTime(file) + currentLastWriteTime = lastWriteTime -> + + reader + + | _ -> + let add _ = + let lastWriteTime = File.GetLastWriteTime(file) + let reader = createReader ilGlobals file + // record in the weak cache, to enable sharing within a provider, even if the strong cache is flushed. + readerWeakCache.[key] <- (lastWriteTime, WeakReference<_>(reader)) + (lastWriteTime, 1, reader) + + let update _ (currentLastWriteTime, count, reader) = + let lastWriteTime = File.GetLastWriteTime(file) + if currentLastWriteTime <> lastWriteTime then + let reader = createReader ilGlobals file + // record in the weak cache, to enable sharing within a provider, even if the strong cache is flushed. + readerWeakCache.[key] <- (lastWriteTime, WeakReference<_>(reader)) + (lastWriteTime, count + 1, reader) + else + (lastWriteTime, count, reader) + let _, _, reader = readerStrongCache.AddOrUpdate(key, add, update) + reader + + (* NOTE: ecma_ prefix refers to the standard "mscorlib" *) + let EcmaPublicKey = PublicKeyToken ([|0xdeuy; 0xaduy; 0xbeuy; 0xefuy; 0xcauy; 0xfeuy; 0xfauy; 0xceuy |]) + let EcmaMscorlibScopeRef = ILScopeRef.Assembly (ILAssemblyRef("mscorlib", UNone, USome EcmaPublicKey, true, UNone, UNone)) + +//==================================================================================================== +// TargetAssembly +// +// An implementation of reflection objects over on-disk assemblies, sufficient to give +// System.Type, System.MethodInfo, System.ConstructorInfo etc. objects +// that can be referred to in quotations and used as backing information for cross- +// targeting F# type providers. + + +namespace ProviderImplementation.ProvidedTypes + + #nowarn "1182" + + // + // The on-disk assemblies are read by AssemblyReader. + // + // Background + // ---------- + // + // Provided type/member definitions need to refer to non-provided definitions like "System.Object" and "System.String". + // + // For cross-targeting F# type providers, these can be references to assemblies that can't easily be loaded by .NET + // reflection. For this reason, an implementation of the .NET reflection objects is needed. At minimum this + // implementation must support the operations used by the F# compiler to interrogate the reflection objects. + // + // For a System.Assembly, the information must be sufficient to allow the Assembly --> ILScopeRef conversion + // in ExtensionTyping.fs of the F# compiler. This requires: + // Assembly.GetName() + // + // For a System.Type representing a reference to a named type definition, the information must be sufficient + // to allow the Type --> ILTypeRef conversion in the F# compiler. This requires: + // typ.DeclaringType + // typ.Name + // typ.Namespace + // + // For a System.Type representing a type expression, the information must be sufficient to allow the Type --> ILType.Var conversion in the F# compiler. + // typeof.Equals(typ) + // typ.IsGenericParameter + // typ.GenericParameterPosition + // typ.IsArray + // typ.GetElementType() + // typ.GetArrayRank() + // typ.IsByRef + // typ.GetElementType() + // typ.IsPointer + // typ.GetElementType() + // typ.IsGenericType + // typ.GetGenericArguments() + // typ.GetGenericTypeDefinition() + // + // For a System.MethodBase --> ILType.ILMethodRef conversion: + // + // :?> MethodInfo as minfo + // + // minfo.IsGenericMethod || minfo.DeclaringType.IsGenericType + // minfo.DeclaringType.GetGenericTypeDefinition + // minfo.DeclaringType.GetMethods().MetadataToken + // minfo.MetadataToken + // minfo.IsGenericMethod + // minfo.GetGenericArguments().Length + // minfo.ReturnType + // minfo.GetParameters | .ParameterType + // minfo.Name + // + // :?> ConstructorInfo as cinfo + // + // cinfo.DeclaringType.IsGenericType + // cinfo.DeclaringType.GetGenericTypeDefinition + // cinfo.DeclaringType.GetConstructors() GetParameters | .ParameterType + // + + #nowarn "40" + + open System + open System.IO + open System.Collections.Generic + open System.Reflection + open ProviderImplementation.ProvidedTypes.AssemblyReader + + + [] + module Utils2 = + + // A table tracking how wrapped type definition objects are translated to cloned objects. + // Unique wrapped type definition objects must be translated to unique wrapper objects, based + // on object identity. + type TxTable<'T2>() = + let tab = Dictionary() + member __.Get inp f = + if tab.ContainsKey inp then + tab.[inp] + else + let res = f() + tab.[inp] <- res + res + + member __.ContainsKey inp = tab.ContainsKey inp + + + let instParameterInfo typeBuilder inst (inp: ParameterInfo) = + { new ParameterInfo() with + override __.Name = inp.Name + override __.ParameterType = inp.ParameterType |> instType typeBuilder inst + override __.Attributes = inp.Attributes + override __.RawDefaultValue = inp.RawDefaultValue + override __.GetCustomAttributesData() = inp.GetCustomAttributesData() + override __.ToString() = inp.ToString() + "@inst" } + + let hashILParameterTypes (ps: ILParameters) = + // This hash code doesn't need to be very good as hashing by name is sufficient to give decent hash granularity + ps.Length + + let eqILScopeRef (_sco1: ILScopeRef) (_sco2: ILScopeRef) = + true // TODO (though omitting this is not a problem in practice since type equivalence by name is sufficient to bind methods) + + let eqAssemblyAndILScopeRef (_ass1: Assembly) (_sco2: ILScopeRef) = + true // TODO (though omitting this is not a problem in practice since type equivalence by name is sufficient to bind methods) + + + let rec eqILTypeRef (ty1: ILTypeRef) (ty2: ILTypeRef) = + ty1.Name = ty2.Name && eqILTypeRefScope ty1.Scope ty2.Scope + + and eqILTypeRefScope (ty1: ILTypeRefScope) (ty2: ILTypeRefScope) = + match ty1, ty2 with + | ILTypeRefScope.Top scoref1, ILTypeRefScope.Top scoref2 -> eqILScopeRef scoref1 scoref2 + | ILTypeRefScope.Nested tref1, ILTypeRefScope.Nested tref2 -> eqILTypeRef tref1 tref2 + | _ -> false + + and eqILTypes (tys1: ILType[]) (tys2: ILType[]) = + lengthsEqAndForall2 tys1 tys2 eqILType + + and eqILType (ty1: ILType) (ty2: ILType) = + match ty1, ty2 with + | (ILType.Value(tspec1) | ILType.Boxed(tspec1)), (ILType.Value(tspec2) | ILType.Boxed(tspec2))-> + eqILTypeRef tspec1.TypeRef tspec2.TypeRef && eqILTypes tspec1.GenericArgs tspec2.GenericArgs + | ILType.Array(rank1, arg1), ILType.Array(rank2, arg2) -> + rank1 = rank2 && eqILType arg1 arg2 + | ILType.Ptr(arg1), ILType.Ptr(arg2) -> + eqILType arg1 arg2 + | ILType.Byref(arg1), ILType.Byref(arg2) -> + eqILType arg1 arg2 + | ILType.Var(arg1), ILType.Var(arg2) -> + arg1 = arg2 + | _ -> false + + let rec eqTypeAndILTypeRef (ty1: Type) (ty2: ILTypeRef) = + ty1.Name = ty2.Name && + ty1.Namespace = (StructOption.toObj ty2.Namespace) && + match ty2.Scope with + | ILTypeRefScope.Top scoref2 -> eqAssemblyAndILScopeRef ty1.Assembly scoref2 + | ILTypeRefScope.Nested tref2 -> ty1.IsNested && eqTypeAndILTypeRef ty1.DeclaringType tref2 + + let rec eqTypesAndILTypes (tys1: Type[]) (tys2: ILType[]) = + eqTypesAndILTypesWithInst [| |] tys1 tys2 + + and eqTypesAndILTypesWithInst inst2 (tys1: Type[]) (tys2: ILType[]) = + lengthsEqAndForall2 tys1 tys2 (eqTypeAndILTypeWithInst inst2) + + and eqTypeAndILTypeWithInst inst2 (ty1: Type) (ty2: ILType) = + match ty2 with + | (ILType.Value(tspec2) | ILType.Boxed(tspec2))-> + if tspec2.GenericArgs.Length > 0 then + ty1.IsGenericType && eqTypeAndILTypeRef (ty1.GetGenericTypeDefinition()) tspec2.TypeRef && eqTypesAndILTypesWithInst inst2 (ty1.GetGenericArguments()) tspec2.GenericArgs + else + not ty1.IsGenericType && eqTypeAndILTypeRef ty1 tspec2.TypeRef + | ILType.Array(rank2, arg2) -> + ty1.IsArray && ty1.GetArrayRank() = rank2.Rank && eqTypeAndILTypeWithInst inst2 (ty1.GetElementType()) arg2 + | ILType.Ptr(arg2) -> + ty1.IsPointer && eqTypeAndILTypeWithInst inst2 (ty1.GetElementType()) arg2 + | ILType.Byref(arg2) -> + ty1.IsByRef && eqTypeAndILTypeWithInst inst2 (ty1.GetElementType()) arg2 + | ILType.Var(arg2) -> + if int arg2 < inst2.Length then + eqTypes ty1 inst2.[int arg2] + else + ty1.IsGenericParameter && ty1.GenericParameterPosition = int arg2 + + | _ -> false + + let eqParametersAndILParameterTypesWithInst inst2 (ps1: ParameterInfo[]) (ps2: ILParameters) = + lengthsEqAndForall2 ps1 ps2 (fun p1 p2 -> eqTypeAndILTypeWithInst inst2 p1.ParameterType p2.ParameterType) + + + type MethodSymbol2(gmd: MethodInfo, gargs: Type[], typeBuilder: ITypeBuilder) = + inherit MethodInfo() + let dty = gmd.DeclaringType + let dinst = (if dty.IsGenericType then dty.GetGenericArguments() else [| |]) + + override __.Attributes = gmd.Attributes + override __.Name = gmd.Name + override __.DeclaringType = dty + override __.MemberType = gmd.MemberType + + override __.GetParameters() = gmd.GetParameters() |> Array.map (instParameterInfo typeBuilder (dinst, gargs)) + override __.CallingConvention = gmd.CallingConvention + override __.ReturnType = gmd.ReturnType |> instType typeBuilder (dinst, gargs) + override __.GetGenericMethodDefinition() = gmd + override __.IsGenericMethod = gmd.IsGenericMethod + override __.GetGenericArguments() = gargs + override __.MetadataToken = gmd.MetadataToken + + override __.GetCustomAttributesData() = gmd.GetCustomAttributesData() + override __.MakeGenericMethod(typeArgs) = MethodSymbol2(gmd, typeArgs, typeBuilder) :> MethodInfo + override __.GetHashCode() = gmd.MetadataToken + override this.Equals(that:obj) = + match that with + | :? MethodInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes dty that.DeclaringType && lengthsEqAndForall2 (gmd.GetGenericArguments()) (that.GetGenericArguments()) (=) + | _ -> false + + + override this.MethodHandle = notRequired this "MethodHandle" this.Name + override this.ReturnParameter = notRequired this "ReturnParameter" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + override this.ReturnTypeCustomAttributes = notRequired this "ReturnTypeCustomAttributes" this.Name + override this.GetBaseDefinition() = notRequired this "GetBaseDefinition" this.Name + override this.GetMethodImplementationFlags() = notRequired this "GetMethodImplementationFlags" this.Name + override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override __.GetCustomAttributes(inherited) = + gmd.GetCustomAttributes(inherited) + override __.GetCustomAttributes(attributeType, inherited) = + gmd.GetCustomAttributes(attributeType, inherited) + + override __.ToString() = gmd.ToString() + "@inst" + + + /// Represents a constructor in an instantiated type + type ConstructorSymbol (declTy: Type, inp: ConstructorInfo, typeBuilder: ITypeBuilder) = + inherit ConstructorInfo() + let gps = ((if declTy.IsGenericType then declTy.GetGenericArguments() else [| |]), [| |]) + + override __.Name = inp.Name + override __.Attributes = inp.Attributes + override __.MemberType = MemberTypes.Constructor + override __.DeclaringType = declTy + + override __.GetParameters() = inp.GetParameters() |> Array.map (instParameterInfo typeBuilder gps) + override __.GetCustomAttributesData() = inp.GetCustomAttributesData() + override __.MetadataToken = inp.MetadataToken + + override __.GetHashCode() = inp.GetHashCode() + override this.Equals(that:obj) = + match that with + | :? ConstructorInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes declTy that.DeclaringType + | _ -> false + + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + override this.Invoke(_invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetMethodImplementationFlags() = notRequired this "GetMethodImplementationFlags" this.Name + override this.MethodHandle = notRequired this "MethodHandle" this.Name + override this.GetCustomAttributes(inherited) = inp.GetCustomAttributes(inherited) + override this.GetCustomAttributes(attributeType, inherited) = inp.GetCustomAttributes(attributeType, inherited) + + override __.ToString() = sprintf "tgt constructor(...) in type %s" declTy.FullName + static member Make (typeBuilder: ITypeBuilder) (declTy: Type) md = ConstructorSymbol (declTy, md, typeBuilder) :> ConstructorInfo + + /// Represents a method in an instantiated type + type MethodSymbol (declTy: Type, inp: MethodInfo, typeBuilder: ITypeBuilder) = + inherit MethodInfo() + let gps1 = (if declTy.IsGenericType then declTy.GetGenericArguments() else [| |]) + let gps2 = inp.GetGenericArguments() + let gps = (gps1, gps2) + + override __.Name = inp.Name + override __.DeclaringType = declTy + override __.MemberType = inp.MemberType + override __.Attributes = inp.Attributes + override __.GetParameters() = inp.GetParameters() |> Array.map (instParameterInfo typeBuilder gps) + override __.CallingConvention = inp.CallingConvention + override __.ReturnType = inp.ReturnType |> instType typeBuilder gps + override __.GetCustomAttributesData() = inp.GetCustomAttributesData() + override __.GetGenericArguments() = gps2 + override __.IsGenericMethod = (gps2.Length <> 0) + override __.IsGenericMethodDefinition = __.IsGenericMethod + + override __.GetHashCode() = inp.GetHashCode() + override this.Equals(that:obj) = + match that with + | :? MethodInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes this.DeclaringType that.DeclaringType + | _ -> false + + override this.MakeGenericMethod(args) = MethodSymbol2(this, args, typeBuilder) :> MethodInfo + + override __.MetadataToken = inp.MetadataToken + + override this.MethodHandle = notRequired this "MethodHandle" this.Name + override this.ReturnParameter = notRequired this "ReturnParameter" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + override this.ReturnTypeCustomAttributes = notRequired this "ReturnTypeCustomAttributes" this.Name + override this.GetBaseDefinition() = notRequired this "GetBaseDefinition" this.Name + override this.GetMethodImplementationFlags() = notRequired this "GetMethodImplementationFlags" this.Name + override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetCustomAttributes(inherited) = inp.GetCustomAttributes(inherited) + override this.GetCustomAttributes(attributeType, inherited) = inp.GetCustomAttributes(attributeType, inherited) + + override __.ToString() = sprintf "tgt method %s(...) in type %s" inp.Name declTy.FullName + + static member Make (typeBuilder: ITypeBuilder) (declTy: Type) md = MethodSymbol (declTy, md, typeBuilder) :> MethodInfo + + /// Represents a property in an instantiated type + type PropertySymbol (declTy: Type, inp: PropertyInfo, typeBuilder: ITypeBuilder) = + inherit PropertyInfo() + let gps = ((if declTy.IsGenericType then declTy.GetGenericArguments() else [| |]), [| |]) + + override __.Name = inp.Name + override __.Attributes = inp.Attributes + override __.MemberType = MemberTypes.Property + override __.DeclaringType = declTy + + override __.PropertyType = inp.PropertyType |> instType typeBuilder gps + override __.GetGetMethod(nonPublic) = inp.GetGetMethod(nonPublic) |> Option.ofObj |> Option.map (MethodSymbol.Make typeBuilder declTy) |> Option.toObj + override __.GetSetMethod(nonPublic) = inp.GetSetMethod(nonPublic) |> Option.ofObj |> Option.map (MethodSymbol.Make typeBuilder declTy) |> Option.toObj + override __.GetIndexParameters() = inp.GetIndexParameters() |> Array.map (instParameterInfo typeBuilder gps) + override __.CanRead = inp.GetGetMethod(true) |> isNull |> not + override __.CanWrite = inp.GetSetMethod(true) |> isNull |> not + override __.GetCustomAttributesData() = inp.GetCustomAttributesData() + override __.MetadataToken = inp.MetadataToken + + override __.GetHashCode() = inp.GetHashCode() + override this.Equals(that:obj) = + match that with + | :? PropertyInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes this.DeclaringType that.DeclaringType + | _ -> false + + override this.GetValue(_obj, _invokeAttr, _binder, _index, _culture) = notRequired this "GetValue" this.Name + override this.SetValue(_obj, _value, _invokeAttr, _binder, _index, _culture) = notRequired this "SetValue" this.Name + override this.GetAccessors(_nonPublic) = notRequired this "GetAccessors" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + + override __.ToString() = sprintf "tgt property %s(...) in type %s" inp.Name declTy.Name + + static member Make (typeBuilder: ITypeBuilder) (declTy: Type) md = PropertySymbol (declTy, md, typeBuilder) :> PropertyInfo + + /// Represents an event in an instantiated type + type EventSymbol (declTy: Type, inp: EventInfo, typeBuilder: ITypeBuilder) = + inherit EventInfo() + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + + override __.Name = inp.Name + override __.Attributes = inp.Attributes + override __.MemberType = MemberTypes.Event + override __.DeclaringType = declTy + + override __.EventHandlerType = inp.EventHandlerType |> instType typeBuilder (gps, [| |]) + override __.GetAddMethod(nonPublic) = inp.GetAddMethod(nonPublic) |> Option.ofObj |> Option.map (MethodSymbol.Make typeBuilder declTy) |> Option.toObj + override __.GetRemoveMethod(nonPublic) = inp.GetRemoveMethod(nonPublic) |> Option.ofObj |> Option.map (MethodSymbol.Make typeBuilder declTy) |> Option.toObj + override __.GetCustomAttributesData() = inp.GetCustomAttributesData() + override __.MetadataToken = inp.MetadataToken + + override __.GetHashCode() = inp.GetHashCode() + override this.Equals(that:obj) = + match that with + | :? EventInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes this.DeclaringType that.DeclaringType + | _ -> false + + override this.GetRaiseMethod(_nonPublic) = notRequired this "GetRaiseMethod" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + + override __.ToString() = sprintf "tgt event %s(...) in type %s" inp.Name declTy.FullName + + static member Make (typeBuilder: ITypeBuilder) (declTy: Type) md = EventSymbol (declTy, md, typeBuilder) :> EventInfo + + /// Represents a field in an instantiated type + type FieldSymbol (declTy: Type, inp: FieldInfo, typeBuilder: ITypeBuilder) = + inherit FieldInfo() + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + + override __.Name = inp.Name + override __.Attributes = inp.Attributes + override __.MemberType = MemberTypes.Field + override __.DeclaringType = declTy + + override __.FieldType = inp.FieldType |> instType typeBuilder (gps, [| |]) + override __.GetRawConstantValue() = inp.GetRawConstantValue() + override __.GetCustomAttributesData() = inp.GetCustomAttributesData() + override __.MetadataToken = inp.MetadataToken + + override __.GetHashCode() = inp.GetHashCode() + override this.Equals(that:obj) = + match that with + | :? FieldInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes this.DeclaringType that.DeclaringType + | _ -> false + + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + override this.SetValue(_obj, _value, _invokeAttr, _binder, _culture) = notRequired this "SetValue" this.Name + override this.GetValue(_obj) = notRequired this "GetValue" this.Name + override this.FieldHandle = notRequired this "FieldHandle" this.Name + + override __.ToString() = sprintf "tgt literal field %s(...) in type %s" inp.Name declTy.FullName + + static member Make (typeBuilder: ITypeBuilder) (declTy: Type) md = FieldSymbol (declTy, md, typeBuilder) :> FieldInfo + + /// Represents the type constructor in a provided symbol type. + [] + type TypeSymbolKind = + | SDArray + | Array of int + | Pointer + | ByRef + | TargetGeneric of TargetTypeDefinition + | OtherGeneric of Type + + + /// Represents an array or other symbolic type involving a provided type as the argument. + /// See the type provider spec for the methods that must be implemented. + /// Note that the type provider specification does not require us to implement pointer-equality for provided types. + and TypeSymbol(kind: TypeSymbolKind, typeArgs: Type[], typeBuilder: ITypeBuilder) as this = + inherit TypeDelegator() + do this.typeImpl <- this + + override this.FullName = + if this.IsArray then this.GetElementType().FullName + "[]" + elif this.IsPointer then this.GetElementType().FullName + "*" + elif this.IsByRef then this.GetElementType().FullName + "&" + elif this.IsGenericType then this.GetGenericTypeDefinition().FullName + "[" + (this.GetGenericArguments() |> Array.map (fun arg -> arg.FullName) |> String.concat ",") + "]" + else failwithf "unreachable, stack trace = %A" Environment.StackTrace + + override this.DeclaringType = + if this.IsArray || this.IsPointer || this.IsByRef then this.GetElementType().DeclaringType + elif this.IsGenericType then this.GetGenericTypeDefinition().DeclaringType + else failwithf "unreachable, stack trace = %A" Environment.StackTrace + + override this.Name = + if this.IsArray then this.GetElementType().Name + "[]" + elif this.IsPointer then this.GetElementType().Name + "*" + elif this.IsByRef then this.GetElementType().Name + "&" + elif this.IsGenericType then this.GetGenericTypeDefinition().Name + else failwithf "unreachable, stack trace = %A" Environment.StackTrace + + override this.BaseType = + if this.IsArray then typeof + elif this.IsPointer then typeof + elif this.IsByRef then typeof + elif this.IsGenericType then instType typeBuilder (this.GetGenericArguments(), [| |]) (this.GetGenericTypeDefinition().BaseType) + else failwithf "unreachable, stack trace = %A" Environment.StackTrace + + override this.MetadataToken = + if this.IsArray then typeof.MetadataToken + elif this.IsPointer then typeof.MetadataToken + elif this.IsByRef then typeof.MetadataToken + elif this.IsGenericType then this.GetGenericTypeDefinition().MetadataToken + else failwithf "unreachable, stack trace = %A" Environment.StackTrace + + override this.Assembly = + if this.IsArray || this.IsPointer || this.IsByRef then this.GetElementType().Assembly + elif this.IsGenericType then this.GetGenericTypeDefinition().Assembly + else failwithf "unreachable, stack trace = %A" Environment.StackTrace + + override this.Namespace = + if this.IsArray || this.IsPointer || this.IsByRef then this.GetElementType().Namespace + elif this.IsGenericType then this.GetGenericTypeDefinition().Namespace + else failwithf "unreachable, stack trace = %A" Environment.StackTrace + + override __.GetArrayRank() = (match kind with TypeSymbolKind.Array n -> n | TypeSymbolKind.SDArray -> 1 | _ -> failwithf "non-array type") + override __.IsValueTypeImpl() = this.IsGenericType && this.GetGenericTypeDefinition().IsValueType + override __.IsArrayImpl() = (match kind with TypeSymbolKind.Array _ | TypeSymbolKind.SDArray -> true | _ -> false) + override __.IsByRefImpl() = (match kind with TypeSymbolKind.ByRef _ -> true | _ -> false) + override __.IsPointerImpl() = (match kind with TypeSymbolKind.Pointer _ -> true | _ -> false) + override __.IsPrimitiveImpl() = false + override __.IsGenericType = (match kind with TypeSymbolKind.TargetGeneric _ | TypeSymbolKind.OtherGeneric _ -> true | _ -> false) + override __.GetGenericArguments() = (match kind with TypeSymbolKind.TargetGeneric _ | TypeSymbolKind.OtherGeneric _ -> typeArgs | _ -> [| |]) + override __.GetGenericTypeDefinition() = (match kind with TypeSymbolKind.TargetGeneric e -> (e :> Type) | TypeSymbolKind.OtherGeneric gtd -> gtd | _ -> failwithf "non-generic type") + override __.IsCOMObjectImpl() = false + override __.HasElementTypeImpl() = (match kind with TypeSymbolKind.TargetGeneric _ | TypeSymbolKind.OtherGeneric _ -> false | _ -> true) + override __.GetElementType() = (match kind, typeArgs with (TypeSymbolKind.Array _ | TypeSymbolKind.SDArray | TypeSymbolKind.ByRef | TypeSymbolKind.Pointer), [| e |] -> e | _ -> failwithf "%A, %A: not an array, pointer or byref type" kind typeArgs) + + override x.Module = x.Assembly.ManifestModule + + override this.GetHashCode() = + if this.IsArray then 10 + hash (this.GetElementType()) + elif this.IsPointer then 163 + hash (this.GetElementType()) + elif this.IsByRef then 283 + hash (this.GetElementType()) + else this.GetGenericTypeDefinition().MetadataToken + + override this.Equals(other: obj) = eqTypeObj this other + + override this.Equals(otherTy: Type) = eqTypes this otherTy + + override this.IsAssignableFrom(otherTy: Type) = isAssignableFrom this otherTy + + override this.IsSubclassOf(otherTy: Type) = isSubclassOf this otherTy + + member __.Kind = kind + member __.Args = typeArgs + + override this.GetConstructors bindingFlags = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.Methods.Entries + |> Array.filter (fun md -> md.Name = ".ctor" || md.Name = ".cctor") + |> Array.map (gtd.MakeConstructorInfo this) + |> Array.filter (canBindConstructor bindingFlags) + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetConstructors(bindingFlags) + |> Array.map (ConstructorSymbol.Make typeBuilder this) + | _ -> notRequired this "GetConstructors" this.Name + + override this.GetMethods bindingFlags = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.Methods.Entries + |> Array.filter (fun md -> md.Name <> ".ctor" && md.Name <> ".cctor") + |> Array.map (gtd.MakeMethodInfo this) + |> Array.filter (canBindMethod bindingFlags) + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetMethods(bindingFlags) + |> Array.map (MethodSymbol.Make typeBuilder this) + | _ -> notRequired this "GetMethods" this.Name + + override this.GetFields bindingFlags = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.Fields.Entries + |> Array.map (gtd.MakeFieldInfo this) + |> Array.filter (canBindField bindingFlags) + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetFields(bindingFlags) + |> Array.map (FieldSymbol.Make typeBuilder this) + | _ -> notRequired this "GetFields" this.Name + + override this.GetProperties bindingFlags = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.Properties.Entries + |> Array.map (gtd.MakePropertyInfo this) + |> Array.filter (canBindProperty bindingFlags) + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetProperties(bindingFlags) + |> Array.map (PropertySymbol.Make typeBuilder this) + | _ -> notRequired this "GetProperties" this.Name + + override this.GetEvents bindingFlags = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.Events.Entries + |> Array.map (gtd.MakeEventInfo this) + |> Array.filter (canBindEvent bindingFlags) + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetEvents(bindingFlags) + |> Array.map (EventSymbol.Make typeBuilder this) + | _ -> notRequired this "GetEvents" this.Name + + override this.GetNestedTypes bindingFlags = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.NestedTypes.Entries + |> Array.map (gtd.MakeNestedTypeInfo this) + |> Array.filter (canBindNestedType bindingFlags) + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetNestedTypes(bindingFlags) + | _ -> notRequired this "GetNestedTypes" this.Name + + override this.GetConstructorImpl(bindingFlags, _binderBinder, _callConvention, types, _modifiers) = + let ctors = this.GetConstructors(bindingFlags) |> Array.filter (fun c -> match types with null -> true | t -> let ps = c.GetParameters() in ps.Length = t.Length && (ps, t) ||> Seq.forall2 (fun p ty -> p.ParameterType = ty ) ) + match ctors with + | [| |] -> null + | [| ci |] -> ci + | _ -> failwithf "multiple constructors exist" + + override this.GetMethodImpl(name, bindingFlags, _binderBinder, _callConvention, types, _modifiers) = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + let md = + match types with + | null -> gtd.Metadata.Methods.TryFindUniqueByName(name) + | _ -> + let mds = gtd.Metadata.Methods.FindByNameAndArity(name, types.Length) + match mds |> Array.filter (fun md -> eqTypesAndILTypesWithInst typeArgs types md.ParameterTypes) with + | [| |] -> None + | [| md |] -> Some md + | _ -> failwithf "multiple methods exist with name %s" name + md |> Option.map (gtd.MakeMethodInfo this) |> Option.toObj + | TypeSymbolKind.OtherGeneric _ -> + match this.GetMethods(bindingFlags) |> Array.filter (fun c -> name = c.Name && match types with null -> true | t -> c.GetParameters().Length = t.Length) with + | [| |] -> null + | [| mi |] -> mi + | _ -> failwithf "multiple methods exist with name %s" name + | _ -> notRequired this "GetMethodImpl" this.Name + + override this.GetField(name, bindingFlags) = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.Fields.Entries |> Array.tryFind (fun md -> md.Name = name) + |> Option.map (gtd.MakeFieldInfo this) + |> Option.toObj + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetFields(bindingFlags) + |> Array.tryFind (fun md -> md.Name = name) + |> Option.map (FieldSymbol.Make typeBuilder this) + |> Option.toObj + + | _ -> notRequired this "GetField" this.Name + + override this.GetPropertyImpl(name, bindingFlags, _binder, _returnType, _types, _modifiers) = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.Properties.Entries + |> Array.tryFind (fun md -> md.Name = name) + |> Option.map (gtd.MakePropertyInfo this) + |> Option.toObj + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetProperties(bindingFlags) + |> Array.tryFind (fun md -> md.Name = name) + |> Option.map (PropertySymbol.Make typeBuilder this) + |> Option.toObj + + | _ -> notRequired this "GetPropertyImpl" this.Name + + override this.GetEvent(name, bindingFlags) = + match kind with + | TypeSymbolKind.TargetGeneric gtd -> + gtd.Metadata.Events.Entries + |> Array.tryFind (fun md -> md.Name = name) + |> Option.map (gtd.MakeEventInfo this) + |> Option.toObj + | TypeSymbolKind.OtherGeneric gtd -> + gtd.GetEvents(bindingFlags) + |> Array.tryFind (fun md -> md.Name = name) + |> Option.map (EventSymbol.Make typeBuilder this) + |> Option.toObj + | _ -> notRequired this "GetEvent" this.Name + + override this.GetNestedType(_name, _bindingFlags) = notRequired this "GetNestedType" this.Name + + override this.AssemblyQualifiedName = "[" + this.Assembly.FullName + "]" + this.FullName + + override this.GetAttributeFlagsImpl() = getAttributeFlagsImpl this + + override this.UnderlyingSystemType = (this :> Type) + + override __.GetCustomAttributesData() = ([| |] :> IList<_>) + + override this.GetMembers _bindingFlags = notRequired this "GetMembers" this.Name + override this.GetInterface(_name, _ignoreCase) = notRequired this "GetInterface" this.Name + override this.GetInterfaces() = notRequired this "GetInterfaces" this.Name + override __.GetCustomAttributes(_inherit) = emptyAttributes + override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType + override __.IsDefined(_attributeType, _inherit) = false + + override this.MemberType = + match kind with + | TypeSymbolKind.OtherGeneric gtd -> gtd.MemberType + | _ -> notRequired this "MemberType" this.FullName + +#if NETCOREAPP + // See bug https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues/236 + override __.IsSZArray = + match kind with + | TypeSymbolKind.SDArray _ -> true + | _ -> false +#endif + override this.GetMember(_name, _mt, _bindingFlags) = notRequired this "GetMember" this.Name + override this.GUID = notRequired this "GUID" this.Name + override this.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired this "InvokeMember" this.Name + override this.MakeArrayType() = TypeSymbol(TypeSymbolKind.SDArray, [| this |], typeBuilder) :> Type + override this.MakeArrayType arg = TypeSymbol(TypeSymbolKind.Array arg, [| this |], typeBuilder) :> Type + override this.MakePointerType() = TypeSymbol(TypeSymbolKind.Pointer, [| this |], typeBuilder) :> Type + override this.MakeByRefType() = TypeSymbol(TypeSymbolKind.ByRef, [| this |], typeBuilder) :> Type + + override this.GetEvents() = this.GetEvents(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.Static) // Needed because TypeDelegator.cs provides a delegting implementation of this, and we are self-delegating + override this.ToString() = this.FullName + + + /// Convert an ILGenericParameterDef read from a binary to a System.Type. + and TargetGenericParam (asm, gpsf, pos, inp: ILGenericParameterDef, txILType, txCustomAttributesData, typeBuilder: ITypeBuilder) as this = + inherit TypeDelegator() + do this.typeImpl <- this + override __.Name = inp.Name + override __.Assembly = (asm :> Assembly) + override __.FullName = inp.Name + override __.IsGenericParameter = true + override __.GenericParameterPosition = pos + override __.GetGenericParameterConstraints() = inp.Constraints |> Array.map (txILType (gpsf())) + + override __.MemberType = enum 0 + override __.MetadataToken = inp.Token + + override __.Namespace = null //notRequired this "Namespace" + override this.DeclaringType = notRequired this "DeclaringType" this.Name + override __.BaseType = null //notRequired this "BaseType" this.Name + override this.GetInterfaces() = notRequired this "GetInterfaces" this.Name + + override this.GetConstructors(_bindingFlags) = notRequired this "GetConstructors" this.Name + override this.GetMethods(_bindingFlags) = notRequired this "GetMethods" this.Name + override this.GetFields(_bindingFlags) = notRequired this "GetFields" this.Name + override this.GetProperties(_bindingFlags) = notRequired this "GetProperties" this.Name + override this.GetEvents(_bindingFlags) = notRequired this "GetEvents" this.Name + override this.GetNestedTypes(_bindingFlags) = notRequired this "GetNestedTypes" this.Name + + override this.GetConstructorImpl(_bindingFlags, _binder, _callConvention, _types, _modifiers) = notRequired this "GetConstructorImpl" this.Name + override this.GetMethodImpl(_name, _bindingFlags, _binder, _callConvention, _types, _modifiers) = notRequired this "GetMethodImpl" this.Name + override this.GetField(_name, _bindingFlags) = notRequired this "GetField" this.Name + override this.GetPropertyImpl(_name, _bindingFlags, _binder, _returnType, _types, _modifiers) = notRequired this "GetPropertyImpl" this.Name + override this.GetNestedType(_name, _bindingFlags) = notRequired this "GetNestedType" this.Name + override this.GetEvent(_name, _bindingFlags) = notRequired this "GetEvent" this.Name + override this.GetMembers(_bindingFlags) = notRequired this "GetMembers" this.Name + override this.MakeGenericType(_args) = notRequired this "MakeGenericType" this.Name + + override this.MakeArrayType() = TypeSymbol(TypeSymbolKind.SDArray, [| this |], typeBuilder) :> Type + override this.MakeArrayType arg = TypeSymbol(TypeSymbolKind.Array arg, [| this |], typeBuilder) :> Type + override this.MakePointerType() = TypeSymbol(TypeSymbolKind.Pointer, [| this |], typeBuilder) :> Type + override this.MakeByRefType() = TypeSymbol(TypeSymbolKind.ByRef, [| this |], typeBuilder) :> Type + + override __.GetAttributeFlagsImpl() = TypeAttributes.Public ||| TypeAttributes.Class ||| TypeAttributes.Sealed + + override __.IsArrayImpl() = false + override __.IsByRefImpl() = false + override __.IsPointerImpl() = false + override __.IsPrimitiveImpl() = false + override __.IsCOMObjectImpl() = false + override __.IsGenericType = false + override __.IsGenericTypeDefinition = false + + override __.HasElementTypeImpl() = false + + override this.UnderlyingSystemType = (this :> Type) + override __.GetCustomAttributesData() = inp.CustomAttrs |> txCustomAttributesData + + override this.Equals(that:obj) = System.Object.ReferenceEquals (this, that) + override this.GetHashCode() = hash inp.Name + + override __.ToString() = sprintf "tgt generic param %s" inp.Name + + override this.AssemblyQualifiedName = "[" + this.Assembly.FullName + "]" + this.FullName + + override this.GetGenericArguments() = notRequired this "GetGenericArguments" this.Name + override this.GetGenericTypeDefinition() = notRequired this "GetGenericTypeDefinition" this.Name + override this.GetMember(_name, _mt, _bindingFlags) = notRequired this "txILGenericParam: GetMember" this.Name + override this.GUID = notRequired this "txILGenericParam: GUID" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "txILGenericParam: GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "txILGenericParam: GetCustomAttributes" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "txILGenericParam: IsDefined" this.Name + override this.GetInterface(_name, _ignoreCase) = notRequired this "txILGenericParam: GetInterface" this.Name + override this.Module = notRequired this "txILGenericParam: Module" this.Name: Module + override this.GetElementType() = notRequired this "txILGenericParam: GetElementType" this.Name + override this.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired this "txILGenericParam: InvokeMember" this.Name + override this.GetEvents() = this.GetEvents(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.Static) // Needed because TypeDelegator.cs provides a delegting implementation of this, and we are self-delegating + + /// Clones namespaces, type providers, types and members provided by tp, renaming namespace nsp1 into namespace nsp2. + + /// Makes a type definition read from a binary available as a System.Type. Not all methods are implemented. + and TargetTypeDefinition(ilGlobals: ILGlobals, tryBindAssembly: ILAssemblyRef -> Choice, asm: TargetAssembly, declTyOpt: Type option, inp: ILTypeDef, typeBuilder: ITypeBuilder) as this = + inherit TypeDelegator() + + // Note: For F# type providers we never need to view the custom attributes + let rec txCustomAttributesArg ((ty:ILType, v:obj)) = + CustomAttributeTypedArgument(txILType ([| |], [| |]) ty, v) + + and txCustomAttributesDatum (inp: ILCustomAttribute) = + let args, namedArgs = decodeILCustomAttribData ilGlobals inp + { new CustomAttributeData () with + member __.Constructor = txILConstructorRef inp.Method.MethodRef + member __.ConstructorArguments = [| for arg in args -> txCustomAttributesArg arg |] :> IList<_> + // Note, named arguments of custom attributes are not required by F# compiler on binding context elements. + member __.NamedArguments = [| |] :> IList<_> + } + + and txCustomAttributesData (inp: ILCustomAttrs) = + [| for a in inp.Entries do + yield txCustomAttributesDatum a |] + :> IList + + /// Makes a parameter definition read from a binary available as a ParameterInfo. Not all methods are implemented. + and txILParameter gps (inp: ILParameter) = + { new ParameterInfo() with + + override __.Name = StructOption.toObj inp.Name + override __.ParameterType = inp.ParameterType |> txILType gps + override __.RawDefaultValue = (match inp.Default with UNone -> null | USome v -> v) + override __.Attributes = inp.Attributes + override __.GetCustomAttributesData() = inp.CustomAttrs |> txCustomAttributesData + + override x.ToString() = sprintf "tgt parameter %s" x.Name } + + /// Makes a method definition read from a binary available as a ConstructorInfo. Not all methods are implemented. + and txILConstructorDef (declTy: Type) (inp: ILMethodDef) = + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + { new ConstructorInfo() with + + override __.Name = inp.Name + override __.Attributes = inp.Attributes + override __.MemberType = MemberTypes.Constructor + override __.DeclaringType = declTy + + override __.GetParameters() = inp.Parameters |> Array.map (txILParameter (gps, [| |])) + override __.GetCustomAttributesData() = inp.CustomAttrs |> txCustomAttributesData + override __.MetadataToken = inp.Token + + override __.GetHashCode() = inp.Token + + override this.Equals(that:obj) = + match that with + | :? ConstructorInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes declTy that.DeclaringType + | _ -> false + + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + override this.Invoke(_invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetMethodImplementationFlags() = notRequired this "GetMethodImplementationFlags" this.Name + override this.MethodHandle = notRequired this "MethodHandle" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" this.Name + + override __.ToString() = sprintf "tgt constructor(...) in type %s" declTy.FullName } + + /// Makes a method definition read from a binary available as a MethodInfo. Not all methods are implemented. + and txILMethodDef (declTy: Type) (inp: ILMethodDef) = + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + let rec gps2 = inp.GenericParams |> Array.mapi (fun i gp -> txILGenericParam (fun () -> gps, gps2) (i + gps.Length) gp) + let mutable returnTypeFixCache = None + { new MethodInfo() with + + override __.Name = inp.Name + override __.DeclaringType = declTy + override __.MemberType = MemberTypes.Method + override __.Attributes = inp.Attributes + override __.GetParameters() = inp.Parameters |> Array.map (txILParameter (gps, gps2)) + override __.CallingConvention = if inp.IsStatic then CallingConventions.Standard else CallingConventions.HasThis ||| CallingConventions.Standard + + override __.ReturnType = + match returnTypeFixCache with + | None -> + let returnType = inp.Return.Type |> txILType (gps, gps2) + let returnTypeFix = + match returnType.Namespace, returnType.Name with + | "System", "Void"-> + if ImportProvidedMethodBaseAsILMethodRef_OnStack_HACK() then + typeof + else + returnType + | t -> returnType + returnTypeFixCache <- Some returnTypeFix + returnTypeFix + | Some returnTypeFix -> + returnTypeFix + + override __.GetCustomAttributesData() = inp.CustomAttrs |> txCustomAttributesData + override __.GetGenericArguments() = gps2 + override __.IsGenericMethod = (gps2.Length <> 0) + override __.IsGenericMethodDefinition = __.IsGenericMethod + + override __.GetHashCode() = inp.Token + + override this.Equals(that:obj) = + match that with + | :? MethodInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes this.DeclaringType that.DeclaringType + | _ -> false + + override this.MakeGenericMethod(args) = MethodSymbol2(this, args, typeBuilder) :> MethodInfo + + override __.MetadataToken = inp.Token + + // unused + override this.MethodHandle = notRequired this "MethodHandle" this.Name + override this.ReturnParameter = notRequired this "ReturnParameter" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + override this.ReturnTypeCustomAttributes = notRequired this "ReturnTypeCustomAttributes" this.Name + override this.GetBaseDefinition() = notRequired this "GetBaseDefinition" this.Name + override this.GetMethodImplementationFlags() = notRequired this "GetMethodImplementationFlags" this.Name + override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired this "Invoke" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" this.Name + + override __.ToString() = sprintf "tgt method %s(...) in type %s" inp.Name declTy.FullName } + + /// Makes a property definition read from a binary available as a PropertyInfo. Not all methods are implemented. + and txILPropertyDef (declTy: Type) (inp: ILPropertyDef) = + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + { new PropertyInfo() with + + override __.Name = inp.Name + override __.Attributes = inp.Attributes + override __.MemberType = MemberTypes.Property + override __.DeclaringType = declTy + + override __.PropertyType = inp.PropertyType |> txILType (gps, [| |]) + override __.GetGetMethod(_nonPublic) = inp.GetMethod |> Option.map (txILMethodRef declTy) |> Option.toObj + override __.GetSetMethod(_nonPublic) = inp.SetMethod |> Option.map (txILMethodRef declTy) |> Option.toObj + override __.GetIndexParameters() = inp.IndexParameters |> Array.map (txILParameter (gps, [| |])) + override __.CanRead = inp.GetMethod.IsSome + override __.CanWrite = inp.SetMethod.IsSome + override __.GetCustomAttributesData() = inp.CustomAttrs |> txCustomAttributesData + override __.MetadataToken = inp.Token + + override __.GetHashCode() = inp.Token + + override this.Equals(that:obj) = + match that with + | :? PropertyInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes this.DeclaringType that.DeclaringType + | _ -> false + + override this.GetValue(_obj, _invokeAttr, _binder, _index, _culture) = notRequired this "GetValue" this.Name + override this.SetValue(_obj, _value, _invokeAttr, _binder, _index, _culture) = notRequired this "SetValue" this.Name + override this.GetAccessors(nonPublic) = notRequired this "GetAccessors" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + + override __.ToString() = sprintf "tgt property %s(...) in type %s" inp.Name declTy.Name } + + /// Make an event definition read from a binary available as an EventInfo. Not all methods are implemented. + and txILEventDef (declTy: Type) (inp: ILEventDef) = + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + { new EventInfo() with + + override __.Name = inp.Name + override __.Attributes = inp.Attributes + override __.MemberType = MemberTypes.Event + override __.DeclaringType = declTy + + override __.EventHandlerType = inp.EventHandlerType |> txILType (gps, [| |]) + override __.GetAddMethod(_nonPublic) = inp.AddMethod |> txILMethodRef declTy + override __.GetRemoveMethod(_nonPublic) = inp.RemoveMethod |> txILMethodRef declTy + override __.GetCustomAttributesData() = inp.CustomAttrs |> txCustomAttributesData + override __.MetadataToken = inp.Token + + override __.GetHashCode() = inp.Token + + override this.Equals(that:obj) = + match that with + | :? EventInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes this.DeclaringType that.DeclaringType + | _ -> false + + override this.GetRaiseMethod(_nonPublic) = notRequired this "GetRaiseMethod" this.Name + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + + override __.ToString() = sprintf "tgt event %s(...) in type %s" inp.Name declTy.FullName } + + /// Makes a field definition read from a binary available as a FieldInfo. Not all methods are implemented. + and txILFieldDef (declTy: Type) (inp: ILFieldDef) = + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + { new FieldInfo() with + + override __.Name = inp.Name + override __.Attributes = inp.Attributes + override __.MemberType = MemberTypes.Field + override __.DeclaringType = declTy + + override __.FieldType = inp.FieldType |> txILType (gps, [| |]) + override __.GetRawConstantValue() = match inp.LiteralValue with None -> null | Some v -> v + override __.GetCustomAttributesData() = inp.CustomAttrs |> txCustomAttributesData + override __.MetadataToken = inp.Token + + override __.GetHashCode() = inp.Token + + override this.Equals(that:obj) = + match that with + | :? FieldInfo as that -> this.MetadataToken = that.MetadataToken && eqTypes this.DeclaringType that.DeclaringType + | _ -> false + + override this.ReflectedType = notRequired this "ReflectedType" this.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" this.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" this.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" this.Name + override this.SetValue(_obj, _value, _invokeAttr, _binder, _culture) = notRequired this "SetValue" this.Name + override this.GetValue(_obj) = notRequired this "GetValue" this.Name + override this.FieldHandle = notRequired this "FieldHandle" this.Name + + override __.ToString() = sprintf "tgt literal field %s(...) in type %s" inp.Name declTy.FullName } + + /// Bind a reference to an assembly + and txScopeRef(sref: ILScopeRef) = + match sref with + | ILScopeRef.Assembly aref -> match tryBindAssembly aref with Choice1Of2 asm -> asm | Choice2Of2 exn -> raise exn + | ILScopeRef.Local -> (asm :> Assembly) + | ILScopeRef.Module _ -> (asm :> Assembly) + + /// Bind a reference to a type + and txILTypeRef(tref: ILTypeRef): Type = + match tref.Scope with + | ILTypeRefScope.Top scoref -> txScopeRef(scoref).GetType(joinILTypeName tref.Namespace tref.Name) + | ILTypeRefScope.Nested encl -> txILTypeRef(encl).GetNestedType(tref.Name, bindAll) + + /// Bind a reference to a constructor + and txILConstructorRef (mref: ILMethodRef) = + let declTy = txILTypeRef(mref.EnclosingTypeRef) + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + let argTypes = Array.map (txILType (gps, [| |])) mref.ArgTypes + let cons = declTy.GetConstructor(bindAll, null, argTypes, null) + if isNull cons then failwithf "constructor reference '%A' not resolved" mref + cons + + /// Bind a reference to a method + and txILMethodRef (declTy: Type) (mref: ILMethodRef) = + let gps = if declTy.IsGenericType then declTy.GetGenericArguments() else [| |] + let argTypes = mref.ArgTypes |> Array.map (txILType (gps, [| |])) + let meth = declTy.GetMethod(mref.Name, bindAll, null, argTypes, null) + if isNull meth then failwithf "method reference '%A' not resolved" mref + meth + + /// Convert an ILType read from a binary to a System.Type backed by TargetTypeDefinitions + and txILType gps (ty: ILType) = + + match ty with + | ILType.Void -> txILType gps ilGlobals.typ_Void + | ILType.Value tspec + | ILType.Boxed tspec -> + let tdefR = txILTypeRef tspec.TypeRef + match tspec.GenericArgs with + | [| |] -> tdefR + | args -> tdefR.MakeGenericType(Array.map (txILType gps) args) + | ILType.Array(rank, arg) -> + let argR = txILType gps arg + if rank.Rank = 1 then argR.MakeArrayType() + else argR.MakeArrayType(rank.Rank) + | ILType.FunctionPointer _ -> failwith "unexpected function type" + | ILType.Ptr(arg) -> (txILType gps arg).MakePointerType() + | ILType.Byref(arg) -> (txILType gps arg).MakeByRefType() + | ILType.Modified(_, _mod, arg) -> txILType gps arg + | ILType.Var(n) -> + let (gps1:Type[]), (gps2:Type[]) = gps + if n < gps1.Length then gps1.[n] + elif n < gps1.Length + gps2.Length then gps2.[n - gps1.Length] + else failwithf "generic parameter index out of range: %d" n + + /// Convert an ILGenericParameterDef read from a binary to a System.Type. + and txILGenericParam gpsf pos (inp: ILGenericParameterDef) = + TargetGenericParam (asm, gpsf, pos, inp, txILType, txCustomAttributesData, typeBuilder) :> Type + + let rec gps = inp.GenericParams |> Array.mapi (fun i gp -> txILGenericParam (fun () -> gps, [| |]) i gp) + + let isNested = declTyOpt.IsSome + + do this.typeImpl <- this + override __.Name = inp.Name + override __.Assembly = (asm :> Assembly) + override __.DeclaringType = declTyOpt |> Option.toObj + override __.MemberType = if isNested then MemberTypes.NestedType else MemberTypes.TypeInfo + override __.MetadataToken = inp.Token + + override __.FullName = + match declTyOpt with + | None -> + match inp.Namespace with + | UNone -> inp.Name + | USome nsp -> nsp + "." + inp.Name + | Some declTy -> + declTy.FullName + "+" + inp.Name + + override __.Namespace = inp.Namespace |> StructOption.toObj + override __.BaseType = inp.Extends |> Option.map (txILType (gps, [| |])) |> Option.toObj + override __.GetInterfaces() = inp.Implements |> Array.map (txILType (gps, [| |])) + + override this.GetConstructors(bindingFlags) = + inp.Methods.Entries + |> Array.filter (fun x -> x.Name = ".ctor" || x.Name = ".cctor") + |> Array.map (txILConstructorDef this) + |> Array.filter (canBindConstructor bindingFlags) + + override this.GetMethods(bindingFlags) = + inp.Methods.Entries + |> Array.filter (fun x -> x.Name <> ".ctor" && x.Name <> ".cctor") + |> Array.map (txILMethodDef this) + |> Array.filter (canBindMethod bindingFlags) + + override this.GetFields(bindingFlags) = + inp.Fields.Entries + |> Array.map (txILFieldDef this) + |> Array.filter (canBindField bindingFlags) + + override this.GetEvents(bindingFlags) = + inp.Events.Entries + |> Array.map (txILEventDef this) + |> Array.filter (canBindEvent bindingFlags) + + override this.GetProperties(bindingFlags) = + inp.Properties.Entries + |> Array.map (txILPropertyDef this) + |> Array.filter (canBindProperty bindingFlags) + + override this.GetNestedTypes(bindingFlags) = + inp.NestedTypes.Entries + |> Array.map (asm.TxILTypeDef (Some (this :> Type))) + |> Array.filter (canBindNestedType bindingFlags) + + override this.GetConstructorImpl(_bindingFlags, _binder, _callConvention, types, _modifiers) = + let md = + match types with + | null -> inp.Methods.TryFindUniqueByName(".ctor") + | _ -> + inp.Methods.FindByNameAndArity(".ctor", types.Length) + |> Array.tryFind (fun md -> eqTypesAndILTypes types md.ParameterTypes) + md + |> Option.map (txILConstructorDef this) + |> Option.toObj + + override this.GetMethodImpl(name, _bindingFlags, _binder, _callConvention, types, _modifiers) = + let md = + match types with + | null -> inp.Methods.TryFindUniqueByName(name) + | _ -> + inp.Methods.FindByNameAndArity(name, types.Length) + |> Array.tryFind (fun md -> eqTypesAndILTypes types md.ParameterTypes) + md |> Option.map (txILMethodDef this) |> Option.toObj + + override this.GetField(name, _bindingFlags) = + inp.Fields.Entries + |> Array.tryPick (fun p -> if p.Name = name then Some (txILFieldDef this p) else None) + |> Option.toObj + + override this.GetPropertyImpl(name, _bindingFlags, _binder, _returnType, _types, _modifiers) = + inp.Properties.Entries + |> Array.tryPick (fun p -> if p.Name = name then Some (txILPropertyDef this p) else None) + |> Option.toObj + + override this.GetEvent(name, _bindingFlags) = + inp.Events.Entries + |> Array.tryPick (fun ev -> if ev.Name = name then Some (txILEventDef this ev) else None) + |> Option.toObj + + override this.GetNestedType(name, _bindingFlags) = + inp.NestedTypes.TryFindByName(UNone, name) |> Option.map (asm.TxILTypeDef (Some (this :> Type))) |> Option.toObj + + + override this.GetMembers(bindingFlags) = + [| for x in this.GetConstructors(bindingFlags) do yield (x :> MemberInfo) + for x in this.GetMethods(bindingFlags) do yield (x :> MemberInfo) + for x in this.GetFields(bindingFlags) do yield (x :> MemberInfo) + for x in this.GetProperties(bindingFlags) do yield (x :> MemberInfo) + for x in this.GetEvents(bindingFlags) do yield (x :> MemberInfo) + for x in this.GetNestedTypes(bindingFlags) do yield (x :> MemberInfo) |] + + override this.MakeGenericType(args) = TypeSymbol(TypeSymbolKind.TargetGeneric this, args, typeBuilder) :> Type + override this.MakeArrayType() = TypeSymbol(TypeSymbolKind.SDArray, [| this |], typeBuilder) :> Type + override this.MakeArrayType arg = TypeSymbol(TypeSymbolKind.Array arg, [| this |], typeBuilder) :> Type + override this.MakePointerType() = TypeSymbol(TypeSymbolKind.Pointer, [| this |], typeBuilder) :> Type + override this.MakeByRefType() = TypeSymbol(TypeSymbolKind.ByRef, [| this |], typeBuilder) :> Type + + override __.GetAttributeFlagsImpl() = + let attr = TypeAttributes.Public ||| TypeAttributes.Class + let attr = if inp.IsSealed then attr ||| TypeAttributes.Sealed else attr + let attr = if inp.IsInterface then attr ||| TypeAttributes.Interface else attr + let attr = if inp.IsSerializable then attr ||| TypeAttributes.Serializable else attr + if isNested then adjustTypeAttributes isNested attr else attr + + override __.IsValueTypeImpl() = inp.IsStructOrEnum + + override __.IsEnum = + match this.BaseType with + | null -> false + | bt -> bt.FullName = "System.Enum" || bt.IsEnum + + override __.GetEnumUnderlyingType() = + if this.IsEnum then + txILType ([| |], [| |]) ilGlobals.typ_Int32 // TODO: in theory the assumption of "Int32" is not accurate for all enums, howver in practice .NET only uses enums with backing field Int32 + else failwithf "not enum type" + + override __.IsArrayImpl() = false + override __.IsByRefImpl() = false + override __.IsPointerImpl() = false + override __.IsPrimitiveImpl() = false + override __.IsCOMObjectImpl() = false + override __.IsGenericType = (gps.Length <> 0) + override __.IsGenericTypeDefinition = (gps.Length <> 0) + override __.HasElementTypeImpl() = false + + override this.UnderlyingSystemType = (this :> Type) + override __.GetCustomAttributesData() = inp.CustomAttrs |> txCustomAttributesData + + override this.Equals(that:obj) = System.Object.ReferenceEquals (this, that) + override this.Equals(that:Type) = System.Object.ReferenceEquals (this, that) + override __.GetHashCode() = inp.Token + + override this.IsAssignableFrom(otherTy: Type) = isAssignableFrom this otherTy + + override this.IsSubclassOf(otherTy: Type) = isSubclassOf this otherTy + + override this.AssemblyQualifiedName = "[" + this.Assembly.FullName + "]" + this.FullName + + override this.ToString() = sprintf "tgt type %s" this.FullName + + override __.GetGenericArguments() = gps + override this.GetGenericTypeDefinition() = (this :> Type) + + override x.Module = x.Assembly.ManifestModule + + override this.GetMember(_name, _memberType, _bindingFlags) = notRequired this "GetMember" inp.Name + override this.GUID = notRequired this "GUID" inp.Name + override this.GetCustomAttributes(_inherited) = notRequired this "GetCustomAttributes" inp.Name + override this.GetCustomAttributes(_attributeType, _inherited) = notRequired this "GetCustomAttributes" inp.Name + override this.IsDefined(_attributeType, _inherited) = notRequired this "IsDefined" inp.Name + override this.GetInterface(_name, _ignoreCase) = notRequired this "GetInterface" inp.Name + override this.GetElementType() = notRequired this "GetElementType" inp.Name + override this.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired this "InvokeMember" inp.Name + + member __.Metadata: ILTypeDef = inp + member __.MakeMethodInfo (declTy: Type) md = txILMethodDef declTy md + member __.MakeConstructorInfo (declTy: Type) md = txILConstructorDef declTy md + member __.MakePropertyInfo (declTy: Type) md = txILPropertyDef declTy md + member __.MakeEventInfo (declTy: Type) md = txILEventDef declTy md + member __.MakeFieldInfo (declTy: Type) md = txILFieldDef declTy md + member __.MakeNestedTypeInfo (declTy: Type) md = asm.TxILTypeDef (Some declTy) md + override this.GetEvents() = this.GetEvents(BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.Static) // Needed because TypeDelegator.cs provides a delegting implementation of this, and we are self-delegating +#if NETCOREAPP + // See bug https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues/236 + override __.IsSZArray = false +#endif + + and TargetModule(location: string) = + inherit Module() + override __.MetadataToken = hash location + + /// Implements System.Reflection.Assembly backed by .NET metadata provided by an ILModuleReader + and TargetAssembly(ilGlobals, tryBindAssembly: ILAssemblyRef -> Choice, reader: ILModuleReader option, location: string, typeBuilder: ITypeBuilder) as asm = + inherit Assembly() + + // A table tracking how type definition objects are translated. + let txTable = TxTable() + let mutable reader = reader + let manifestModule = TargetModule(location) + let getReader() = match reader with None -> failwith "the reader on the TargetAssembly has not been set" | Some r -> r + + let txILTypeDef (declTyOpt: Type option) (inp: ILTypeDef) = + txTable.Get inp.Token (fun () -> + // We never create target types for the types of primitive values that are accepted by the F# compiler as Expr.Value nodes, + // which fortunately also correspond to element types. We just use the design-time types instead. + // See convertConstExpr in the compiler, e.g. + // https://github.com/Microsoft/visualfsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 + // for the accepted types. + match inp.Namespace, inp.Name with + //| USome "System", "Void"-> typeof + (* + | USome "System", "Boolean" -> typeof + | USome "System", "String"-> typeof + | USome "System", "Object"-> typeof + | USome "System", "Int32" -> typeof + | USome "System", "SByte" -> typeof + | USome "System", "Int16"-> typeof + | USome "System", "Int64" -> typeof + | USome "System", "IntPtr" -> typeof + | USome "System", "Byte" -> typeof + | USome "System", "UInt16"-> typeof + | USome "System", "UInt32" -> typeof + | USome "System", "UInt64" -> typeof + | USome "System", "UIntPtr" -> typeof + | USome "System", "Double" -> typeof + | USome "System", "Single" -> typeof + | USome "System", "Char" -> typeof + *) + | _ -> + TargetTypeDefinition(ilGlobals, tryBindAssembly, asm, declTyOpt, inp, typeBuilder) :> System.Type) + + let types = lazy [| for td in getReader().ILModuleDef.TypeDefs.Entries -> txILTypeDef None td |] + + + override __.GetReferencedAssemblies() = [| for aref in getReader().ILAssemblyRefs -> aref.ToAssemblyName() |] + + override __.GetTypes () = types.Force() + + override x.GetType (nm:string) = + if nm.Contains("+") then + let i = nm.LastIndexOf("+") + let enc, nm2 = nm.[0..i-1], nm.[i+1..] + match x.GetType(enc) with + | null -> null + | t -> t.GetNestedType(nm2, bindAll) + elif nm.Contains(".") then + let i = nm.LastIndexOf(".") + let nsp, nm2 = nm.[0..i-1], nm.[i+1..] + x.TryBindType(USome nsp, nm2) |> Option.toObj + else + x.TryBindType(UNone, nm) |> Option.toObj + + override __.GetName() = getReader().ILModuleDef.ManifestOfAssembly.GetName() + + override x.FullName = x.GetName().ToString() + + override __.Location = location + override __.ManifestModule = (manifestModule :> Module) + + override __.ReflectionOnly = true + + override x.GetManifestResourceStream(resourceName:string) = + let r = getReader().ILModuleDef.Resources.Entries |> Seq.find (fun r -> r.Name = resourceName) + match r.Location with + | ILResourceLocation.Local f -> new MemoryStream(f()) :> Stream + | _ -> + notRequired x "reading manifest resource %s" resourceName + + member __.TxILTypeDef declTyOpt inp = txILTypeDef declTyOpt inp + + member __.Reader with get() = reader and set v = (if reader.IsSome then failwith "reader on TargetAssembly already set"); reader <- v + + member __.TryBindType(nsp:string uoption, nm:string): Type option = + match getReader().ILModuleDef.TypeDefs.TryFindByName(nsp, nm) with + | Some td -> asm.TxILTypeDef None td |> Some + | None -> + match getReader().ILModuleDef.ManifestOfAssembly.ExportedTypes.TryFindByName(nsp, nm) with + | Some tref -> + match tref.ScopeRef with + | ILScopeRef.Assembly aref2 -> + let ass2opt = tryBindAssembly(aref2) + match ass2opt with + | Choice1Of2 ass2 -> + match ass2.GetType(joinILTypeName nsp nm) with + | null -> None + | ty -> Some ty + | Choice2Of2 _err -> None + | _ -> + printfn "unexpected non-forwarder during binding" + None + | None -> None + + member x.BindType(nsp:string uoption, nm:string) = + match x.TryBindType(nsp, nm) with + | None -> failwithf "failed to bind type %s in assembly %s" nm asm.FullName + | Some res -> res + + override x.ToString() = "tgt assembly " + x.FullName + + type ProvidedAssembly(isTgt: bool, assemblyName:AssemblyName, assemblyFileName: string, customAttributesData) = + + inherit Assembly() + + let customAttributesImpl = CustomAttributesImpl(isTgt, customAttributesData) + + let theTypes = ResizeArray() + + let addTypes (ptds:ProvidedTypeDefinition[], enclosingTypeNames: string list option) = + for pt in ptds do + if pt.IsErased then failwith ("The provided type "+pt.Name+"is marked as erased and cannot be converted to a generated type. Set 'IsErased=false' on the ProvidedTypeDefinition") + if not isTgt && pt.BelongsToTargetModel then failwithf "Expected '%O' to be a source ProvidedTypeDefinition. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" pt + if isTgt && not pt.BelongsToTargetModel then failwithf "Expected '%O' to be a target ProvidedTypeDefinition. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" pt + theTypes.Add (ptds, enclosingTypeNames) + + let theTypesArray = lazy (theTypes.ToArray() |> Array.collect (function (ptds, None) -> Array.map (fun ptd -> (ptd :> Type)) ptds | _ -> [| |])) + + member __.AddCustomAttribute(attribute) = customAttributesImpl.AddCustomAttribute(attribute) + + override __.GetReferencedAssemblies() = [| |] //notRequired x "GetReferencedAssemblies" (assemblyName.ToString()) + + override __.GetName() = assemblyName + + override __.FullName = assemblyName.ToString() + + override __.Location = assemblyFileName + + override __.ReflectionOnly = true + + override __.GetTypes () = theTypesArray.Force() + + override __.ToString () = assemblyName.ToString() + + override x.GetType (nm: string) = + if nm.Contains("+") then + let i = nm.LastIndexOf("+") + let enc, nm2 = nm.[0..i-1], nm.[i+1..] + match x.GetType(enc) with + | null -> null + | t -> t.GetNestedType(nm2, bindAll) + else + theTypesArray.Force() + |> Array.tryPick (fun ty -> if ty.FullName = nm then Some ty else None) + |> Option.toObj + + new () = + let tmpFile = Path.GetTempFileName() + let assemblyFileName = Path.ChangeExtension(tmpFile, "dll") + File.Delete(tmpFile) + let simpleName = Path.GetFileNameWithoutExtension(assemblyFileName) + ProvidedAssembly(AssemblyName(simpleName), assemblyFileName) + + new (assemblyName, assemblyFileName) = + ProvidedAssembly(false, assemblyName, assemblyFileName, K [||]) + + member __.BelongsToTargetModel = isTgt + + member __.AddNestedTypes (types, enclosingGeneratedTypeNames) = + addTypes (Array.ofList types, Some enclosingGeneratedTypeNames) + + member __.AddTypes (types) = + addTypes (Array.ofList types, None) + + member __.AddTheTypes (types, enclosingGeneratedTypeNames) = + addTypes (types, enclosingGeneratedTypeNames) + + member __.GetTheTypes () = theTypes.ToArray() + + override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData() + +//==================================================================================================== +// ProvidedTypesContext +// +// A binding context for cross-targeting type providers + +namespace ProviderImplementation.ProvidedTypes + + + #nowarn "8796" + #nowarn "1182" + + open System + open System.Diagnostics + open System.IO + open System.Collections.Concurrent + open System.Collections.Generic + open System.Reflection + + open Microsoft.FSharp.Quotations + open Microsoft.FSharp.Quotations.Patterns + open Microsoft.FSharp.Quotations.DerivedPatterns + open Microsoft.FSharp.Core.CompilerServices + open Microsoft.FSharp.Reflection + + open ProviderImplementation.ProvidedTypes + open ProviderImplementation.ProvidedTypes.AssemblyReader + + [] + module private ImplementationUtils = + type System.Object with + member x.GetProperty(nm) = + let ty = x.GetType() + let prop = ty.GetProperty(nm, bindAll) + let v = prop.GetValue(x, null) + v + + member x.GetField(nm) = + let ty = x.GetType() + let fld = ty.GetField(nm, bindAll) + let v = fld.GetValue(x) + v + + member x.HasProperty(nm) = + let ty = x.GetType() + let p = ty.GetProperty(nm, bindAll) + p |> isNull |> not + + member x.HasField(nm) = + let ty = x.GetType() + let fld = ty.GetField(nm, bindAll) + fld |> isNull |> not + + member x.GetElements() = [ for v in (x :?> System.Collections.IEnumerable) do yield v ] + + + + type ProvidedTypeBuilder() = + static let tupleNames = + [| "System.Tuple`1"; "System.Tuple`2"; "System.Tuple`3"; + "System.Tuple`4"; "System.Tuple`5"; "System.Tuple`6"; + "System.Tuple`7"; "System.Tuple`8"; "System.Tuple" + "System.ValueTuple`1"; "System.ValueTuple`2"; "System.ValueTuple`3"; + "System.ValueTuple`4"; "System.ValueTuple`5"; "System.ValueTuple`6"; + "System.ValueTuple`7"; "System.ValueTuple`8"; "System.ValueTuple" |] + + + static member MakeGenericType(genericTypeDefinition: Type, genericArguments: Type list) = + if genericArguments.Length = 0 then genericTypeDefinition else + match genericTypeDefinition with + | :? TargetTypeDefinition -> failwithf "unexpected target model in ProvidedTypeBuilder.MakeGenericType, stacktrace = %s " Environment.StackTrace + | :? ProvidedTypeDefinition as ptd when ptd.BelongsToTargetModel -> failwithf "unexpected target model ptd in MakeGenericType, stacktrace = %s " Environment.StackTrace + | :? ProvidedTypeDefinition -> ProvidedTypeSymbol(ProvidedTypeSymbolKind.Generic genericTypeDefinition, genericArguments, ProvidedTypeBuilder.typeBuilder) :> Type + | _ -> TypeSymbol(TypeSymbolKind.OtherGeneric genericTypeDefinition, List.toArray genericArguments, ProvidedTypeBuilder.typeBuilder) :> Type + + static member MakeGenericMethod(genericMethodDefinition, genericArguments: Type list) = + if genericArguments.Length = 0 then genericMethodDefinition else + MethodSymbol2(genericMethodDefinition, Array.ofList genericArguments, ProvidedTypeBuilder.typeBuilder) :> MethodInfo + + static member MakeTupleType(types, isStruct) = + let rec mkTupleType isStruct (asm:Assembly) (tys:Type list) = + let maxTuple = 8 + + let n = min tys.Length maxTuple + let tupleFullName = tupleNames.[n - 1 + (if isStruct then 9 else 0)] + let ty = asm.GetType(tupleFullName) + if tys.Length >= maxTuple then + let tysA = (Array.ofList tys).[0..maxTuple-2] |> List.ofArray + let tysB = (Array.ofList tys).[maxTuple-1..] |> List.ofArray + let tyB = mkTupleType isStruct asm tysB + ProvidedTypeBuilder.MakeGenericType(ty, List.append tysA [ tyB ]) + else + ProvidedTypeBuilder.MakeGenericType(ty, tys) + mkTupleType isStruct (typeof.Assembly) types + + static member MakeTupleType(types) = ProvidedTypeBuilder.MakeTupleType(types, false) + + static member typeBuilder = + { new ITypeBuilder with + member this.MakeGenericType(typeDef: Type, args)= + match typeDef with + | :? ProvidedTypeDefinition -> ProvidedTypeSymbol(ProvidedTypeSymbolKind.Generic typeDef, Array.toList args, this) :> Type + | _ -> + if args |> Array.exists (function :? ProvidedTypeDefinition -> true | _ -> false) then + TypeSymbol(TypeSymbolKind.OtherGeneric typeDef, args, this) :> Type + else + typeDef.MakeGenericType(args) + member this.MakeArrayType(typ) = + match typ with + | :? ProvidedTypeDefinition -> + TypeSymbol(TypeSymbolKind.SDArray, [| typ |], this) :> Type + | _ -> typ.MakeArrayType() + member this.MakeRankedArrayType(typ,rank) = + match typ with + | :? ProvidedTypeDefinition -> + TypeSymbol(TypeSymbolKind.Array rank, [| typ |], this) :> Type + | _ -> typ.MakeArrayType(rank) + member this.MakePointerType(typ) = + match typ with + | :? ProvidedTypeDefinition -> + TypeSymbol(TypeSymbolKind.Pointer, [| typ |], this) :> Type + | _ -> typ.MakePointerType() + member this.MakeByRefType(typ) = + match typ with + | :? ProvidedTypeDefinition -> + TypeSymbol(TypeSymbolKind.ByRef, [| typ |], this) :> Type + | _ -> typ.MakeByRefType() } + + //-------------------------------------------------------------------------------- + // The quotation simplifier + // + // This is invoked for each quotation specified by the type provider, as part of the translation to + /// the target model, i.e. before it is handed to the F# compiler (for erasing type providers) or + // the TPSDK IL code generator (for generative type providers). This allows a broader range of quotations + // to be used when authoring type providers than are strictly allowed by those tools. + // + // Specifically we accept: + // + // - NewTuple nodes (for generative type providers) + // - TupleGet nodes (for generative type providers) + // - array and list values as constants + // - PropertyGet and PropertySet nodes + // - Application, NewUnionCase, NewRecord, UnionCaseTest nodes + // - Let nodes (defining "byref" values) + // - LetRecursive nodes + // + // Additionally, a set of code optimizations are applied for generative type providers: + // - inlineRightPipe + // - optimizeCurriedApplications + // - inlineValueBindings + + // Note, the QuotationSimplifier works over source quotations, not target quotations + type QuotationSimplifier(isGenerated: bool) = + + let rec simplifyExpr q = + match q with + +#if !NO_GENERATIVE + // Convert NewTuple to the call to the constructor of the Tuple type (only for generated types, + // the F# compile does the job for erased types when it receives the quotation) + | NewTuple(items) when isGenerated -> + let rec mkCtor args ty = + let ctor, restTyOpt = Reflection.FSharpValue.PreComputeTupleConstructorInfo ty + match restTyOpt with + | None -> Expr.NewObjectUnchecked(ctor, List.map simplifyExpr args) + | Some restTy -> + let curr = [for a in Seq.take 7 args -> simplifyExpr a] + let rest = List.ofSeq (Seq.skip 7 args) + Expr.NewObjectUnchecked(ctor, curr @ [mkCtor rest restTy]) + let tys = [ for e in items -> e.Type ] + let tupleTy = ProvidedTypeBuilder.MakeTupleType(tys, q.Type.IsValueType) + simplifyExpr (mkCtor items tupleTy) + + // convert TupleGet to the chain of PropertyGet calls (only for generated types) + | TupleGet(e, i) when isGenerated -> + let rec mkGet (ty : Type) i (e: Expr) = + if ty.IsValueType then + let get index = + let fields = ty.GetFields() |> Array.sortBy (fun fi -> fi.Name) + if index >= fields.Length then + invalidArg "index" (sprintf "The tuple index '%d' was out of range for tuple type %s" index ty.Name) + fields.[index] + let tupleEncField = 7 + let fget = Expr.FieldGetUnchecked(e, get i) + if i < tupleEncField then + fget + else + let etys = ty.GetGenericArguments() + mkGet etys.[tupleEncField] (i - tupleEncField) fget + else + let pi, restOpt = Reflection.FSharpValue.PreComputeTuplePropertyInfo(ty, i) + let propGet = Expr.PropertyGetUnchecked(e, pi) + match restOpt with + | None -> propGet + | Some (restTy, restI) -> mkGet restTy restI propGet + simplifyExpr (mkGet e.Type i (simplifyExpr e)) +#endif + + | Value(value, ty) -> + if value |> isNull |> not then + let tyOfValue = value.GetType() + transValue(value, tyOfValue, ty) + else q + + // Eliminate F# property gets to method calls + | PropertyGet(obj, propInfo, args) -> + match obj with + | None -> simplifyExpr (Expr.CallUnchecked(propInfo.GetGetMethod(true), args)) + | Some o -> simplifyExpr (Expr.CallUnchecked(simplifyExpr o, propInfo.GetGetMethod(true), args)) + + // Eliminate F# property sets to method calls + | PropertySet(obj, propInfo, args, v) -> + match obj with + | None -> simplifyExpr (Expr.CallUnchecked(propInfo.GetSetMethod(true), args@[v])) + | Some o -> simplifyExpr (Expr.CallUnchecked(simplifyExpr o, propInfo.GetSetMethod(true), args@[v])) + + // Eliminate F# function applications to FSharpFunc<_, _>.Invoke calls + | Application(f, e) -> + simplifyExpr (Expr.CallUnchecked(simplifyExpr f, f.Type.GetMethod "Invoke", [ e ]) ) + + // Eliminate F# union operations + | NewUnionCase(ci, es) -> + simplifyExpr (Expr.CallUnchecked(Reflection.FSharpValue.PreComputeUnionConstructorInfo ci, es) ) + + // Eliminate F# union operations + | UnionCaseTest(e, uc) -> + let tagInfo = Reflection.FSharpValue.PreComputeUnionTagMemberInfo uc.DeclaringType + let tagExpr = + match tagInfo with + | :? PropertyInfo as tagProp -> + simplifyExpr (Expr.PropertyGet(e, tagProp) ) + | :? MethodInfo as tagMeth -> + if tagMeth.IsStatic then simplifyExpr (Expr.Call(tagMeth, [e])) + else simplifyExpr (Expr.Call(e, tagMeth, [])) + | _ -> failwith "unreachable: unexpected result from PreComputeUnionTagMemberInfo. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" + let tagNumber = uc.Tag + simplifyExpr <@@ (%%(tagExpr): int) = tagNumber @@> + + // Eliminate F# record operations + | NewRecord(ci, es) -> + simplifyExpr (Expr.NewObjectUnchecked(Reflection.FSharpValue.PreComputeRecordConstructorInfo ci, es) ) + + // Explicitly handle weird byref variables in lets (used to populate out parameters), since the generic handlers can't deal with byrefs. + // + // The binding must have leaves that are themselves variables (due to the limited support for byrefs in expressions) + // therefore, we can perform inlining to translate this to a form that can be compiled + | Let(v, vexpr, bexpr) when v.Type.IsByRef -> transLetOfByref v vexpr bexpr + + // Eliminate recursive let bindings (which are unsupported by the type provider API) to regular let bindings + | LetRecursive(bindings, expr) -> simplifyLetRec bindings expr + + // Handle the generic cases + | ShapeLambdaUnchecked(v, body) -> Expr.Lambda(v, simplifyExpr body) + | ShapeCombinationUnchecked(comb, args) -> RebuildShapeCombinationUnchecked(comb, List.map simplifyExpr args) + | ShapeVarUnchecked _ -> q + + and simplifyLetRec bindings expr = + // This uses a "lets and sets" approach, converting something like + // let rec even = function + // | 0 -> true + // | n -> odd (n-1) + // and odd = function + // | 0 -> false + // | n -> even (n-1) + // X + // to something like + // let even = ref Unchecked.defaultof<_> + // let odd = ref Unchecked.defaultof<_> + // even := function + // | 0 -> true + // | n -> !odd (n-1) + // odd := function + // | 0 -> false + // | n -> !even (n-1) + // X' + // where X' is X but with occurrences of even/odd substituted by !even and !odd (since now even and odd are references) + // Translation relies on typedefof<_ ref> - does this affect ability to target different runtime and design time environments? + let vars = List.map fst bindings + let refVars = vars |> List.map (fun v -> Var(v.Name, ProvidedTypeBuilder.MakeGenericType(typedefof<_ ref>, [v.Type]))) + + // "init t" generates the equivalent of <@ ref Unchecked.defaultof @> + let init (t:Type) = + let r = match <@ ref 1 @> with Call(None, r, [_]) -> r | _ -> failwith "Extracting MethodInfo from <@ 1 @> failed" + let d = match <@ Unchecked.defaultof<_> @> with Call(None, d, []) -> d | _ -> failwith "Extracting MethodInfo from <@ Unchecked.defaultof<_> @> failed" + let ir = ProvidedTypeBuilder.MakeGenericMethod(r.GetGenericMethodDefinition(), [ t ]) + let id = ProvidedTypeBuilder.MakeGenericMethod(d.GetGenericMethodDefinition(), [ t ]) + Expr.CallUnchecked(ir, [Expr.CallUnchecked(id, [])]) + + // deref v generates the equivalent of <@ !v @> + // (so v's type must be ref) + let deref (v:Var) = + let m = match <@ !(ref 1) @> with Call(None, m, [_]) -> m | _ -> failwith "Extracting MethodInfo from <@ !(ref 1) @> failed" + let tyArgs = v.Type.GetGenericArguments() + let im = ProvidedTypeBuilder.MakeGenericMethod(m.GetGenericMethodDefinition(), Array.toList tyArgs) + Expr.CallUnchecked(im, [Expr.Var v]) + + // substitution mapping a variable v to the expression <@ !v' @> using the corresponding new variable v' of ref type + let subst = + let map = [ for v in refVars -> v.Name, deref v ] |> Map.ofList + fun (v:Var) -> Map.tryFind v.Name map + + let refExpr = expr.Substitute(subst) + + // maps variables to new variables + let varDict = [ for (v, rv) in List.zip vars refVars -> v.Name, rv ] |> dict + + // given an old variable v and an expression e, returns a quotation like <@ v' := e @> using the corresponding new variable v' of ref type + let setRef (v:Var) e = + let m = match <@ (ref 1) := 2 @> with Call(None, m, [_;_]) -> m | _ -> failwith "Extracting MethodInfo from <@ (ref 1) := 2 @> failed" + let im = ProvidedTypeBuilder.MakeGenericMethod(m.GetGenericMethodDefinition(), [ v.Type ]) + Expr.CallUnchecked(im, [Expr.Var varDict.[v.Name]; e]) + + // Something like + // <@ + // v1 := e1' + // v2 := e2' + // ... + // refExpr + // @> + // Note that we must substitute our new variable dereferences into the bound expressions + let body = + bindings + |> List.fold (fun b (v, e) -> Expr.Sequential(setRef v (e.Substitute subst), b)) refExpr + + // Something like + // let v1 = ref Unchecked.defaultof + // let v2 = ref Unchecked.defaultof + // ... + // body + (body, vars) + ||> List.fold (fun b v -> Expr.LetUnchecked(varDict.[v.Name], init v.Type, b)) + |> simplifyExpr + + + and transLetOfByref v vexpr bexpr = + match vexpr with + | Sequential(e', vexpr') -> + (* let v = (e'; vexpr') in bexpr => e'; let v = vexpr' in bexpr *) + Expr.Sequential(e', transLetOfByref v vexpr' bexpr) + |> simplifyExpr + | IfThenElse(c, b1, b2) -> + (* let v = if c then b1 else b2 in bexpr => if c then let v = b1 in bexpr else let v = b2 in bexpr *) + // + // Note, this duplicates "bexpr" + Expr.IfThenElseUnchecked(c, transLetOfByref v b1 bexpr, transLetOfByref v b2 bexpr) + |> simplifyExpr + | Var _ -> + (* let v = v1 in bexpr => bexpr[v/v1] *) + bexpr.Substitute(fun v' -> if v = v' then Some vexpr else None) + |> simplifyExpr + | _ -> + failwithf "Unexpected byref binding: %A = %A. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" v vexpr + + and transValueArray (o: Array, ty: Type) = + let elemTy = ty.GetElementType() + let converter = getValueConverterForType elemTy + let elements = [ for el in o -> converter el ] + Expr.NewArrayUnchecked(elemTy, elements) + + and transValueList(o, ty: Type, nil, cons) = + let converter = getValueConverterForType (ty.GetGenericArguments().[0]) + o + |> Seq.cast + |> List.ofSeq + |> fun l -> List.foldBack(fun o s -> Expr.NewUnionCase(cons, [ converter(o); s ])) l (Expr.NewUnionCase(nil, [])) + |> simplifyExpr + + and getValueConverterForType (ty: Type) = + if ty.IsArray then + fun (v: obj) -> transValueArray(v :?> Array, ty) + elif ty.IsGenericType && ty.GetGenericTypeDefinition() = typedefof<_ list> then + let nil, cons = + let cases = Reflection.FSharpType.GetUnionCases(ty) + let a = cases.[0] + let b = cases.[1] + if a.Name = "Empty" then a, b + else b, a + + fun v -> transValueList (v :?> System.Collections.IEnumerable, ty, nil, cons) + else + fun v -> Expr.Value(v, ty) + + and transValue (v: obj, tyOfValue: Type, expectedTy: Type) = + let converter = getValueConverterForType tyOfValue + let r = converter v + if tyOfValue <> expectedTy then Expr.Coerce(r, expectedTy) + else r + +#if !NO_GENERATIVE + let getFastFuncType (args: list) resultType = + let types = + [| for arg in args -> arg.Type + yield resultType |] + let fastFuncTy = + match List.length args with + | 2 -> typedefof>.MakeGenericType(types) + | 3 -> typedefof>.MakeGenericType(types) + | 4 -> typedefof>.MakeGenericType(types) + | 5 -> typedefof>.MakeGenericType(types) + | _ -> invalidArg "args" "incorrect number of arguments" + fastFuncTy.GetMethod("Adapt") + + let (===) a b = LanguagePrimitives.PhysicalEquality a b + + let traverse f = + let rec fallback e = + match e with + | Let(v, value, body) -> + let fixedValue = f fallback value + let fixedBody = f fallback body + if fixedValue === value && fixedBody === body then + e + else + Expr.LetUnchecked(v, fixedValue, fixedBody) + | ShapeVarUnchecked _ -> e + | ShapeLambdaUnchecked(v, body) -> + let fixedBody = f fallback body + if fixedBody === body then + e + else + Expr.Lambda(v, fixedBody) + | ShapeCombinationUnchecked(shape, exprs) -> + let exprs1 = List.map (f fallback) exprs + if List.forall2 (===) exprs exprs1 then + e + else + RebuildShapeCombinationUnchecked(shape, exprs1) + fun e -> f fallback e + + let rightPipe = <@@ (|>) @@> + let inlineRightPipe expr = + let rec loop expr = traverse loopCore expr + and loopCore fallback orig = + match orig with + | SpecificCall rightPipe (None, _, [operand; applicable]) -> + let fixedOperand = loop operand + match loop applicable with + | Lambda(arg, body) -> + let v = Var("__temp", operand.Type) + let ev = Expr.Var v + + let fixedBody = loop body + Expr.Let(v, fixedOperand, fixedBody.Substitute(fun v1 -> if v1 = arg then Some ev else None)) + | fixedApplicable -> Expr.Application(fixedApplicable, fixedOperand) + | x -> fallback x + loop expr + + + let inlineValueBindings e = + let map = Dictionary(HashIdentity.Reference) + let rec loop expr = traverse loopCore expr + and loopCore fallback orig = + match orig with + | Let(id, (Value(_) as v), body) when not id.IsMutable -> + map.[id] <- v + let fixedBody = loop body + map.Remove(id) |> ignore + fixedBody + | ShapeVarUnchecked v -> + match map.TryGetValue v with + | true, e -> e + | _ -> orig + | x -> fallback x + loop e + + + let optimizeCurriedApplications expr = + let rec loop expr = traverse loopCore expr + and loopCore fallback orig = + match orig with + | Application(e, arg) -> + let e1 = tryPeelApplications e [loop arg] + if e1 === e then + orig + else + e1 + | x -> fallback x + and tryPeelApplications orig args = + let n = List.length args + match orig with + | Application(e, arg) -> + let e1 = tryPeelApplications e ((loop arg)::args) + if e1 === e then + orig + else + e1 + | Let(id, applicable, (Lambda(_) as body)) when n > 0 -> + let numberOfApplication = countPeelableApplications body id 0 + if numberOfApplication = 0 then orig + elif n = 1 then Expr.Application(applicable, List.head args) + elif n <= 5 then + let resultType = + applicable.Type + |> Seq.unfold (fun t -> + if not t.IsGenericType then None else + let args = t.GetGenericArguments() + if args.Length <> 2 then None else + Some (args.[1], args.[1]) + ) + |> Seq.toArray + |> (fun arr -> arr.[n - 1]) + + let adaptMethod = getFastFuncType args resultType + let adapted = Expr.Call(adaptMethod, [loop applicable]) + let invoke = adapted.Type.GetMethod("Invoke", [| for arg in args -> arg.Type |]) + Expr.Call(adapted, invoke, args) + else + (applicable, args) ||> List.fold (fun e a -> Expr.Application(e, a)) + | _ -> + orig + and countPeelableApplications expr v n = + match expr with + // v - applicable entity obtained on the prev step + // \arg -> let v1 = (f arg) in rest ==> f + | Lambda(arg, Let(v1, Application(Var f, Var arg1), rest)) when v = f && arg = arg1 -> countPeelableApplications rest v1 (n + 1) + // \arg -> (f arg) ==> f + | Lambda(arg, Application(Var f, Var arg1)) when v = f && arg = arg1 -> n + | _ -> n + loop expr +#endif + + member __.TranslateExpression q = simplifyExpr q + + member __.TranslateQuotationToCode qexprf (paramNames: string[]) (argExprs: Expr[]) = + // Use the real variable names instead of indices, to improve output of Debug.fs + // Add let bindings for arguments to ensure that arguments will be evaluated + let varDecisions = argExprs |> Array.mapi (fun i e -> match e with Var v when v.Name = paramNames.[i] -> false, v | _ -> true, Var(paramNames.[i], e.Type)) + let vars = varDecisions |> Array.map snd + let expr = qexprf ([for v in vars -> Expr.Var v]) + + let pairs = Array.zip argExprs varDecisions + let expr = Array.foldBack (fun (arg, (replace, var)) e -> if replace then Expr.LetUnchecked(var, arg, e) else e) pairs expr +#if !NO_GENERATIVE + let expr = + if isGenerated then + let e1 = inlineRightPipe expr + let e2 = optimizeCurriedApplications e1 + let e3 = inlineValueBindings e2 + e3 + else + expr +#endif + + simplifyExpr expr + + /// A cross-targeting type provider must ultimately provide quotations and reflection objects w.r.t. + /// the type binding context for the target assembly reference set. + /// + /// To make building a cross-targeting type provider palatable, the type provider is written w.r.t. to + /// homogeneous quotations and reflection objects referring to a copy of the target runtime constructs held + /// in the design-time assembly itself. These are then systematically remapped (replaced/translated) to the + /// corresponding reflection objects in the target assembly reference set. + /// + /// The ProvidedTypesContext acts as a way of creating provided objects where the replacement is automatically and + /// systematically applied. + + + /// Represents the type binding context for the type provider based on the set of assemblies + /// referenced by the compilation. + type ProvidedTypesContext(referencedAssemblyPaths: string list, assemblyReplacementMap: (string*string) list, sourceAssemblies: Assembly list) as this = + + // A duplicate 'mscorlib' appears in the paths reported by the F# compiler + let referencedAssemblyPaths = referencedAssemblyPaths |> Seq.distinctBy Path.GetFileNameWithoutExtension |> Seq.toList + //do System.Diagnostics.Debugger.Break() + + /// Find which assembly defines System.Object etc. + let systemRuntimeScopeRef = + lazy + referencedAssemblyPaths |> List.tryPick (fun path -> + try + let simpleName = Path.GetFileNameWithoutExtension path + if simpleName = "mscorlib" || simpleName = "System.Runtime" || simpleName = "netstandard" || simpleName = "System.Private.CoreLib" then + let reader = ILModuleReaderAfterReadingAllBytes (path, mkILGlobals EcmaMscorlibScopeRef) + let mdef = reader.ILModuleDef + match mdef.TypeDefs.TryFindByName(USome "System", "Object") with + | None -> None + | Some _ -> + let m = mdef.ManifestOfAssembly + let assRef = ILAssemblyRef(m.Name, UNone, (match m.PublicKey with USome k -> USome (PublicKey.KeyAsToken(k)) | UNone -> UNone), m.Retargetable, m.Version, m.Locale) + Some (ILScopeRef.Assembly assRef) + else + None + with _ -> None ) + |> function + | None -> EcmaMscorlibScopeRef // failwith "no reference to mscorlib.dll or System.Runtime.dll or netstandard.dll found" + | Some r -> r + + let fsharpCoreRefVersion = + lazy + referencedAssemblyPaths |> List.tryPick (fun path -> + try + let simpleName = Path.GetFileNameWithoutExtension path + if simpleName = "FSharp.Core" then + let reader = ILModuleReaderAfterReadingAllBytes (path, mkILGlobals (systemRuntimeScopeRef.Force())) + match reader.ILModuleDef.Manifest with + | Some m -> match m.Version with USome v -> Some v | UNone -> None + | None -> None + else + None + with _ -> None ) + |> function + | None -> typeof.Assembly.GetName().Version // failwith "no reference to FSharp.Core found" + | Some r -> r + + let ilGlobals = + lazy mkILGlobals (systemRuntimeScopeRef.Force()) + + let mkReader ref = + try let reader = ILModuleReaderAfterReadingAllBytes(ref, ilGlobals.Force()) + Choice1Of2(TargetAssembly(ilGlobals.Force(), this.TryBindILAssemblyRefToTgt, Some reader, ref, ProvidedTypeBuilder.typeBuilder) :> Assembly) + with err -> Choice2Of2 err + + let targetAssembliesTable_ = ConcurrentDictionary>() + let targetAssemblies_ = ResizeArray() + let targetAssembliesQueue = ResizeArray<_>() + do targetAssembliesQueue.Add (fun () -> + for ref in referencedAssemblyPaths do + let reader = mkReader ref + let simpleName = Path.GetFileNameWithoutExtension ref + targetAssembliesTable_.[simpleName] <- reader + match reader with + | Choice2Of2 _ -> () + | Choice1Of2 asm -> targetAssemblies_.Add asm) + let flush() = + let qs = targetAssembliesQueue.ToArray() + targetAssembliesQueue.Clear() + for q in qs do q() + let getTargetAssemblies() = flush(); targetAssemblies_ + let getTargetAssembliesTable() = flush(); targetAssembliesTable_ + + let tryBindTargetAssemblySimple(simpleName:string): Choice = + let table = getTargetAssembliesTable() + if table.ContainsKey(simpleName) then table.[simpleName] + else Choice2Of2 (Exception(sprintf "assembly %s not found" simpleName)) + + let sourceAssembliesTable_ = ConcurrentDictionary() + let sourceAssemblies_ = ResizeArray<_>() + let sourceAssembliesQueue = ResizeArray<_>() + + let enqueueReferencedAssemblies(asm: Assembly) = + do sourceAssembliesQueue.Add (fun () -> + [| for referencedAssemblyName in asm.GetReferencedAssemblies() do + let referencedAssembly = try Assembly.Load(referencedAssemblyName) with _ -> null + if not (isNull referencedAssembly) then + yield referencedAssembly |]) + + do sourceAssembliesQueue.Add (fun () -> List.toArray sourceAssemblies) + + let getSourceAssemblies() = + while sourceAssembliesQueue.Count > 0 do + let qs = sourceAssembliesQueue.ToArray() + sourceAssembliesQueue.Clear() + for q in qs do + for asm in q() do + let simpleName = asm.GetName().Name + if not (sourceAssembliesTable_.ContainsKey(simpleName)) then + sourceAssembliesTable_.[simpleName] <- asm + sourceAssemblies_.Add asm + // Find the transitive closure of all referenced assemblies + enqueueReferencedAssemblies asm + + sourceAssemblies_ + + /// When translating quotations, Expr.Var's are translated to new variable respecting reference equality. + let varTableFwd = Dictionary() + let varTableBwd = Dictionary() + let assemblyTableFwd = Dictionary() + let typeTableFwd = Dictionary() + let typeTableBwd = Dictionary() + + let fixName (fullName:string) = + if fullName.StartsWith("FSI_") then + // when F# Interactive is the host of the design time assembly, + // all namespaces are prefixed with FSI_, in the runtime assembly + // the name won't have that prefix + fullName.Substring(fullName.IndexOf('.') + 1) + else + fullName + + let tryGetTypeFromAssembly toTgt (originalAssemblyName:string) fullName (asm:Assembly) = + // if the original assembly of the type being replaced is in `assemblyReplacementMap`, + // then we only map it to assemblies with a name specified in `assemblyReplacementMap` + let restrictedAndMatching = + assemblyReplacementMap + |> Seq.exists (fun (originalName:string, newName:string) -> + originalAssemblyName.StartsWith originalName && not (asm.FullName.StartsWith(newName))) + + // Check if the assembly can be queried for types yet. Cross-assembly recursive linking back to generated assemblies + // is not supported in some cases where recursive linking is needed during the process of generation itself. + let canQuery = (match asm with :? TargetAssembly as t -> t.Reader.IsSome | _ -> true) + + if not canQuery then None + elif restrictedAndMatching then None + elif asm.FullName.StartsWith "FSI-ASSEMBLY" then + // when F# Interactive is the host of the design time assembly, + // for each type in the runtime assembly there might be multiple + // versions (FSI_0001.FullTypeName, FSI_0002.FullTypeName, etc). + // Get the last one. + asm.GetTypes() + |> Seq.filter (fun t -> fixName t.FullName = fullName) + |> Seq.sortBy (fun t -> t.FullName) + |> Seq.toList + |> function [] -> None | xs -> Some (Seq.last xs, false) + else + asm.GetType fullName |> function null -> None | x -> Some (x, true) + + let typeBuilder = ProvidedTypeBuilder.typeBuilder + let rec convTypeRef toTgt (t:Type) = + let table = (if toTgt then typeTableFwd else typeTableBwd) + match table.TryGetValue(t) with + | true, newT -> newT + | false, _ -> + match t with + | :? ProvidedTypeDefinition as ptd when toTgt -> + if ptd.IsErased && ptd.BelongsToTargetModel then failwithf "unexpected erased target ProvidedTypeDefinition '%O'" ptd + // recursively get the provided type. + convTypeDefToTgt t + + | _ -> + let asms = (if toTgt then getTargetAssemblies() else getSourceAssemblies()) + let fullName = fixName t.FullName + + // TODO: this linear search through all available source/target assemblies feels as if it must be too slow in some cases. + // However, we store type translations in various tables (typeTableFwd and typeTableBwd) so perhaps it is not a problem + let rec loop i = + if i < 0 then + let msg = + if toTgt then sprintf "The design-time type '%O' utilized by a type provider was not found in the target reference assembly set '%A'. You may be referencing a profile which contains fewer types than those needed by the type provider you are using." t (getTargetAssemblies() |> Seq.toList) + elif getSourceAssemblies() |> Seq.length = 0 then sprintf "A failure occured while determining compilation references" + else sprintf "The target type '%O' utilized by a type provider was not found in the design-time assembly set '%A'. Please report this problem to the project site for the type provider." t (getSourceAssemblies() |> Seq.toList) + failwith msg + else + match tryGetTypeFromAssembly toTgt t.Assembly.FullName fullName asms.[i] with + | Some (newT, canSave) -> + if canSave then table.[t] <- newT + newT + | None -> loop (i - 1) + loop (asms.Count - 1) + + and convType toTgt (t:Type) = + let table = (if toTgt then typeTableFwd else typeTableBwd) + match table.TryGetValue(t) with + | true, newT -> newT + | false, _ -> + if t :? ProvidedTypeSymbol && (t :?> ProvidedTypeSymbol).IsFSharpTypeAbbreviation then t + // Types annotated with units-of-measure + elif t :? ProvidedTypeSymbol && (t :?> ProvidedTypeSymbol).IsFSharpUnitAnnotated then + let genericType = t.GetGenericTypeDefinition() + let newT = convTypeRef toTgt genericType + let typeArguments = t.GetGenericArguments() |> Array.map (convType toTgt) |> Array.toList + ProvidedMeasureBuilder.AnnotateType (newT, typeArguments) + elif t.IsGenericType && not t.IsGenericTypeDefinition then + let genericType = t.GetGenericTypeDefinition() + let newT = convTypeRef toTgt genericType + let typeArguments = t.GetGenericArguments() |> Array.map (convType toTgt) + typeBuilder.MakeGenericType(newT,typeArguments) + elif t.IsGenericParameter then t + elif t.IsArray || t.IsByRef || t.IsPointer then + let elemType = t.GetElementType() + let elemTypeT = convType toTgt elemType + if t.IsArray then + let rank = t.GetArrayRank() + if rank = 1 then typeBuilder.MakeArrayType(elemTypeT) else typeBuilder.MakeRankedArrayType(elemTypeT,t.GetArrayRank()) + elif t.IsByRef then typeBuilder.MakeByRefType(elemTypeT) + else typeBuilder.MakePointerType(elemTypeT) + + else + convTypeRef toTgt t + + and convTypeToTgt ty = convType true ty + and convTypeToSrc ty = convType false ty + + and convPropertyRefToTgt (p: PropertyInfo) = + Debug.Assert((match p with :? ProvidedProperty as x -> not x.BelongsToTargetModel | _ -> true), "unexpected target ProvidedProperty") + let t = convTypeToTgt p.DeclaringType + let bindingFlags = bindSome p.IsStatic + let pT = t.GetProperty(p.Name, bindingFlags) + if isNull pT then failwithf "Property '%O' of type '%O' not found. This property may be missing in the types available in the target assemblies." p t + Debug.Assert((match pT with :? ProvidedProperty as x -> x.BelongsToTargetModel | _ -> true), "expected a target ProvidedProperty") + pT + + and convFieldRefToTgt (f: FieldInfo) = + Debug.Assert((match f with :? ProvidedField as x -> not x.BelongsToTargetModel | _ -> true), "unexpected target ProvidedField") + let t = convTypeToTgt f.DeclaringType + let fT = t.GetField(f.Name, bindSome f.IsStatic) + if isNull fT then failwithf "Field '%O' of type '%O' not found. This field may be missing in the types available in the target assemblies." f t + Debug.Assert((match fT with :? ProvidedField as x -> x.BelongsToTargetModel | _ -> true), "expected a target ProvidedField") + fT + + and convMethodRefToTgt (m: MethodInfo) = + Debug.Assert((match m with :? ProvidedMethod as x -> not x.BelongsToTargetModel | _ -> true), "unexpected target ProvidedMethod") + //Debug.Assert (m.Name <> "get_Item1" || m.DeclaringType.Name <> "Tuple`2") + let declTyT = convTypeToTgt m.DeclaringType + let mT = + if m.IsGenericMethod then + let genericMethod = m.GetGenericMethodDefinition() + let parameterTypesT = genericMethod.GetParameters() |> Array.map (fun p -> convTypeToTgt p.ParameterType) + let genericMethodT = declTyT.GetMethod(genericMethod.Name, bindSome m.IsStatic, null, parameterTypesT, null) + if isNull genericMethodT then null else + let typeArgumentsT = m.GetGenericArguments() |> Array.map convTypeToTgt + genericMethodT.MakeGenericMethod(typeArgumentsT) + else + let parameterTypesT = m.GetParameters() |> Array.map (fun p -> convTypeToTgt p.ParameterType) + declTyT.GetMethod(m.Name, bindSome m.IsStatic, null, parameterTypesT, null) + match mT with + | null -> failwithf "Method '%O' not found in type '%O'. This method may be missing in the types available in the target assemblies." m mT + | _ -> + Debug.Assert((match mT with :? ProvidedMethod as x -> x.BelongsToTargetModel | _ -> true), "expected a target ProvidedMethod") + mT + + and tryConvConstructorRefToTgt (cons: ConstructorInfo) = + Debug.Assert((match cons with :? ProvidedConstructor as x -> not x.BelongsToTargetModel | _ -> true), "unexpected target ProvidedConstructor") + let declTyT = convTypeToTgt cons.DeclaringType + let parameterTypesT = cons.GetParameters() |> Array.map (fun p -> convTypeToTgt p.ParameterType) + let flags = + (if cons.IsStatic then BindingFlags.Static else BindingFlags.Instance) + ||| (if cons.IsPublic then BindingFlags.Public else BindingFlags.NonPublic ) + let consT = declTyT.GetConstructor(flags, null,parameterTypesT, null ) + match consT with + | null -> Choice1Of2 (sprintf "Constructor '%O' not found in type '%O'. This constructor may be missing in the types available in the target assemblies." cons declTyT) + | _ -> + Debug.Assert((match consT with :? ProvidedConstructor as x -> x.BelongsToTargetModel | _ -> true), "expected a target ProvidedConstructor") + Choice2Of2 consT + + and convConstructorRefToTgt (cons: ConstructorInfo) = + match tryConvConstructorRefToTgt cons with + | Choice1Of2 err -> failwith err + | Choice2Of2 res -> res + + and convVarToSrc (v: Var) = + match varTableBwd.TryGetValue v with + | true, v -> v + | false, _ -> + let newVar = Var (v.Name, convTypeToSrc v.Type, v.IsMutable) + // store the original var as we'll have to revert to it later + varTableBwd.Add(v, newVar) + varTableFwd.Add(newVar, v) + newVar + + and convVarExprToSrc quotation = + match quotation with + | ShapeVarUnchecked v -> + Expr.Var (convVarToSrc v) + | _ -> failwithf "Unexpected non-variable argument: %A" quotation + + and convVarToTgt (v: Var) = + match varTableFwd.TryGetValue v with + | true, v -> v + | false, _ -> + // It's a variable local to the quotation + let newVar = Var (v.Name, convTypeToTgt v.Type, v.IsMutable) + // store it so we reuse it from now on + varTableFwd.Add(v, newVar) + varTableBwd.Add(newVar, v) + newVar + + + and convExprToTgt quotation = + match quotation with + | Call (obj, m, args) -> + let mR = convMethodRefToTgt m + let argsR = List.map convExprToTgt args + match obj with + | Some obj -> Expr.CallUnchecked (convExprToTgt obj, mR, argsR) + | None -> Expr.CallUnchecked (mR, argsR) + | PropertyGet (obj, p, indexArgs) -> + let pR = convPropertyRefToTgt p + let indexArgsR = List.map convExprToTgt indexArgs + match obj with + | Some obj -> Expr.PropertyGetUnchecked (convExprToTgt obj, pR, indexArgsR) + | None -> Expr.PropertyGetUnchecked (pR, indexArgsR) + | PropertySet (obj, p, indexArgs, value) -> + let pR = convPropertyRefToTgt p + let indexArgsR = List.map convExprToTgt indexArgs + match obj with + | Some obj -> Expr.PropertySetUnchecked (convExprToTgt obj, pR, convExprToTgt value, indexArgsR) + | None -> Expr.PropertySetUnchecked (pR, convExprToTgt value, indexArgsR) + | NewObject (c, exprs) -> + let exprsR = List.map convExprToTgt exprs + Expr.NewObjectUnchecked (convConstructorRefToTgt c, exprsR) + | DefaultValue (t) -> + Expr.DefaultValue (convTypeToTgt t) + | Coerce (expr, t) -> + Expr.Coerce (convExprToTgt expr, convTypeToTgt t) + | TypeTest (expr, t) -> + Expr.TypeTest (convExprToTgt expr, convTypeToTgt t) + | TryWith (body, filterVar, filterBody, catchVar, catchBody) -> + Expr.TryWith (convExprToTgt body, convVarToTgt filterVar, convExprToTgt filterBody, convVarToTgt catchVar, convExprToTgt catchBody) + | TryFinally (body, compensation) -> + Expr.TryFinally (convExprToTgt body, convExprToTgt compensation) + | NewArray (t, exprs) -> + Expr.NewArrayUnchecked (convTypeToTgt t, List.map convExprToTgt exprs) + | NewTuple (exprs) -> + Expr.NewTuple (List.map convExprToTgt exprs) + | Lambda (v, expr) -> + Expr.Lambda (convVarToTgt v, convExprToTgt expr) + | TupleGet (expr, i) -> + Expr.TupleGetUnchecked (convExprToTgt expr, i) + | NewDelegate (t, vars, expr) -> + Expr.NewDelegateUnchecked (convTypeToTgt t, List.map convVarToTgt vars, convExprToTgt expr) + | FieldGet (obj, f) -> + match obj with + | Some obj -> Expr.FieldGetUnchecked (convExprToTgt obj, convFieldRefToTgt f) + | None -> Expr.FieldGetUnchecked (convFieldRefToTgt f) + | FieldSet (obj, f, value) -> + match obj with + | Some obj -> Expr.FieldSetUnchecked (convExprToTgt obj, convFieldRefToTgt f, convExprToTgt value) + | None -> Expr.FieldSetUnchecked (convFieldRefToTgt f, convExprToTgt value) + | Let (var, value, body) -> + Expr.LetUnchecked(convVarToTgt var, convExprToTgt value, convExprToTgt body) + + // Eliminate some F# constructs which do not cross-target well + | Application(f, e) -> + convExprToTgt (Expr.CallUnchecked(f, f.Type.GetMethod "Invoke", [ e ]) ) + | NewUnionCase(ci, es) -> + convExprToTgt (Expr.CallUnchecked(Reflection.FSharpValue.PreComputeUnionConstructorInfo ci, es) ) + | NewRecord(ci, es) -> + convExprToTgt (Expr.NewObjectUnchecked(FSharpValue.PreComputeRecordConstructorInfo ci, es) ) + | UnionCaseTest(e, uc) -> + let tagInfo = FSharpValue.PreComputeUnionTagMemberInfo uc.DeclaringType + let tagExpr = + match tagInfo with + | :? PropertyInfo as tagProp -> Expr.PropertyGetUnchecked(e, tagProp) + | :? MethodInfo as tagMeth -> + if tagMeth.IsStatic then Expr.CallUnchecked(tagMeth, [e]) + else Expr.CallUnchecked(e, tagMeth, []) + | _ -> failwith "unreachable: unexpected result from PreComputeUnionTagMemberInfo" + let tagNumber = uc.Tag + convExprToTgt <@@ (%%(tagExpr): int) = tagNumber @@> + + | Value (obj, ty) -> + match obj with + | :? Type as vty -> Expr.Value(convTypeToTgt vty, ty) + | _ -> Expr.Value(obj, convTypeToTgt ty) + + // Traverse remaining constructs + | ShapeVarUnchecked v -> + Expr.Var (convVarToTgt v) + | ShapeLambdaUnchecked _ as d -> + failwithf "It's not possible to use construct %O when cross targetting to a different FSharp.Core. Make sure you're not calling a function with signature A->(B->C) instead of A->B->C (using |> causes this)." d + | ShapeCombinationUnchecked (o, exprs) -> + RebuildShapeCombinationUnchecked (o, List.map convExprToTgt exprs) + + and convCodeToTgt (codeFun: Expr list -> Expr, isStatic, isCtor, parameters: ProvidedParameter[], isGenerated) = + (fun argsT -> + // argsT: the target arg expressions coming from host tooling. Includes "this" for instance methods and generative constructors. + // parameters: the (source) parameters specific by the TPDTC. Does not include "this" + // paramNames: equal in length to argsT. The preferred named for the parameters. Seems to include "this" for instance methods and generative constructors. + let args = List.map convVarExprToSrc argsT + let paramNames = + // https://github.com/fsprojects/SwaggerProvider/blob/cfb7a665fada77fd0200591f62faba0ba44e172c/src/SwaggerProvider.DesignTime/SwaggerProviderConfig.fs#L79 + // "Erased constructors should not pass the instance as the first argument when calling invokeCode!" + // "Generated constructors should always pass the instance as the first argument when calling invokeCode!" + [| if not isStatic && (not isCtor || isGenerated) then yield "this" + for p in parameters do yield p.Name |] + let code2 = QuotationSimplifier(isGenerated).TranslateQuotationToCode codeFun paramNames (Array.ofList args) + let codeT = convExprToTgt code2 + codeT) + + and convBaseCallToTgt (codeFun: Expr list -> ConstructorInfo * Expr list, isGenerated) = + (fun argsT -> + let args = List.map convVarExprToSrc argsT + let ctor, argExprs = codeFun args + let argExprs2 = List.map (QuotationSimplifier(isGenerated).TranslateExpression) argExprs + //let code2 = QuotationSimplifier(false).TranslateQuotationToCode code paramNames + let ctorT = convConstructorRefToTgt ctor + let codeT = List.map convExprToTgt argExprs2 + ctorT, codeT) + + and convMemberRefToTgt (x: MemberInfo) = + match x with + | :? PropertyInfo as p -> convPropertyRefToTgt p :> MemberInfo + | :? FieldInfo as p -> convFieldRefToTgt p :> MemberInfo + | :? MethodInfo as p -> convMethodRefToTgt p :> MemberInfo + | :? ConstructorInfo as p -> convConstructorRefToTgt p :> MemberInfo + | :? Type as p -> convTypeToTgt p :> MemberInfo + | _ -> failwith "unknown member info" + + and convCustomAttributesTypedArg (x: CustomAttributeTypedArgument) = + CustomAttributeTypedArgument(convTypeToTgt x.ArgumentType, x.Value) + + and convCustomAttributesNamedArg (x: CustomAttributeNamedArgument) = + CustomAttributeNamedArgument(convMemberRefToTgt x.MemberInfo, convCustomAttributesTypedArg x.TypedValue) + + and tryConvCustomAttributeDataToTgt (x: CustomAttributeData) = + // Allow a fail on AllowNullLiteralAttribute. Some downlevel FSharp.Core don't have this. + // In this case just skip the attribute which means null is allowed when targeting downlevel FSharp.Core. + match tryConvConstructorRefToTgt x.Constructor with + | Choice1Of2 _ when x.Constructor.DeclaringType.Name = typeof.Name -> None + | Choice1Of2 msg -> failwith msg + | Choice2Of2 res -> + Some + { new CustomAttributeData () with + member __.Constructor = res + member __.ConstructorArguments = [| for arg in x.ConstructorArguments -> convCustomAttributesTypedArg arg |] :> IList<_> + member __.NamedArguments = [| for arg in x.NamedArguments -> convCustomAttributesNamedArg arg |] :> IList<_> } + + and convCustomAttributesDataToTgt (cattrs: IList) = + cattrs |> Array.ofSeq |> Array.choose tryConvCustomAttributeDataToTgt + + and convProvidedTypeDefToTgt (x: ProvidedTypeDefinition) = + if x.IsErased && x.BelongsToTargetModel then failwithf "unexpected target type definition '%O'" x + match typeTableFwd.TryGetValue(x) with + | true, newT -> (newT :?> ProvidedTypeDefinition) + | false, _ -> + let container = + match x.Container with + | TypeContainer.Namespace(assemf, nm) -> + TypeContainer.Namespace((fun () -> + match assemf() with + | :? ProvidedAssembly as assembly -> convProvidedAssembly assembly + | assembly -> + assemblyReplacementMap + |> Seq.tryPick (fun (originalName, newName) -> + if assembly.GetName().Name = originalName then + match this.TryBindSimpleAssemblyNameToTarget(newName) with + | Choice1Of2 replacementAssembly -> Some replacementAssembly + | Choice2Of2 _ -> None + else + None) + |> function None -> assembly | Some replacementAssembly -> replacementAssembly + ), nm) + | c -> c // nested types patched below + + // Create the type definition with contents mapped to the target + // Use a 'let rec' to allow access to the target as the declaring + // type of the contents in a delayed way. + let rec xT : ProvidedTypeDefinition = + let mutable methodsIdx = 0 + let checkFreshMethods() = + x.CountMembersFromCursor(methodsIdx) > 0 + + let getFreshMethods() = + let vs, idx2 = x.GetMembersFromCursor(methodsIdx) + methodsIdx <- idx2 + vs |> Array.map (convMemberDefToTgt xT) + + let mutable interfacesIdx = 0 + let getFreshInterfaces() = + let vs, idx2 = x.GetInterfaceImplsFromCursor(interfacesIdx) + interfacesIdx <- idx2 + vs |> Array.map convTypeToTgt + + let mutable overridesIdx = 0 + let getFreshMethodOverrides() = + let vs, idx2 = x.GetMethodOverridesFromCursor(overridesIdx) + overridesIdx <- idx2 + vs |> Array.map (fun (a, b) -> (convMethodRefToTgt a :?> ProvidedMethod), convMethodRefToTgt b) + + let backingDataSource = Some (checkFreshMethods, getFreshMethods, getFreshInterfaces, getFreshMethodOverrides) + + ProvidedTypeDefinition(true, container, x.Name, + (x.BaseTypeRaw >> Option.map convTypeToTgt), + x.AttributesRaw, + (x.EnumUnderlyingTypeRaw >> Option.map convTypeToTgt), + x.StaticParams |> List.map convStaticParameterDefToTgt, + x.StaticParamsApply |> Option.map (fun f s p -> + let t = f s p + let tT = convProvidedTypeDefToTgt t + tT), + backingDataSource, + (x.GetCustomAttributesData >> convCustomAttributesDataToTgt), + x.NonNullable, + x.HideObjectMethods, ProvidedTypeBuilder.typeBuilder) + + Debug.Assert(not (typeTableFwd.ContainsKey(x))) + typeTableFwd.[x] <- xT + if x.IsNested then + let parentT = (convTypeToTgt x.DeclaringType :?> ProvidedTypeDefinition) + parentT.PatchDeclaringTypeOfMember xT + xT + + and convTypeDefToTgt (x: Type) = + match x with + | :? ProvidedTypeDefinition as x -> convProvidedTypeDefToTgt x :> Type + | _ -> x + + and convParameterDefToTgt (x: ProvidedParameter) = + Debug.Assert (not x.BelongsToTargetModel, "unexpected target ProvidedParameter") + ProvidedParameter(true, x.Name, x.Attributes, + x.ParameterType |> convTypeToTgt, + x.OptionalValue, + (x.GetCustomAttributesData >> convCustomAttributesDataToTgt)) + + and convStaticParameterDefToTgt (x: ProvidedStaticParameter) = + Debug.Assert (not x.BelongsToTargetModel, "unexpected target ProvidedStaticParameter") + ProvidedStaticParameter(x.Name, convTypeToTgt x.ParameterType, ?parameterDefaultValue=x.ParameterDefaultValue) + + and convMemberDefToTgt declTyT (x: MemberInfo) = + let xT : MemberInfo = + match x with + | :? ProvidedField as x -> + Debug.Assert (not x.BelongsToTargetModel, "unexpected target ProvidedField") + ProvidedField(true, x.Name, x.Attributes, + x.FieldType |> convTypeToTgt, + x.GetRawConstantValue(), + (x.GetCustomAttributesData >> convCustomAttributesDataToTgt)) :> _ + | :? ProvidedProperty as x -> + Debug.Assert (not x.BelongsToTargetModel, "unexpected target ProvidedProperty") + ProvidedProperty(true, x.Name, x.Attributes, + x.PropertyType |> convTypeToTgt, + x.IsStatic, + x.Getter |> Option.map (fun f -> f >> convMethodRefToTgt), + x.Setter |> Option.map (fun f -> f >> convMethodRefToTgt), + x.IndexParameters |> Array.map convParameterDefToTgt, + (x.GetCustomAttributesData >> convCustomAttributesDataToTgt)) :> _ + | :? ProvidedEvent as x -> + Debug.Assert (not x.BelongsToTargetModel, "unexpected target ProvidedEvent") + ProvidedEvent(true, x.Name, x.Attributes, + x.EventHandlerType |> convTypeToTgt, + x.IsStatic, + (fun () -> convMethodRefToTgt x.Adder), + (fun () -> convMethodRefToTgt x.Remover), + (x.GetCustomAttributesData >> convCustomAttributesDataToTgt)) :> _ + | :? ProvidedConstructor as x -> + Debug.Assert (not x.BelongsToTargetModel, "unexpected target ProvidedConstructor") + ProvidedConstructor(true, x.Attributes, + x.Parameters |> Array.map convParameterDefToTgt, + convCodeToTgt (x.GetInvokeCode, x.IsStatic, true, x.Parameters, not x.IsErased), + (match x.BaseCall with None -> None | Some f -> Some (convBaseCallToTgt(f, not x.IsErased))), + x.IsImplicitConstructor, + (x.GetCustomAttributesData >> convCustomAttributesDataToTgt)) :> _ + | :? ProvidedMethod as x -> + Debug.Assert (not x.BelongsToTargetModel, "unexpected target ProvidedMethod") + ProvidedMethod(true, x.Name, x.Attributes, + x.Parameters |> Array.map convParameterDefToTgt, + x.ReturnType |> convTypeToTgt, + x.GetInvokeCode |> Option.map (fun invokeCode -> convCodeToTgt (invokeCode, x.IsStatic, false, x.Parameters, not x.IsErased)), + x.StaticParams |> List.map convStaticParameterDefToTgt, + x.StaticParamsApply |> Option.map (fun f s p -> f s p |> convProvidedMethodDefToTgt declTyT), + (x.GetCustomAttributesData >> convCustomAttributesDataToTgt)) :> _ + | :? ProvidedTypeDefinition as x -> convTypeDefToTgt x :> _ + | _ -> failwith "unknown member type" + Debug.Assert(declTyT.BelongsToTargetModel) + declTyT.PatchDeclaringTypeOfMember xT + Debug.Assert(xT.DeclaringType :? ProvidedTypeDefinition) + Debug.Assert((xT.DeclaringType :?> ProvidedTypeDefinition).BelongsToTargetModel) + xT + + and convProvidedMethodDefToTgt declTyT (x: ProvidedMethod) = + convMemberDefToTgt declTyT x :?> ProvidedMethod + + and convProvidedAssembly (assembly: ProvidedAssembly) = + match assemblyTableFwd.TryGetValue(assembly) with + | true, newT -> newT + | false, _ -> + let tgtAssembly = ProvidedAssembly(true, assembly.GetName(), assembly.Location, K(convCustomAttributesDataToTgt(assembly.GetCustomAttributesData()))) + + for (types, enclosingGeneratedTypeNames) in assembly.GetTheTypes() do + let typesT = Array.map convProvidedTypeDefToTgt types + tgtAssembly.AddTheTypes (typesT, enclosingGeneratedTypeNames) + + assemblyTableFwd.Add(assembly, tgtAssembly) + this.AddSourceAssembly(assembly) + this.AddTargetAssembly(assembly.GetName(), tgtAssembly) + (tgtAssembly :> Assembly) + + let rec convNamespaceToTgt (x: IProvidedNamespace) = + { new IProvidedNamespace with + member __.GetNestedNamespaces() = Array.map convNamespaceToTgt (x.GetNestedNamespaces()) + member __.NamespaceName = x.NamespaceName + member __.GetTypes() = Array.map convTypeDefToTgt (x.GetTypes()) + member __.ResolveTypeName typeName = convTypeDefToTgt (x.ResolveTypeName typeName) } + + /// Gets the equivalent target method + member __.ConvertSourceMethodRefToTarget t = convMethodRefToTgt t + + /// Gets the equivalent target constructor + member __.ConvertSourceConstructorRefToTarget t = convConstructorRefToTgt t + + /// Gets the equivalent target type + member __.ConvertSourceTypeToTarget t = convTypeToTgt t + + member __.ConvertTargetTypeToSource t = convTypeToSrc t + + member __.ConvertSourceExprToTarget e = convExprToTgt e + + member __.ConvertSourceNamespaceToTarget ns = convNamespaceToTgt ns + + member __.ConvertSourceProvidedTypeDefinitionToTarget ptd = convProvidedTypeDefToTgt ptd + + member __.TryBindILAssemblyRefToTgt(aref: ILAssemblyRef): Choice = tryBindTargetAssemblySimple(aref.Name) + + member __.TryBindAssemblyNameToTarget(aref: AssemblyName): Choice = tryBindTargetAssemblySimple(aref.Name) + + member __.TryBindSimpleAssemblyNameToTarget(assemblyName: string) = tryBindTargetAssemblySimple(assemblyName) + + member __.ILGlobals = ilGlobals.Value + + member __.ReferencedAssemblyPaths = referencedAssemblyPaths + + member __.GetTargetAssemblies() = getTargetAssemblies().ToArray() + + member __.GetSourceAssemblies() = getSourceAssemblies().ToArray() + + member __.FSharpCoreAssemblyVersion = fsharpCoreRefVersion.Force() + + member this.ReadRelatedAssembly(fileName) = + let ilg = ilGlobals.Force() + let reader = ILModuleReaderAfterReadingAllBytes(fileName, ilg) + TargetAssembly(ilg, this.TryBindILAssemblyRefToTgt, Some reader, fileName, ProvidedTypeBuilder.typeBuilder) :> Assembly + + member this.ReadRelatedAssembly(bytes:byte[]) = + let fileName = "file.dll" + let ilg = ilGlobals.Force() + let is = ByteFile(bytes) + let pe = PEReader(fileName, is) + let mdchunk = bytes.[pe.MetadataPhysLoc .. pe.MetadataPhysLoc + pe.MetadataSize - 1] + let mdfile = ByteFile(mdchunk) + let reader = ILModuleReader(fileName, mdfile, ilg, true) + TargetAssembly(ilg, this.TryBindILAssemblyRefToTgt, Some reader, fileName, ProvidedTypeBuilder.typeBuilder) :> Assembly + + member __.AddSourceAssembly(asm: Assembly) = + sourceAssembliesQueue.Add (fun () -> [| asm |]) + + member __.AddTargetAssembly(asmName: AssemblyName, asm: Assembly) = + targetAssembliesQueue.Add (fun () -> + targetAssembliesTable_.[asmName.Name] <- Choice1Of2 asm + targetAssemblies_.Add asm) + + static member Create (config: TypeProviderConfig, assemblyReplacementMap, sourceAssemblies) = + + // Use the reflection hack to determine the set of referenced assemblies by reflecting over the SystemRuntimeContainsType + // closure in the TypeProviderConfig object. + let referencedAssemblyPaths = config.ReferencedAssemblies |> Array.toList + ProvidedTypesContext(referencedAssemblyPaths, assemblyReplacementMap, sourceAssemblies) + + + +#if !NO_GENERATIVE + +namespace ProviderImplementation.ProvidedTypes + + #nowarn "1182" + module BinaryWriter = + + open System + open System.Diagnostics + open System.IO + open System.Collections.Concurrent + open System.Collections.Generic + open System.Reflection + open System.Text + + open Microsoft.FSharp.Quotations + open Microsoft.FSharp.Quotations.DerivedPatterns + open Microsoft.FSharp.Quotations.Patterns + open Microsoft.FSharp.Quotations.ExprShape + open Microsoft.FSharp.Core.CompilerServices + open Microsoft.FSharp.Reflection + + open ProviderImplementation.ProvidedTypes + open ProviderImplementation.ProvidedTypes.AssemblyReader + open ProviderImplementation.ProvidedTypes.UncheckedQuotations + + let formatCodeLabel (x:int) = "L"+string x + + let emitBytesViaBuffer f = let bb = ByteBuffer.Create 10 in f bb; bb.Close() + + /// Alignment and padding + let align alignment n = ((n + alignment - 1) / alignment) * alignment + + //--------------------------------------------------------------------- + // Concrete token representations etc. used in PE files + //--------------------------------------------------------------------- + + + let getUncodedToken (tab:ILTableName) idx = ((tab.Index <<< 24) ||| idx) + + let markerForUnicodeBytes (b:byte[]) = + let len = b.Length + let rec scan i = + i < len/2 && + (let b1 = Bytes.get b (i*2) + let b2 = Bytes.get b (i*2+1) + (b2 <> 0) + || (b1 >= 0x01 && b1 <= 0x08) // as per ECMA and C# + || (b1 >= 0xE && b1 <= 0x1F) // as per ECMA and C# + || (b1 = 0x27) // as per ECMA and C# + || (b1 = 0x2D) // as per ECMA and C# + || (b1 > 0x7F) // as per C# (but ECMA omits this) + || scan (i+1)) + let marker = if scan 0 then 0x01 else 0x00 + marker + + + // -------------------------------------------------------------------- + // Fixups + // -------------------------------------------------------------------- + + /// Check that the data held at a fixup is some special magic value, as a sanity check + /// to ensure the fixup is being placed at a ood location. + let checkFixup32 (data: byte[]) offset exp = + if data.[offset + 3] <> b3 exp then failwith "fixup sanity check failed" + if data.[offset + 2] <> b2 exp then failwith "fixup sanity check failed" + if data.[offset + 1] <> b1 exp then failwith "fixup sanity check failed" + if data.[offset] <> b0 exp then failwith "fixup sanity check failed" + + let applyFixup32 (data:byte[]) offset v = + data.[offset] <- b0 v + data.[offset+1] <- b1 v + data.[offset+2] <- b2 v + data.[offset+3] <- b3 v + + //--------------------------------------------------------------------- + // TYPES FOR TABLES + //--------------------------------------------------------------------- + + module RowElementTags = + let [] UShort = 0 + let [] ULong = 1 + let [] Data = 2 + let [] DataResources = 3 + let [] Guid = 4 + let [] Blob = 5 + let [] String = 6 + let [] SimpleIndexMin = 7 + let SimpleIndex (t: ILTableName) = assert (t.Index <= 112); SimpleIndexMin + t.Index + let [] SimpleIndexMax = 119 + + let [] TypeDefOrRefOrSpecMin = 120 + let TypeDefOrRefOrSpec (t: TypeDefOrRefOrSpecTag) = assert (t.Tag <= 2); TypeDefOrRefOrSpecMin + t.Tag (* + 111 + 1 = 0x70 + 1 = max ILTableName.Tndex + 1 *) + let [] TypeDefOrRefOrSpecMax = 122 + + let [] TypeOrMethodDefMin = 123 + let TypeOrMethodDef (t: TypeOrMethodDefTag) = assert (t.Tag <= 1); TypeOrMethodDefMin + t.Tag (* + 2 + 1 = max TypeDefOrRefOrSpec.Tag + 1 *) + let [] TypeOrMethodDefMax = 124 + + let [] HasConstantMin = 125 + let HasConstant (t: HasConstantTag) = assert (t.Tag <= 2); HasConstantMin + t.Tag (* + 1 + 1 = max TypeOrMethodDef.Tag + 1 *) + let [] HasConstantMax = 127 + + let [] HasCustomAttributeMin = 128 + let HasCustomAttribute (t: HasCustomAttributeTag) = assert (t.Tag <= 21); HasCustomAttributeMin + t.Tag (* + 2 + 1 = max HasConstant.Tag + 1 *) + let [] HasCustomAttributeMax = 149 + + let [] HasFieldMarshalMin = 150 + let HasFieldMarshal (t: HasFieldMarshalTag) = assert (t.Tag <= 1); HasFieldMarshalMin + t.Tag (* + 21 + 1 = max HasCustomAttribute.Tag + 1 *) + let [] HasFieldMarshalMax = 151 + + let [] HasDeclSecurityMin = 152 + let HasDeclSecurity (t: HasDeclSecurityTag) = assert (t.Tag <= 2); HasDeclSecurityMin + t.Tag (* + 1 + 1 = max HasFieldMarshal.Tag + 1 *) + let [] HasDeclSecurityMax = 154 + + let [] MemberRefParentMin = 155 + let MemberRefParent (t: MemberRefParentTag) = assert (t.Tag <= 4); MemberRefParentMin + t.Tag (* + 2 + 1 = max HasDeclSecurity.Tag + 1 *) + let [] MemberRefParentMax = 159 + + let [] HasSemanticsMin = 160 + let HasSemantics (t: HasSemanticsTag) = assert (t.Tag <= 1); HasSemanticsMin + t.Tag (* + 4 + 1 = max MemberRefParent.Tag + 1 *) + let [] HasSemanticsMax = 161 + + let [] MethodDefOrRefMin = 162 + let MethodDefOrRef (t: MethodDefOrRefTag) = assert (t.Tag <= 2); MethodDefOrRefMin + t.Tag (* + 1 + 1 = max HasSemantics.Tag + 1 *) + let [] MethodDefOrRefMax = 164 + + let [] MemberForwardedMin = 165 + let MemberForwarded (t: MemberForwardedTag) = assert (t.Tag <= 1); MemberForwardedMin + t.Tag (* + 2 + 1 = max MethodDefOrRef.Tag + 1 *) + let [] MemberForwardedMax = 166 + + let [] ImplementationMin = 167 + let Implementation (t: ImplementationTag) = assert (t.Tag <= 2); ImplementationMin + t.Tag (* + 1 + 1 = max MemberForwarded.Tag + 1 *) + let [] ImplementationMax = 169 + + let [] CustomAttributeTypeMin = 170 + let CustomAttributeType (t: CustomAttributeTypeTag) = assert (t.Tag <= 3); CustomAttributeTypeMin + t.Tag (* + 2 + 1 = max Implementation.Tag + 1 *) + let [] CustomAttributeTypeMax = 173 + + let [] ResolutionScopeMin = 174 + let ResolutionScope (t: ResolutionScopeTag) = assert (t.Tag <= 4); ResolutionScopeMin + t.Tag (* + 3 + 1 = max CustomAttributeType.Tag + 1 *) + let [] ResolutionScopeMax = 178 + + [] + type RowElement(tag:int32, idx: int32) = + + member __.Tag = tag + member __.Val = idx + + // These create RowElements + let UShort (x:uint16) = RowElement(RowElementTags.UShort, int32 x) + let ULong (x:int32) = RowElement(RowElementTags.ULong, x) + /// Index into cenv.data or cenv.resources. Gets fixed up later once we known an overall + /// location for the data section. flag indicates if offset is relative to cenv.resources. + let Data (x:int, k:bool) = RowElement((if k then RowElementTags.DataResources else RowElementTags.Data ), x) + /// pos. in guid array + let Guid (x:int) = RowElement(RowElementTags.Guid, x) + /// pos. in blob array + let Blob (x:int) = RowElement(RowElementTags.Blob, x) + /// pos. in string array + let StringE (x:int) = RowElement(RowElementTags.String, x) + /// pos. in some table + let SimpleIndex (t, x:int) = RowElement(RowElementTags.SimpleIndex t, x) + let TypeDefOrRefOrSpec (t, x:int) = RowElement(RowElementTags.TypeDefOrRefOrSpec t, x) + let TypeOrMethodDef (t, x:int) = RowElement(RowElementTags.TypeOrMethodDef t, x) + let HasConstant (t, x:int) = RowElement(RowElementTags.HasConstant t, x) + let HasCustomAttribute (t, x:int) = RowElement(RowElementTags.HasCustomAttribute t, x) + let HasFieldMarshal (t, x:int) = RowElement(RowElementTags.HasFieldMarshal t, x) + let HasDeclSecurity (t, x:int) = RowElement(RowElementTags.HasDeclSecurity t, x) + let MemberRefParent (t, x:int) = RowElement(RowElementTags.MemberRefParent t, x) + let HasSemantics (t, x:int) = RowElement(RowElementTags.HasSemantics t, x) + let MethodDefOrRef (t, x:int) = RowElement(RowElementTags.MethodDefOrRef t, x) + let MemberForwarded (t, x:int) = RowElement(RowElementTags.MemberForwarded t, x) + let Implementation (t, x:int) = RowElement(RowElementTags.Implementation t, x) + let CustomAttributeType (t, x:int) = RowElement(RowElementTags.CustomAttributeType t, x) + let ResolutionScope (t, x:int) = RowElement(RowElementTags.ResolutionScope t, x) + + type BlobIndex = int + type StringIndex = int + + let BlobIndex (x:BlobIndex): int = x + let StringIndex (x:StringIndex): int = x + + let inline combineHash x2 acc = 37 * acc + x2 // (acc <<< 6 + acc >>> 2 + x2 + 0x9e3779b9) + + let hashRow (elems:RowElement[]) = + let mutable acc = 0 + for i in 0 .. elems.Length - 1 do + acc <- (acc <<< 1) + elems.[i].Tag + elems.[i].Val + 631 + acc + + let equalRows (elems:RowElement[]) (elems2:RowElement[]) = + if elems.Length <> elems2.Length then false else + let mutable ok = true + let n = elems.Length + let mutable i = 0 + while ok && i < n do + if elems.[i].Tag <> elems2.[i].Tag || elems.[i].Val <> elems2.[i].Val then ok <- false + i <- i + 1 + ok + + + type GenericRow = RowElement[] + + /// This is the representation of shared rows is used for most shared row types. + /// Rows ILAssemblyRef and ILMethodRef are very common and are given their own + /// representations. + [] + type SharedRow(elems: RowElement[], hashCode: int) = + member __.GenericRow = elems + override __.GetHashCode() = hashCode + override __.Equals(obj:obj) = + match obj with + | :? SharedRow as y -> equalRows elems y.GenericRow + | _ -> false + + let SharedRow(elems: RowElement[]) = new SharedRow(elems, hashRow elems) + + /// Special representation: Note, only hashing by name + let AssemblyRefRow(s1, s2, s3, s4, l1, b1, nameIdx, str2, b2) = + let hashCode = hash nameIdx + let genericRow = [| UShort s1; UShort s2; UShort s3; UShort s4; ULong l1; Blob b1; StringE nameIdx; StringE str2; Blob b2 |] + new SharedRow(genericRow, hashCode) + + /// Special representation the computes the hash more efficiently + let MemberRefRow(mrp:RowElement, nmIdx:StringIndex, blobIdx:BlobIndex) = + let hashCode = combineHash (hash blobIdx) (combineHash (hash nmIdx) (hash mrp)) + let genericRow = [| mrp; StringE nmIdx; Blob blobIdx |] + new SharedRow(genericRow, hashCode) + + /// Unshared rows are used for definitional tables where elements do not need to be made unique + /// e.g. ILMethodDef and ILTypeDef. Most tables are like this. We don't precompute a + /// hash code for these rows, and indeed the GetHashCode and Equals should not be needed. + [] + type UnsharedRow(elems: RowElement[]) = + member __.GenericRow = elems + override __.GetHashCode() = hashRow elems + override __.Equals(obj:obj) = + match obj with + | :? UnsharedRow as y -> equalRows elems y.GenericRow + | _ -> false + + + //===================================================================== + //===================================================================== + // IL --> TABLES+CODE + //===================================================================== + //===================================================================== + + // This environment keeps track of how many generic parameters are in scope. + // This lets us translate AbsIL type variable number to IL type variable numbering + type ILTypeWriterEnv = { EnclosingTyparCount: int } + let envForTypeDef (td:ILTypeDef) = { EnclosingTyparCount=td.GenericParams.Length } + let envForMethodRef env (typ:ILType) = { EnclosingTyparCount=(match typ with ILType.Array _ -> env.EnclosingTyparCount | _ -> typ.GenericArgs.Length) } + let envForNonGenericMethodRef _mref = { EnclosingTyparCount=System.Int32.MaxValue } + let envForFieldSpec (fspec:ILFieldSpec) = { EnclosingTyparCount=fspec.EnclosingType.GenericArgs.Length } + let envForOverrideSpec (ospec:ILOverridesSpec) = { EnclosingTyparCount=ospec.EnclosingType.GenericArgs.Length } + + //--------------------------------------------------------------------- + // TABLES + //--------------------------------------------------------------------- + + [] + type MetadataTable<'T> = + { name: string + dict: Dictionary<'T, int> // given a row, find its entry number + mutable rows: ResizeArray<'T> } + member x.Count = x.rows.Count + + static member New(nm, hashEq) = + { name=nm + dict = new Dictionary<_, _>(100, hashEq) + rows= new ResizeArray<_>() } + + member tbl.EntriesAsArray = + tbl.rows.ToArray() + + member tbl.Entries = + tbl.rows.ToArray() |> Array.toList + + member tbl.AddSharedEntry x = + let n = tbl.rows.Count + 1 + tbl.dict.[x] <- n + tbl.rows.Add(x) + n + + member tbl.AddUnsharedEntry x = + let n = tbl.rows.Count + 1 + tbl.rows.Add(x) + n + + member tbl.FindOrAddSharedEntry x = + let mutable res = Unchecked.defaultof<_> + let ok = tbl.dict.TryGetValue(x, &res) + if ok then res + else tbl.AddSharedEntry x + + + /// This is only used in one special place - see further below. + member tbl.SetRowsOfTable (t: _[]) = + tbl.rows <- ResizeArray(t) + let h = tbl.dict + h.Clear() + t |> Array.iteri (fun i x -> h.[x] <- (i+1)) + + member tbl.AddUniqueEntry nm geterr x = + if tbl.dict.ContainsKey x then failwith ("duplicate entry '"+geterr x+"' in "+nm+" table") + else tbl.AddSharedEntry x + + member tbl.GetTableEntry x = tbl.dict.[x] + member tbl.GetTableKeys() = tbl.dict.Keys |> Seq.toArray + + //--------------------------------------------------------------------- + // Keys into some of the tables + //--------------------------------------------------------------------- + + /// We use this key type to help find ILMethodDefs for MethodRefs + type MethodDefKey(tidx:int, garity:int, nm:string, rty:ILType, argtys:ILTypes, isStatic:bool) = + // Precompute the hash. The hash doesn't include the return type or + // argument types (only argument type count). This is very important, since + // hashing these is way too expensive + let hashCode = + hash tidx + |> combineHash (hash garity) + |> combineHash (hash nm) + |> combineHash (hash argtys.Length) + |> combineHash (hash isStatic) + member __.TypeIdx = tidx + member __.GenericArity = garity + member __.Name = nm + member __.ReturnType = rty + member __.ArgTypes = argtys + member __.IsStatic = isStatic + override __.ToString() = sprintf "%A" (tidx, garity, nm, rty, argtys, isStatic) + override __.GetHashCode() = hashCode + override __.Equals(obj:obj) = + match obj with + | :? MethodDefKey as y -> + tidx = y.TypeIdx && + garity = y.GenericArity && + nm = y.Name && + // note: these next two use structural equality on AbstractIL ILType values + rty = y.ReturnType && + argtys = y.ArgTypes && + isStatic = y.IsStatic + | _ -> false + + /// We use this key type to help find ILFieldDefs for FieldRefs + type FieldDefKey(tidx:int, nm:string, ty:ILType) = + // precompute the hash. hash doesn't include the type + let hashCode = hash tidx |> combineHash (hash nm) + member __.TypeIdx = tidx + member __.Name = nm + member __.Type = ty + override __.GetHashCode() = hashCode + override __.Equals(obj:obj) = + match obj with + | :? FieldDefKey as y -> + tidx = y.TypeIdx && + nm = y.Name && + ty = y.Type + | _ -> false + + type PropertyTableKey = PropKey of int (* type. def. idx. *) * string * ILType * ILTypes + type EventTableKey = EventKey of int (* type. def. idx. *) * string + type TypeDefTableKey = TdKey of string list * string uoption * string + + //--------------------------------------------------------------------- + // The Writer Target + //--------------------------------------------------------------------- + + [] + type MetadataTable = + | Shared of MetadataTable + | Unshared of MetadataTable + member t.FindOrAddSharedEntry(x) = match t with Shared u -> u.FindOrAddSharedEntry(x) | Unshared u -> failwithf "FindOrAddSharedEntry: incorrect table kind, u.name = %s" u.name + member t.AddSharedEntry(x) = match t with | Shared u -> u.AddSharedEntry(x) | Unshared u -> failwithf "AddSharedEntry: incorrect table kind, u.name = %s" u.name + member t.AddUnsharedEntry(x) = match t with Unshared u -> u.AddUnsharedEntry(x) | Shared u -> failwithf "AddUnsharedEntry: incorrect table kind, u.name = %s" u.name + member t.GenericRowsOfTable = match t with Unshared u -> u.EntriesAsArray |> Array.map (fun x -> x.GenericRow) | Shared u -> u.EntriesAsArray |> Array.map (fun x -> x.GenericRow) + member t.SetRowsOfSharedTable rows = match t with Shared u -> u.SetRowsOfTable (Array.map SharedRow rows) | Unshared u -> failwithf "SetRowsOfSharedTable: incorrect table kind, u.name = %s" u.name + member t.Count = match t with Unshared u -> u.Count | Shared u -> u.Count + + + [] + type cenv = + { ilg: ILGlobals + emitTailcalls: bool + deterministic: bool + showTimes: bool + desiredMetadataVersion: Version + requiredDataFixups: ResizeArray<(int32 * (int * bool))> + /// References to strings in codestreams: offset of code and a (fixup-location , string token) list) + mutable requiredStringFixups: ResizeArray<(int32 * (int * int)[])> + codeChunks: ByteBuffer + mutable nextCodeAddr: int32 + + // Collected debug information + mutable moduleGuid: byte[] + generatePdb: bool + /// Raw data, to go into the data section + data: ByteBuffer + /// Raw resource data, to go into the data section + resources: ByteBuffer + mutable entrypoint: (bool * int) option + + /// Caches + trefCache: Dictionary + + /// The following are all used to generate unique items in the output + tables: MetadataTable[] + AssemblyRefs: MetadataTable + fieldDefs: MetadataTable + methodDefIdxsByKey: MetadataTable + methodDefIdxs: Dictionary + propertyDefs: MetadataTable + eventDefs: MetadataTable + typeDefs: MetadataTable + guids: MetadataTable + blobs: MetadataTable + strings: MetadataTable + userStrings: MetadataTable + } + member cenv.GetTable (tab:ILTableName) = cenv.tables.[tab.Index] + + + member cenv.AddCode ((reqdStringFixupsOffset, requiredStringFixups), code) = + cenv.requiredStringFixups.Add ((cenv.nextCodeAddr + reqdStringFixupsOffset, requiredStringFixups)) + cenv.codeChunks.EmitBytes code + cenv.nextCodeAddr <- cenv.nextCodeAddr + code.Length + + member cenv.GetCode() = cenv.codeChunks.Close() + + + let FindOrAddSharedRow (cenv:cenv) tbl x = cenv.GetTable(tbl).FindOrAddSharedEntry x + + // Shared rows must be hash-cons'd to be made unique (no duplicates according to contents) + let AddSharedRow (cenv:cenv) tbl x = cenv.GetTable(tbl).AddSharedEntry x + + // Unshared rows correspond to definition elements (e.g. a ILTypeDef or a ILMethodDef) + let AddUnsharedRow (cenv:cenv) tbl (x:UnsharedRow) = cenv.GetTable(tbl).AddUnsharedEntry x + + let metadataSchemaVersionSupportedByCLRVersion v = 2, 0 + + let headerVersionSupportedByCLRVersion v = + // The COM20HEADER version number + // Whidbey version numbers are 2.5 + // Earlier are 2.0 + // From an email from jeffschw: "Be built with a compiler that marks the COM20HEADER with Major >=2 and Minor >= 5. The V2.0 compilers produce images with 2.5, V1.x produces images with 2.0." + 2, 5 + + let peOptionalHeaderByteByCLRVersion v = + // A flag in the PE file optional header seems to depend on CLI version + // Whidbey version numbers are 8 + // Earlier are 6 + // Tools are meant to ignore this, but the VS Profiler wants it to have the right value + 8 + + // returned by writeBinaryAndReportMappings + [] + type ILTokenMappings = + { TypeDefTokenMap: ILTypeDef list * ILTypeDef -> int32 + FieldDefTokenMap: ILTypeDef list * ILTypeDef -> ILFieldDef -> int32 + MethodDefTokenMap: ILTypeDef list * ILTypeDef -> ILMethodDef -> int32 + PropertyTokenMap: ILTypeDef list * ILTypeDef -> ILPropertyDef -> int32 + EventTokenMap: ILTypeDef list * ILTypeDef -> ILEventDef -> int32 } + + let recordRequiredDataFixup (requiredDataFixups: ResizeArray<_>) (buf: ByteBuffer) pos lab = + requiredDataFixups.Add((pos, lab)) + // Write a special value in that we check later when applying the fixup + buf.EmitInt32 0xdeaddddd + + //--------------------------------------------------------------------- + // The UserString, BlobHeap, GuidHeap tables + //--------------------------------------------------------------------- + + let GetUserStringHeapIdx cenv s = + cenv.userStrings.FindOrAddSharedEntry s + + let GetBytesAsBlobIdx cenv (bytes:byte[]) = + if bytes.Length = 0 then 0 + else cenv.blobs.FindOrAddSharedEntry bytes + + let GetStringHeapIdx cenv s = + if s = "" then 0 + else cenv.strings.FindOrAddSharedEntry s + + let GetGuidIdx cenv info = cenv.guids.FindOrAddSharedEntry info + + let GetStringHeapIdxOption cenv sopt = + match sopt with + | USome ns -> GetStringHeapIdx cenv ns + | UNone -> 0 + + + let splitNameAt (nm:string) idx = + if idx < 0 then failwith "splitNameAt: idx < 0"; + let last = nm.Length - 1 + if idx > last then failwith "splitNameAt: idx > last"; + (nm.Substring(0, idx)), + (if idx < last then nm.Substring (idx+1, last - idx) else "") + + + module String = + let indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException("An index for the character was not found in the string")) + + let index (s:string) (c:char) = + let r = s.IndexOf(c) + if r = -1 then indexNotFound() else r + + let rindex (s:string) (c:char) = + let r = s.LastIndexOf(c) + if r = -1 then indexNotFound() else r + + let contains (s:string) (c:char) = + s.IndexOf(c, 0, String.length s) <> -1 + + let splitTypeNameRightAux nm = + if String.contains nm '.' then + let idx = String.rindex nm '.' + let s1, s2 = splitNameAt nm idx + Some s1, s2 + else None, nm + + let splitTypeNameRight nm = + splitTypeNameRightAux nm + + let GetTypeNameAsElemPair cenv (n1, n2) = + StringE (GetStringHeapIdxOption cenv n1), + StringE (GetStringHeapIdx cenv n2) + + //===================================================================== + // Pass 1 - allocate indexes for types + //===================================================================== + + let addILTypeName enc (td: ILTypeDef) = enc@[(if td.IsNested then td.Name else joinILTypeName td.Namespace td.Name)] + + let rec GenTypeDefPass1 enc cenv (td:ILTypeDef) = + ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_, _, n)) -> n) (TdKey (enc, td.Namespace, td.Name))) + GenTypeDefsPass1 (addILTypeName enc td) cenv td.NestedTypes.Entries + + and GenTypeDefsPass1 enc cenv tds = Array.iter (GenTypeDefPass1 enc cenv) tds + + //===================================================================== + // Pass 2 - allocate indexes for methods and fields and write rows for types + //===================================================================== + + let rec GetIdxForTypeDef cenv key = + try cenv.typeDefs.GetTableEntry key + with + :? KeyNotFoundException -> + let (TdKey (enc, nsp, n) ) = key + failwithf "One of your modules expects the type '%s' to be defined within the module being emitted. keys = %A" (String.concat "." (enc@[joinILTypeName nsp n])) (cenv.typeDefs.GetTableKeys()) + 0 + + // -------------------------------------------------------------------- + // Assembly and module references + // -------------------------------------------------------------------- + + let rec GetAssemblyRefAsRow cenv (aref:ILAssemblyRef) = + AssemblyRefRow + ((match aref.Version with UNone -> 0us | USome v -> uint16 v.Major), + (match aref.Version with UNone -> 0us | USome v -> uint16 v.Minor), + (match aref.Version with UNone -> 0us | USome v -> uint16 v.Build), + (match aref.Version with UNone -> 0us | USome v -> uint16 v.Revision), + ((match aref.PublicKey with USome (PublicKey _) -> 0x0001 | _ -> 0x0000) + ||| (if aref.Retargetable then 0x0100 else 0x0000)), + BlobIndex (match aref.PublicKey with + | UNone -> 0 + | USome (PublicKey b | PublicKeyToken b) -> GetBytesAsBlobIdx cenv b), + StringIndex (GetStringHeapIdx cenv aref.Name), + StringIndex (match aref.Locale with UNone -> 0 | USome s -> GetStringHeapIdx cenv s), + BlobIndex (match aref.Hash with UNone -> 0 | USome s -> GetBytesAsBlobIdx cenv s)) + + and GetAssemblyRefAsIdx cenv aref = + FindOrAddSharedRow cenv ILTableNames.AssemblyRef (GetAssemblyRefAsRow cenv aref) + + and GetModuleRefAsRow cenv (mref:ILModuleRef) = + SharedRow + [| StringE (GetStringHeapIdx cenv mref.Name) |] + + and GetModuleRefAsFileRow cenv (mref:ILModuleRef) = + SharedRow + [| ULong (if mref.HasMetadata then 0x0000 else 0x0001) + StringE (GetStringHeapIdx cenv mref.Name) + (match mref.Hash with UNone -> Blob 0 | USome s -> Blob (GetBytesAsBlobIdx cenv s)) |] + + and GetModuleRefAsIdx cenv mref = + FindOrAddSharedRow cenv ILTableNames.ModuleRef (GetModuleRefAsRow cenv mref) + + and GetModuleRefAsFileIdx cenv mref = + FindOrAddSharedRow cenv ILTableNames.File (GetModuleRefAsFileRow cenv mref) + + // -------------------------------------------------------------------- + // Does a ILScopeRef point to this module? + // -------------------------------------------------------------------- + + let isScopeRefLocal scoref = (scoref = ILScopeRef.Local) + let rec isTypeRefLocal (tref:ILTypeRef) = + isILTypeScopeRefLocal tref.Scope + and isILTypeScopeRefLocal (scoref:ILTypeRefScope) = + match scoref with + | ILTypeRefScope.Top t -> isScopeRefLocal t + | ILTypeRefScope.Nested tref -> isTypeRefLocal tref + let rec enclosing (scoref:ILTypeRefScope) = + match scoref with + | ILTypeRefScope.Top _ -> [] + | ILTypeRefScope.Nested tref -> enclosing tref.Scope @ [joinILTypeName tref.Namespace tref.Name] + + let isTypeLocal (typ:ILType) = typ.IsNominal && isEmpty typ.GenericArgs && isTypeRefLocal typ.TypeRef + + // -------------------------------------------------------------------- + // Scopes to Implementation elements. + // -------------------------------------------------------------------- + + let GetScopeRefAsImplementationElem cenv scoref = + match scoref with + | ILScopeRef.Local -> (ImplementationTag.AssemblyRef, 0) + | ILScopeRef.Assembly aref -> (ImplementationTag.AssemblyRef, GetAssemblyRefAsIdx cenv aref) + | ILScopeRef.Module mref -> (ImplementationTag.File, GetModuleRefAsFileIdx cenv mref) + + // -------------------------------------------------------------------- + // Type references, types etc. + // -------------------------------------------------------------------- + + let rec GetTypeRefAsTypeRefRow cenv (tref:ILTypeRef) = + let nselem, nelem = GetTypeNameAsElemPair cenv (tref.Namespace, tref.Name) + let rs1, rs2 = GetResolutionScopeAsElem cenv tref.Scope + SharedRow [| ResolutionScope (rs1, rs2); nelem; nselem |] + + and GetTypeRefAsTypeRefIdx cenv tref = + let mutable res = 0 + if cenv.trefCache.TryGetValue(tref, &res) then res else + let res = FindOrAddSharedRow cenv ILTableNames.TypeRef (GetTypeRefAsTypeRefRow cenv tref) + cenv.trefCache.[tref] <- res + res + + and GetTypeDescAsTypeRefIdx cenv (enc, nsp, n) = + GetTypeRefAsTypeRefIdx cenv (ILTypeRef (enc, nsp, n)) + + and GetResolutionScopeAsElem cenv scoref = + match scoref with + | ILTypeRefScope.Top s -> + match s with + | ILScopeRef.Local -> (ResolutionScopeTag.Module, 1) + | ILScopeRef.Assembly aref -> (ResolutionScopeTag.AssemblyRef, GetAssemblyRefAsIdx cenv aref) + | ILScopeRef.Module mref -> (ResolutionScopeTag.ModuleRef, GetModuleRefAsIdx cenv mref) + + | ILTypeRefScope.Nested tref -> + (ResolutionScopeTag.TypeRef, GetTypeRefAsTypeRefIdx cenv tref) + + + let emitTypeInfoAsTypeDefOrRefEncoded cenv (bb: ByteBuffer) (scoref, nsp, nm) = + if isILTypeScopeRefLocal scoref then + let idx = GetIdxForTypeDef cenv (TdKey(enclosing scoref, nsp, nm)) + bb.EmitZ32 (idx <<< 2) // ECMA 22.2.8 TypeDefOrRefEncoded - ILTypeDef + else + let idx = GetTypeDescAsTypeRefIdx cenv (scoref, nsp, nm) + bb.EmitZ32 ((idx <<< 2) ||| 0x01) // ECMA 22.2.8 TypeDefOrRefEncoded - ILTypeRef + + let getTypeDefOrRefAsUncodedToken (tag, idx) = + let tab = + if tag = TypeDefOrRefOrSpecTag.TypeDef then ILTableNames.TypeDef + elif tag = TypeDefOrRefOrSpecTag.TypeRef then ILTableNames.TypeRef + elif tag = TypeDefOrRefOrSpecTag.TypeSpec then ILTableNames.TypeSpec + else failwith "getTypeDefOrRefAsUncodedToken" + getUncodedToken tab idx + + // REVIEW: write into an accumuating buffer + let EmitArrayShape (bb: ByteBuffer) (ILArrayShape shape) = + let sized = Array.filter (function (_, Some _) -> true | _ -> false) shape + let lobounded = Array.filter (function (Some _, _) -> true | _ -> false) shape + bb.EmitZ32 shape.Length + bb.EmitZ32 sized.Length + sized |> Array.iter (function (_, Some sz) -> bb.EmitZ32 sz | _ -> failwith "?") + bb.EmitZ32 lobounded.Length + lobounded |> Array.iter (function (Some low, _) -> bb.EmitZ32 low | _ -> failwith "?") + + let hasthisToByte hasthis = + match hasthis with + | ILThisConvention.Instance -> e_IMAGE_CEE_CS_CALLCONV_INSTANCE + | ILThisConvention.InstanceExplicit -> e_IMAGE_CEE_CS_CALLCONV_INSTANCE_EXPLICIT + | ILThisConvention.Static -> 0x00uy + + let callconvToByte ntypars (Callconv (hasthis, bcc)) = + hasthisToByte hasthis ||| + (if ntypars > 0 then e_IMAGE_CEE_CS_CALLCONV_GENERIC else 0x00uy) ||| + (match bcc with + | ILArgConvention.FastCall -> e_IMAGE_CEE_CS_CALLCONV_FASTCALL + | ILArgConvention.StdCall -> e_IMAGE_CEE_CS_CALLCONV_STDCALL + | ILArgConvention.ThisCall -> e_IMAGE_CEE_CS_CALLCONV_THISCALL + | ILArgConvention.CDecl -> e_IMAGE_CEE_CS_CALLCONV_CDECL + | ILArgConvention.Default -> 0x00uy + | ILArgConvention.VarArg -> e_IMAGE_CEE_CS_CALLCONV_VARARG) + + + // REVIEW: write into an accumuating buffer + let rec EmitTypeSpec cenv env (bb: ByteBuffer) (et, tspec:ILTypeSpec) = + if isEmpty tspec.GenericArgs then + bb.EmitByte et + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope, tspec.Namespace, tspec.Name) + else + bb.EmitByte et_WITH + bb.EmitByte et + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope, tspec.Namespace, tspec.Name) + bb.EmitZ32 tspec.GenericArgs.Length + EmitTypes cenv env bb tspec.GenericArgs + + and GetTypeAsTypeDefOrRef cenv env (ty:ILType) = + if isTypeLocal ty then + let tref = ty.TypeRef + (TypeDefOrRefOrSpecTag.TypeDef, GetIdxForTypeDef cenv (TdKey(enclosing tref.Scope, tref.Namespace, tref.Name))) + elif ty.IsNominal && isEmpty ty.GenericArgs then + (TypeDefOrRefOrSpecTag.TypeRef, GetTypeRefAsTypeRefIdx cenv ty.TypeRef) + else + (TypeDefOrRefOrSpecTag.TypeSpec, GetTypeAsTypeSpecIdx cenv env ty) + + and GetTypeAsBytes cenv env ty = emitBytesViaBuffer (fun bb -> EmitType cenv env bb ty) + + and GetTypeOfLocalAsBytes cenv env (l: ILLocal) = + emitBytesViaBuffer (fun bb -> EmitLocalInfo cenv env bb l) + + and GetTypeAsBlobIdx cenv env (ty:ILType) = + GetBytesAsBlobIdx cenv (GetTypeAsBytes cenv env ty) + + and GetTypeAsTypeSpecRow cenv env (ty:ILType) = + SharedRow [| Blob (GetTypeAsBlobIdx cenv env ty) |] + + and GetTypeAsTypeSpecIdx cenv env ty = + FindOrAddSharedRow cenv ILTableNames.TypeSpec (GetTypeAsTypeSpecRow cenv env ty) + + + and EmitType cenv env bb ty = + match ty with + | ElementType et -> bb.EmitByte et + | ILType.Boxed tspec -> EmitTypeSpec cenv env bb (et_CLASS, tspec) + | ILType.Value tspec -> EmitTypeSpec cenv env bb (et_VALUETYPE, tspec) + | ILType.Array (shape, ty) -> + if shape = ILArrayShape.SingleDimensional then (bb.EmitByte et_SZARRAY ; EmitType cenv env bb ty) + else (bb.EmitByte et_ARRAY; EmitType cenv env bb ty; EmitArrayShape bb shape) + | ILType.Var tv -> + let cgparams = env.EnclosingTyparCount + if int32 tv < cgparams then + bb.EmitByte et_VAR + bb.EmitZ32 (int32 tv) + else + bb.EmitByte et_MVAR + bb.EmitZ32 (int32 tv - cgparams) + + | ILType.Byref typ -> + bb.EmitByte et_BYREF + EmitType cenv env bb typ + | ILType.Ptr typ -> + bb.EmitByte et_PTR + EmitType cenv env bb typ + | ILType.Void -> + bb.EmitByte et_VOID + | ILType.FunctionPointer x -> + bb.EmitByte et_FNPTR + EmitCallsig cenv env bb (x.CallingConv, x.ArgTypes, x.ReturnType, None, 0) + | ILType.Modified (req, tref, ty) -> + bb.EmitByte (if req then et_CMOD_REQD else et_CMOD_OPT) + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tref.Scope, tref.Namespace, tref.Name) + EmitType cenv env bb ty + | _ -> failwith "EmitType" + + and EmitLocalInfo cenv env (bb:ByteBuffer) (l:ILLocal) = + if l.IsPinned then + bb.EmitByte et_PINNED + EmitType cenv env bb l.Type + + and EmitCallsig cenv env (bb:ByteBuffer) (callconv, args:ILTypes, ret, varargs:ILVarArgs, genarity) = + bb.EmitByte (callconvToByte genarity callconv) + if genarity > 0 then bb.EmitZ32 genarity + bb.EmitZ32 ((args.Length + (match varargs with None -> 0 | Some l -> l.Length))) + EmitType cenv env bb ret + args |> Array.iter (EmitType cenv env bb) + match varargs with + | None -> ()// no extra arg = no sentinel + | Some tys -> + if isEmpty tys then () // no extra arg = no sentinel + else + bb.EmitByte et_SENTINEL + Array.iter (EmitType cenv env bb) tys + + and GetCallsigAsBytes cenv env x = emitBytesViaBuffer (fun bb -> EmitCallsig cenv env bb x) + + and EmitTypes cenv env bb (inst: ILTypes) = + inst |> Array.iter (EmitType cenv env bb) + + let GetTypeAsMemberRefParent cenv env ty = + match GetTypeAsTypeDefOrRef cenv env ty with + | (tag, _) when tag = TypeDefOrRefOrSpecTag.TypeDef -> printfn "GetTypeAsMemberRefParent: mspec should have been encoded as mdtMethodDef?"; MemberRefParent (MemberRefParentTag.TypeRef, 1) + | (tag, tok) when tag = TypeDefOrRefOrSpecTag.TypeRef -> MemberRefParent (MemberRefParentTag.TypeRef, tok) + | (tag, tok) when tag = TypeDefOrRefOrSpecTag.TypeSpec -> MemberRefParent (MemberRefParentTag.TypeSpec, tok) + | _ -> failwith "GetTypeAsMemberRefParent" + + + + + // -------------------------------------------------------------------- + // Native types + // -------------------------------------------------------------------- + + let rec GetFieldInitAsBlobIdx cenv (x:ILFieldInit) = + GetBytesAsBlobIdx cenv (emitBytesViaBuffer (fun bb -> GetFieldInit bb x)) + + // REVIEW: write into an accumuating buffer + and GetFieldInit (bb: ByteBuffer) x = + match x with + | :? string as b -> bb.EmitBytes (Encoding.Unicode.GetBytes b) + | :? bool as b -> bb.EmitByte (if b then 0x01uy else 0x00uy) + | :? char as x -> bb.EmitUInt16 (uint16 x) + | :? int8 as x -> bb.EmitByte (byte x) + | :? int16 as x -> bb.EmitUInt16 (uint16 x) + | :? int32 as x -> bb.EmitInt32 x + | :? int64 as x -> bb.EmitInt64 x + | :? uint8 as x -> bb.EmitByte x + | :? uint16 as x -> bb.EmitUInt16 x + | :? uint32 as x -> bb.EmitInt32 (int32 x) + | :? uint64 as x -> bb.EmitInt64 (int64 x) + | :? single as x -> bb.EmitInt32 (bitsOfSingle x) + | :? double as x -> bb.EmitInt64 (bitsOfDouble x) + | _ -> bb.EmitInt32 0 + + and GetFieldInitFlags (i: ILFieldInit) = + UShort + (uint16 + (match i with + | :? string -> et_STRING + | :? bool -> et_BOOLEAN + | :? char -> et_CHAR + | :? int8 -> et_I1 + | :? int16 -> et_I2 + | :? int32 -> et_I4 + | :? int64 -> et_I8 + | :? uint8 -> et_U1 + | :? uint16 -> et_U2 + | :? uint32 -> et_U4 + | :? uint64 -> et_U8 + | :? single -> et_R4 + | :? double -> et_R8 + | _ -> et_CLASS)) + + // -------------------------------------------------------------------- + // Type definitions + // -------------------------------------------------------------------- + + let GetMemberAccessFlags access = + match access with + | ILMemberAccess.CompilerControlled -> 0x00000000 + | ILMemberAccess.Public -> 0x00000006 + | ILMemberAccess.Private -> 0x00000001 + | ILMemberAccess.Family -> 0x00000004 + | ILMemberAccess.FamilyAndAssembly -> 0x00000002 + | ILMemberAccess.FamilyOrAssembly -> 0x00000005 + | ILMemberAccess.Assembly -> 0x00000003 + + let GetTypeAccessFlags access = + match access with + | ILTypeDefAccess.Public -> 0x00000001 + | ILTypeDefAccess.Private -> 0x00000000 + | ILTypeDefAccess.Nested ILMemberAccess.Public -> 0x00000002 + | ILTypeDefAccess.Nested ILMemberAccess.Private -> 0x00000003 + | ILTypeDefAccess.Nested ILMemberAccess.Family -> 0x00000004 + | ILTypeDefAccess.Nested ILMemberAccess.FamilyAndAssembly -> 0x00000006 + | ILTypeDefAccess.Nested ILMemberAccess.FamilyOrAssembly -> 0x00000007 + | ILTypeDefAccess.Nested ILMemberAccess.Assembly -> 0x00000005 + | ILTypeDefAccess.Nested ILMemberAccess.CompilerControlled -> failwith "bad type acccess" + + let rec GetTypeDefAsRow cenv env _enc (td:ILTypeDef) = + let nselem, nelem = GetTypeNameAsElemPair cenv (td.Namespace, td.Name) + let flags = + if td.Name = "" then 0x00000000 + else + + int td.Attributes ||| + begin + match td.Layout with + | ILTypeDefLayout.Auto -> 0x00000000 + | ILTypeDefLayout.Sequential _ -> 0x00000008 + | ILTypeDefLayout.Explicit _ -> 0x00000010 + end ||| + begin + match td.Kind with + | ILTypeDefKind.Interface -> 0x00000020 + | _ -> 0x00000000 + end ||| +#if EMIT_SECURITY_DECLS +// @REVIEW (if rtspecialname_of_tdef td then 0x00000800 else 0x00000000) ||| + (if td.HasSecurity || not td.SecurityDecls.Entries.IsEmpty then 0x00040000 else 0x00000000) +#endif + 0x0 + + let tdorTag, tdorRow = GetTypeOptionAsTypeDefOrRef cenv env td.Extends + UnsharedRow + [| ULong flags + nelem + nselem + TypeDefOrRefOrSpec (tdorTag, tdorRow) + SimpleIndex (ILTableNames.Field, cenv.fieldDefs.Count + 1) + SimpleIndex (ILTableNames.Method, cenv.methodDefIdxsByKey.Count + 1) |] + + and GetTypeOptionAsTypeDefOrRef cenv env tyOpt = + match tyOpt with + | None -> (TypeDefOrRefOrSpecTag.TypeDef, 0) + | Some ty -> (GetTypeAsTypeDefOrRef cenv env ty) + + and GetTypeDefAsPropertyMapRow cenv tidx = + UnsharedRow + [| SimpleIndex (ILTableNames.TypeDef, tidx) + SimpleIndex (ILTableNames.Property, cenv.propertyDefs.Count + 1) |] + + and GetTypeDefAsEventMapRow cenv tidx = + UnsharedRow + [| SimpleIndex (ILTableNames.TypeDef, tidx) + SimpleIndex (ILTableNames.Event, cenv.eventDefs.Count + 1) |] + + and GetKeyForFieldDef tidx (fd: ILFieldDef) = + FieldDefKey (tidx, fd.Name, fd.FieldType) + + and GenFieldDefPass2 cenv tidx fd = + ignore (cenv.fieldDefs.AddUniqueEntry "field" (fun (fdkey:FieldDefKey) -> fdkey.Name) (GetKeyForFieldDef tidx fd)) + + and GetKeyForMethodDef tidx (md: ILMethodDef) = + MethodDefKey (tidx, md.GenericParams.Length, md.Name, md.Return.Type, md.ParameterTypes, md.CallingConv.IsStatic) + + and GenMethodDefPass2 cenv tidx md = + let idx = + cenv.methodDefIdxsByKey.AddUniqueEntry + "method" + (fun (key:MethodDefKey) -> + printfn "Duplicate in method table is:" + printfn "%s" (" Type index: "+string key.TypeIdx) + printfn "%s" (" Method name: "+key.Name) + printfn "%s" (" Method arity (num generic params): "+string key.GenericArity) + key.Name + ) + (GetKeyForMethodDef tidx md) + + cenv.methodDefIdxs.[md] <- idx + + and GetKeyForPropertyDef tidx (x: ILPropertyDef) = + PropKey (tidx, x.Name, x.PropertyType, x.IndexParameterTypes) + + and GenPropertyDefPass2 cenv tidx x = + ignore (cenv.propertyDefs.AddUniqueEntry "property" (fun (PropKey (_, n, _, _)) -> n) (GetKeyForPropertyDef tidx x)) + + and GetTypeAsImplementsRow cenv env tidx ty = + let tdorTag, tdorRow = GetTypeAsTypeDefOrRef cenv env ty + UnsharedRow + [| SimpleIndex (ILTableNames.TypeDef, tidx) + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] + + and GenImplementsPass2 cenv env tidx ty = + AddUnsharedRow cenv ILTableNames.InterfaceImpl (GetTypeAsImplementsRow cenv env tidx ty) |> ignore + + and GetKeyForEvent tidx (x: ILEventDef) = + EventKey (tidx, x.Name) + + and GenEventDefPass2 cenv tidx x = + ignore (cenv.eventDefs.AddUniqueEntry "event" (fun (EventKey(_, b)) -> b) (GetKeyForEvent tidx x)) + + and GenTypeDefPass2 pidx enc cenv (td:ILTypeDef) = + try + let env = envForTypeDef td + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Namespace, td.Name)) + let tidx2 = AddUnsharedRow cenv ILTableNames.TypeDef (GetTypeDefAsRow cenv env enc td) + if tidx <> tidx2 then failwith "index of typedef on second pass does not match index on first pass" + + // Add entries to auxiliary mapping tables, e.g. Nested, PropertyMap etc. + // Note Nested is organised differently to the others... + if not (isNil enc) then + AddUnsharedRow cenv ILTableNames.Nested + (UnsharedRow + [| SimpleIndex (ILTableNames.TypeDef, tidx) + SimpleIndex (ILTableNames.TypeDef, pidx) |]) |> ignore + let props = td.Properties.Entries + if not (isEmpty props) then + AddUnsharedRow cenv ILTableNames.PropertyMap (GetTypeDefAsPropertyMapRow cenv tidx) |> ignore + let events = td.Events.Entries + if not (isEmpty events) then + AddUnsharedRow cenv ILTableNames.EventMap (GetTypeDefAsEventMapRow cenv tidx) |> ignore + + // Now generate or assign index numbers for tables referenced by the maps. + // Don't yet generate contents of these tables - leave that to pass3, as + // code may need to embed these entries. + td.Implements |> Array.iter (GenImplementsPass2 cenv env tidx) + props |> Array.iter (GenPropertyDefPass2 cenv tidx) + events |> Array.iter (GenEventDefPass2 cenv tidx) + td.Fields.Entries |> Array.iter (GenFieldDefPass2 cenv tidx) + td.Methods.Entries |> Array.iter (GenMethodDefPass2 cenv tidx) + td.NestedTypes.Entries |> GenTypeDefsPass2 tidx (addILTypeName enc td) cenv + with e -> + failwith ("Error in pass2 for type "+td.Name+", error: "+e.Message) + + and GenTypeDefsPass2 pidx enc cenv tds = + Array.iter (GenTypeDefPass2 pidx enc cenv) tds + + //===================================================================== + // Pass 3 - write details of methods, fields, IL code, custom attrs etc. + //===================================================================== + + exception MethodDefNotFound + let FindMethodDefIdx cenv mdkey = + try cenv.methodDefIdxsByKey.GetTableEntry mdkey + with :? KeyNotFoundException -> + let typeNameOfIdx i = + match + (cenv.typeDefs.dict + |> Seq.fold (fun sofar kvp -> + let tkey2 = kvp.Key + let tidx2 = kvp.Value + if i = tidx2 then + if sofar = None then + Some tkey2 + else failwith "multiple type names map to index" + else sofar) None) with + | Some x -> x + | None -> raise MethodDefNotFound + let (TdKey (tenc, tnsp, tname)) = typeNameOfIdx mdkey.TypeIdx + printfn "%s" ("The local method '"+(String.concat "." (tenc@[tname]))+"'::'"+mdkey.Name+"' was referenced but not declared") + printfn "generic arity: %s " (string mdkey.GenericArity) + cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2, _)) -> + if mdkey2.TypeIdx = mdkey.TypeIdx && mdkey.Name = mdkey2.Name then + let (TdKey (tenc2, tnsp2, tname2)) = typeNameOfIdx mdkey2.TypeIdx + printfn "%s" ("A method in '"+(String.concat "." (tenc2@[tname2]))+"' had the right name but the wrong signature:") + printfn "%s" ("generic arity: "+string mdkey2.GenericArity) + printfn "mdkey2 = %s" (mdkey2.ToString())) + raise MethodDefNotFound + + + let rec GetMethodDefIdx cenv md = + cenv.methodDefIdxs.[md] + + and FindFieldDefIdx cenv fdkey = + try cenv.fieldDefs.GetTableEntry fdkey + with :? KeyNotFoundException -> + failwith ("The local field "+fdkey.Name+" was referenced but not declared") + 1 + + and GetFieldDefAsFieldDefIdx cenv tidx fd = + FindFieldDefIdx cenv (GetKeyForFieldDef tidx fd) + + // -------------------------------------------------------------------- + // ILMethodRef --> ILMethodDef. + // + // Only successfuly converts ILMethodRef's referring to + // methods in the module being emitted. + // -------------------------------------------------------------------- + + let GetMethodRefAsMethodDefIdx cenv (mref:ILMethodRef) = + let tref = mref.EnclosingTypeRef + try + if not (isTypeRefLocal tref) then + failwithf "method referred to by method impl, event or property is not in a type defined in this module, method ref is %A" mref + let tidx = GetIdxForTypeDef cenv (TdKey(enclosing tref.Scope, tref.Namespace, tref.Name)) + let mdkey = MethodDefKey (tidx, mref.GenericArity, mref.Name, mref.ReturnType, mref.ArgTypes, mref.CallingConv.IsStatic) + FindMethodDefIdx cenv mdkey + with e -> + failwithf "Error in GetMethodRefAsMethodDefIdx for mref = %A, error: %s" (mref.Name, tref.Name) e.Message + + let rec MethodRefInfoAsMemberRefRow cenv env fenv (nm, typ, callconv, args, ret, varargs, genarity) = + MemberRefRow(GetTypeAsMemberRefParent cenv env typ, + GetStringHeapIdx cenv nm, + GetMethodRefInfoAsBlobIdx cenv fenv (callconv, args, ret, varargs, genarity)) + + and GetMethodRefInfoAsBlobIdx cenv env info = + GetBytesAsBlobIdx cenv (GetCallsigAsBytes cenv env info) + + let GetMethodRefInfoAsMemberRefIdx cenv env ((_, typ, _, _, _, _, _) as minfo) = + let fenv = envForMethodRef env typ + FindOrAddSharedRow cenv ILTableNames.MemberRef (MethodRefInfoAsMemberRefRow cenv env fenv minfo) + + let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm, typ:ILType, cc, args, ret, varargs, genarity) as minfo) = + if Option.isNone varargs && (isAlwaysMethodDef || isTypeLocal typ) then + if not typ.IsNominal then failwith "GetMethodRefInfoAsMethodRefOrDef: unexpected local tref-typ" + try (MethodDefOrRefTag.MethodDef, GetMethodRefAsMethodDefIdx cenv (ILMethodRef (typ.TypeRef, cc, genarity, nm, args, ret))) + with MethodDefNotFound -> (MethodDefOrRefTag.MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) + else (MethodDefOrRefTag.MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) + + + // -------------------------------------------------------------------- + // ILMethodSpec --> ILMethodRef/ILMethodDef/ILMethodSpec + // -------------------------------------------------------------------- + + let rec GetMethodSpecInfoAsMethodSpecIdx cenv env (nm, typ, cc, args, ret, varargs, minst:ILGenericArgs) = + let mdorTag, mdorRow = GetMethodRefInfoAsMethodRefOrDef false cenv env (nm, typ, cc, args, ret, varargs, minst.Length) + let blob = + emitBytesViaBuffer (fun bb -> + bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_GENERICINST + bb.EmitZ32 minst.Length + minst |> Array.iter (EmitType cenv env bb)) + FindOrAddSharedRow cenv ILTableNames.MethodSpec + (SharedRow + [| MethodDefOrRef (mdorTag, mdorRow) + Blob (GetBytesAsBlobIdx cenv blob) |]) + + and GetMethodDefOrRefAsUncodedToken (tag, idx) = + let tab = + if tag = MethodDefOrRefTag.MethodDef then ILTableNames.Method + elif tag = MethodDefOrRefTag.MemberRef then ILTableNames.MemberRef + else failwith "GetMethodDefOrRefAsUncodedToken" + getUncodedToken tab idx + + and GetMethodSpecInfoAsUncodedToken cenv env ((_, _, _, _, _, _, minst:ILGenericArgs) as minfo) = + if minst.Length > 0 then + getUncodedToken ILTableNames.MethodSpec (GetMethodSpecInfoAsMethodSpecIdx cenv env minfo) + else + GetMethodDefOrRefAsUncodedToken (GetMethodRefInfoAsMethodRefOrDef false cenv env (GetMethodRefInfoOfMethodSpecInfo minfo)) + + and GetMethodSpecAsUncodedToken cenv env mspec = + GetMethodSpecInfoAsUncodedToken cenv env (InfoOfMethodSpec mspec) + + and GetMethodRefInfoOfMethodSpecInfo (nm, typ, cc, args, ret, varargs, minst:ILGenericArgs) = + (nm, typ, cc, args, ret, varargs, minst.Length) + + and GetMethodSpecAsMethodDefOrRef cenv env (mspec, varargs) = + GetMethodRefInfoAsMethodRefOrDef false cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec, varargs))) + + and GetMethodSpecAsMethodDef cenv env (mspec, varargs) = + GetMethodRefInfoAsMethodRefOrDef true cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec, varargs))) + + and InfoOfMethodSpec (mspec:ILMethodSpec, varargs) = + (mspec.Name, + mspec.EnclosingType, + mspec.CallingConv, + mspec.MethodRef.ArgTypes, + mspec.FormalReturnType, + varargs, + mspec.GenericArgs) + + // -------------------------------------------------------------------- + // method_in_parent --> ILMethodRef/ILMethodDef + // + // Used for MethodImpls. + // -------------------------------------------------------------------- + + let rec GetOverridesSpecAsMemberRefIdx cenv env ospec = + let fenv = envForOverrideSpec ospec + let row = MethodRefInfoAsMemberRefRow cenv env fenv (ospec.MethodRef.Name, ospec.EnclosingType, ospec.MethodRef.CallingConv, ospec.MethodRef.ArgTypes, ospec.MethodRef.ReturnType, None, ospec.MethodRef.GenericArity) + FindOrAddSharedRow cenv ILTableNames.MemberRef row + + and GetOverridesSpecAsMethodDefOrRef cenv env (ospec:ILOverridesSpec) = + let typ = ospec.EnclosingType + if isTypeLocal typ then + if not typ.IsNominal then failwith "GetOverridesSpecAsMethodDefOrRef: unexpected local tref-typ" + try (MethodDefOrRefTag.MethodDef, GetMethodRefAsMethodDefIdx cenv ospec.MethodRef) + with MethodDefNotFound -> (MethodDefOrRefTag.MemberRef, GetOverridesSpecAsMemberRefIdx cenv env ospec) + else + (MethodDefOrRefTag.MemberRef, GetOverridesSpecAsMemberRefIdx cenv env ospec) + + // -------------------------------------------------------------------- + // ILMethodRef --> ILMethodRef/ILMethodDef + // + // Used for Custom Attrs. + // -------------------------------------------------------------------- + + let rec GetMethodRefAsMemberRefIdx cenv env fenv (mref:ILMethodRef) = + let row = MethodRefInfoAsMemberRefRow cenv env fenv (mref.Name, ILType.Boxed (ILTypeSpec (mref.EnclosingTypeRef, [| |])), mref.CallingConv, mref.ArgTypes, mref.ReturnType, None, mref.GenericArity) + FindOrAddSharedRow cenv ILTableNames.MemberRef row + + and GetMethodRefAsCustomAttribType cenv (mref:ILMethodRef) = + let fenv = envForNonGenericMethodRef mref + let tref = mref.EnclosingTypeRef + if isTypeRefLocal tref then + try (CustomAttributeTypeTag.MethodDef, GetMethodRefAsMethodDefIdx cenv mref) + with MethodDefNotFound -> (CustomAttributeTypeTag.MemberRef, GetMethodRefAsMemberRefIdx cenv fenv fenv mref) + else + (CustomAttributeTypeTag.MemberRef, GetMethodRefAsMemberRefIdx cenv fenv fenv mref) + + // -------------------------------------------------------------------- + // ILCustomAttrs --> CustomAttribute rows + // -------------------------------------------------------------------- + + let rec GetCustomAttrDataAsBlobIdx cenv (data:byte[]) = + if data.Length = 0 then 0 else GetBytesAsBlobIdx cenv data + + and GetCustomAttrRow cenv hca attr = + let cat = GetMethodRefAsCustomAttribType cenv attr.Method.MethodRef + for element in attr.Elements do + match element with + | :? ILType as ty when ty.IsNominal -> GetTypeRefAsTypeRefIdx cenv ty.TypeRef |> ignore + | _ -> () + + UnsharedRow + [| HasCustomAttribute (fst hca, snd hca) + CustomAttributeType (fst cat, snd cat) + Blob (GetCustomAttrDataAsBlobIdx cenv attr.Data) + |] + + and GenCustomAttrPass3Or4 cenv hca attr = + AddUnsharedRow cenv ILTableNames.CustomAttribute (GetCustomAttrRow cenv hca attr) |> ignore + + and GenCustomAttrsPass3Or4 cenv hca (attrs: ILCustomAttrs) = + attrs.Entries |> Array.iter (GenCustomAttrPass3Or4 cenv hca) + + // -------------------------------------------------------------------- + // ILPermissionSet --> DeclSecurity rows + // -------------------------------------------------------------------- *) + +#if EMIT_SECURITY_DECLS + let rec GetSecurityDeclRow cenv hds (PermissionSet (action, s)) = + UnsharedRow + [| UShort (uint16 (List.assoc action (Lazy.force ILSecurityActionMap))) + HasDeclSecurity (fst hds, snd hds) + Blob (GetBytesAsBlobIdx cenv s) |] + + and GenSecurityDeclPass3 cenv hds attr = + AddUnsharedRow cenv ILTableNames.Permission (GetSecurityDeclRow cenv hds attr) |> ignore + + and GenSecurityDeclsPass3 cenv hds attrs = + List.iter (GenSecurityDeclPass3 cenv hds) attrs +#endif + + // -------------------------------------------------------------------- + // ILFieldSpec --> FieldRef or ILFieldDef row + // -------------------------------------------------------------------- + + let rec GetFieldSpecAsMemberRefRow cenv env fenv (fspec:ILFieldSpec) = + MemberRefRow (GetTypeAsMemberRefParent cenv env fspec.EnclosingType, + GetStringHeapIdx cenv fspec.Name, + GetFieldSpecSigAsBlobIdx cenv fenv fspec) + + and GetFieldSpecAsMemberRefIdx cenv env fspec = + let fenv = envForFieldSpec fspec + FindOrAddSharedRow cenv ILTableNames.MemberRef (GetFieldSpecAsMemberRefRow cenv env fenv fspec) + + // REVIEW: write into an accumuating buffer + and EmitFieldSpecSig cenv env (bb: ByteBuffer) (fspec:ILFieldSpec) = + bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_FIELD + EmitType cenv env bb fspec.FormalType + + and GetFieldSpecSigAsBytes cenv env x = + emitBytesViaBuffer (fun bb -> EmitFieldSpecSig cenv env bb x) + + and GetFieldSpecSigAsBlobIdx cenv env x = + GetBytesAsBlobIdx cenv (GetFieldSpecSigAsBytes cenv env x) + + and GetFieldSpecAsFieldDefOrRef cenv env (fspec:ILFieldSpec) = + let typ = fspec.EnclosingType + if isTypeLocal typ then + if not typ.IsNominal then failwith "GetFieldSpecAsFieldDefOrRef: unexpected local tref-typ" + let tref = typ.TypeRef + let tidx = GetIdxForTypeDef cenv (TdKey(enclosing tref.Scope, tref.Namespace, tref.Name)) + let fdkey = FieldDefKey (tidx, fspec.Name, fspec.FormalType) + (true, FindFieldDefIdx cenv fdkey) + else + (false, GetFieldSpecAsMemberRefIdx cenv env fspec) + + and GetFieldDefOrRefAsUncodedToken (tag, idx) = + let tab = if tag then ILTableNames.Field else ILTableNames.MemberRef + getUncodedToken tab idx + + // -------------------------------------------------------------------- + // callsig --> StandAloneSig + // -------------------------------------------------------------------- + + let GetCallsigAsBlobIdx cenv env (callsig:ILCallingSignature, varargs) = + GetBytesAsBlobIdx cenv + (GetCallsigAsBytes cenv env (callsig.CallingConv, + callsig.ArgTypes, + callsig.ReturnType, varargs, 0)) + + let GetCallsigAsStandAloneSigRow cenv env x = + SharedRow [| Blob (GetCallsigAsBlobIdx cenv env x) |] + + let GetCallsigAsStandAloneSigIdx cenv env info = + FindOrAddSharedRow cenv ILTableNames.StandAloneSig (GetCallsigAsStandAloneSigRow cenv env info) + + // -------------------------------------------------------------------- + // local signatures --> BlobHeap idx + // -------------------------------------------------------------------- + + let EmitLocalSig cenv env (bb: ByteBuffer) (locals: ILLocals) = + bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG + bb.EmitZ32 locals.Length + locals |> Array.iter (EmitLocalInfo cenv env bb) + + let GetLocalSigAsBlobHeapIdx cenv env locals = + GetBytesAsBlobIdx cenv (emitBytesViaBuffer (fun bb -> EmitLocalSig cenv env bb locals)) + + let GetLocalSigAsStandAloneSigIdx cenv env locals = + SharedRow [| Blob (GetLocalSigAsBlobHeapIdx cenv env locals) |] + + + + type ExceptionClauseKind = + | FinallyClause + | FaultClause + | TypeFilterClause of int32 + | FilterClause of int + + type ExceptionClauseSpec = (int * int * int * int * ExceptionClauseKind) + + type CodeBuffer = + + // -------------------------------------------------------------------- + // Buffer to write results of emitting code into. Also record: + // - branch sources (where fixups will occur) + // - possible branch destinations + // - locations of embedded handles into the string table + // - the exception table + // -------------------------------------------------------------------- + { code: ByteBuffer + /// (instruction; optional short form); start of instr in code buffer; code loc for the end of the instruction the fixup resides in ; where is the destination of the fixup + mutable reqdBrFixups: ResizeArray<((int * int option) * int * ILCodeLabel list)> + availBrFixups: Dictionary + /// code loc to fixup in code buffer + mutable reqdStringFixupsInMethod: ResizeArray<(int * int)> + /// data for exception handling clauses + mutable seh: ResizeArray +#if DEBUG_INFO + seqpoints: ResizeArray +#endif + } + + static member Create _nm = + { seh = ResizeArray() + code= ByteBuffer.Create 200 + reqdBrFixups= ResizeArray() + reqdStringFixupsInMethod=ResizeArray() + availBrFixups = Dictionary<_, _>(10, HashIdentity.Structural) +#if DEBUG_INFO + seqpoints = new ResizeArray<_>(10) +#endif + } + + member codebuf.EmitExceptionClause seh = codebuf.seh.Add(seh) + +#if DEBUG_INFO + member codebuf.EmitSeqPoint cenv (m:ILSourceMarker) = () + if cenv.generatePdb then + // table indexes are 1-based, document array indexes are 0-based + let doc = (cenv.documents.FindOrAddSharedEntry m.Document) - 1 + codebuf.seqpoints.Add + { Document=doc + Offset= codebuf.code.Position + Line=m.Line + Column=m.Column + EndLine=m.EndLine + EndColumn=m.EndColumn } +#endif + + member codebuf.EmitByte x = codebuf.code.EmitIntAsByte x + member codebuf.EmitUInt16 x = codebuf.code.EmitUInt16 x + member codebuf.EmitInt32 x = codebuf.code.EmitInt32 x + member codebuf.EmitInt64 x = codebuf.code.EmitInt64 x + + member codebuf.EmitUncodedToken u = codebuf.EmitInt32 u + + member codebuf.RecordReqdStringFixup stringidx = + codebuf.reqdStringFixupsInMethod.Add((codebuf.code.Position, stringidx)) + // Write a special value in that we check later when applying the fixup + codebuf.EmitInt32 0xdeadbeef + + member codebuf.RecordReqdBrFixups i tgs = + codebuf.reqdBrFixups.Add ((i, codebuf.code.Position, tgs)) + // Write a special value in that we check later when applying the fixup + // Value is 0x11 {deadbbbb}* where 11 is for the instruction and deadbbbb is for each target + codebuf.EmitByte 0x11 // for the instruction + (if fst i = i_switch then + codebuf.EmitInt32 tgs.Length) + List.iter (fun _ -> codebuf.EmitInt32 0xdeadbbbb) tgs + + member codebuf.RecordReqdBrFixup i tg = codebuf.RecordReqdBrFixups i [tg] + member codebuf.RecordAvailBrFixup tg = + codebuf.availBrFixups.[tg] <- codebuf.code.Position + + module Codebuf = + // -------------------------------------------------------------------- + // Applying branch fixups. Use short versions of instructions + // wherever possible. Sadly we can only determine if we can use a short + // version after we've layed out the code for all other instructions. + // This in turn means that using a short version may change + // the various offsets into the code. + // -------------------------------------------------------------------- + + let binaryChop p (arr: 'T[]) = + let rec go n m = + if n > m then raise (KeyNotFoundException("binary chop did not find element")) + else + let i = (n+m)/2 + let c = p arr.[i] + if c = 0 then i elif c < 0 then go n (i-1) else go (i+1) m + go 0 (Array.length arr) + + let applyBrFixups (origCode :byte[]) origExnClauses origReqdStringFixups (origAvailBrFixups: Dictionary) origReqdBrFixups = + let orderedOrigReqdBrFixups = origReqdBrFixups |> Array.sortBy (fun (_, fixuploc, _) -> fixuploc) + + let newCode = ByteBuffer.Create origCode.Length + + // Copy over all the code, working out whether the branches will be short + // or long and adjusting the branch destinations. Record an adjust function to adjust all the other + // gumpf that refers to fixed offsets in the code stream. + let newCode, newReqdBrFixups, adjuster = + let remainingReqdFixups = ref (Array.toList orderedOrigReqdBrFixups) + let origWhere = ref 0 + let newWhere = ref 0 + let doneLast = ref false + let newReqdBrFixups = ref [] + + let adjustments = ref [] + + while (not (isNil !remainingReqdFixups) || not !doneLast) do + let doingLast = isNil !remainingReqdFixups + let origStartOfNoBranchBlock = !origWhere + let newStartOfNoBranchBlock = !newWhere + + let origEndOfNoBranchBlock = + if doingLast then origCode.Length + else + let (_, origStartOfInstr, _) = List.head !remainingReqdFixups + origStartOfInstr + + // Copy over a chunk of non-branching code + let nobranch_len = origEndOfNoBranchBlock - origStartOfNoBranchBlock + newCode.EmitBytes origCode.[origStartOfNoBranchBlock..origStartOfNoBranchBlock+nobranch_len-1] + + // Record how to adjust addresses in this range, including the branch instruction + // we write below, or the end of the method if we're doing the last bblock + adjustments := (origStartOfNoBranchBlock, origEndOfNoBranchBlock, newStartOfNoBranchBlock) :: !adjustments + + // Increment locations to the branch instruction we're really interested in + origWhere := origEndOfNoBranchBlock + newWhere := !newWhere + nobranch_len + + // Now do the branch instruction. Decide whether the fixup will be short or long in the new code + if doingLast then + doneLast := true + else + let (i, origStartOfInstr, tgs:ILCodeLabel list) = List.head !remainingReqdFixups + remainingReqdFixups := List.tail !remainingReqdFixups + if origCode.[origStartOfInstr] <> 0x11uy then failwith "br fixup sanity check failed (1)" + let i_length = if fst i = i_switch then 5 else 1 + origWhere := !origWhere + i_length + + let origEndOfInstr = origStartOfInstr + i_length + 4 * tgs.Length + let newEndOfInstrIfSmall = !newWhere + i_length + 1 + let newEndOfInstrIfBig = !newWhere + i_length + 4 * tgs.Length + + let short = + match i, tgs with + | (_, Some i_short), [tg] + when + begin + // Use the original offsets to compute if the branch is small or large. This is + // a safe approximation because code only gets smaller. + if not (origAvailBrFixups.ContainsKey tg) then + printfn "%s" ("branch target " + formatCodeLabel tg + " not found in code") + let origDest = + if origAvailBrFixups.ContainsKey tg then origAvailBrFixups.[tg] + else 666666 + let origRelOffset = origDest - origEndOfInstr + -128 <= origRelOffset && origRelOffset <= 127 + end + -> + newCode.EmitIntAsByte i_short + true + | (i_long, _), _ -> + newCode.EmitIntAsByte i_long + (if i_long = i_switch then + newCode.EmitInt32 tgs.Length) + false + + newWhere := !newWhere + i_length + if !newWhere <> newCode.Position then printfn "mismatch between newWhere and newCode" + + tgs |> List.iter (fun tg -> + let origFixupLoc = !origWhere + checkFixup32 origCode origFixupLoc 0xdeadbbbb + + if short then + newReqdBrFixups := (!newWhere, newEndOfInstrIfSmall, tg, true) :: !newReqdBrFixups + newCode.EmitIntAsByte 0x98 (* sanity check *) + newWhere := !newWhere + 1 + else + newReqdBrFixups := (!newWhere, newEndOfInstrIfBig, tg, false) :: !newReqdBrFixups + newCode.EmitInt32 0xf00dd00f (* sanity check *) + newWhere := !newWhere + 4 + if !newWhere <> newCode.Position then printfn "mismatch between newWhere and newCode" + origWhere := !origWhere + 4) + + if !origWhere <> origEndOfInstr then printfn "mismatch between origWhere and origEndOfInstr" + + let adjuster = + let arr = Array.ofList (List.rev !adjustments) + fun addr -> + let i = + try binaryChop (fun (a1, a2, _) -> if addr < a1 then -1 elif addr > a2 then 1 else 0) arr + with + :? KeyNotFoundException -> + failwith ("adjuster: address "+string addr+" is out of range") + let (origStartOfNoBranchBlock, _, newStartOfNoBranchBlock) = arr.[i] + addr - (origStartOfNoBranchBlock - newStartOfNoBranchBlock) + + newCode.Close(), + List.toArray !newReqdBrFixups, + adjuster + + // Now adjust everything + let newAvailBrFixups = + let tab = Dictionary<_, _>(10, HashIdentity.Structural) + for (KeyValue(tglab, origBrDest)) in origAvailBrFixups do + tab.[tglab] <- adjuster origBrDest + tab + let newReqdStringFixups = Array.map (fun (origFixupLoc, stok) -> adjuster origFixupLoc, stok) origReqdStringFixups +#if EMIT_DEBUG_INFO + let newSeqPoints = Array.map (fun (sp:PdbSequencePoint) -> {sp with Offset=adjuster sp.Offset}) origSeqPoints +#endif + let newExnClauses = + origExnClauses |> Array.map (fun (st1, sz1, st2, sz2, kind) -> + (adjuster st1, (adjuster (st1 + sz1) - adjuster st1), + adjuster st2, (adjuster (st2 + sz2) - adjuster st2), + (match kind with + | FinallyClause | FaultClause | TypeFilterClause _ -> kind + | FilterClause n -> FilterClause (adjuster n)))) + +#if EMIT_DEBUG_INFO + let newScopes = + let rec remap scope = + {scope with StartOffset = adjuster scope.StartOffset + EndOffset = adjuster scope.EndOffset + Children = Array.map remap scope.Children } + Array.map remap origScopes +#endif + + // Now apply the adjusted fixups in the new code + newReqdBrFixups |> Array.iter (fun (newFixupLoc, endOfInstr, tg, small) -> + if not (newAvailBrFixups.ContainsKey tg) then + failwith ("target "+formatCodeLabel tg+" not found in new fixups") + try + let n = newAvailBrFixups.[tg] + let relOffset = (n - endOfInstr) + if small then + if Bytes.get newCode newFixupLoc <> 0x98 then failwith "br fixupsanity check failed" + newCode.[newFixupLoc] <- b0 relOffset + else + checkFixup32 newCode newFixupLoc 0xf00dd00fl + applyFixup32 newCode newFixupLoc relOffset + with :? KeyNotFoundException -> ()) + + newCode, newReqdStringFixups, newExnClauses + + + // -------------------------------------------------------------------- + // Structured residue of emitting instructions: SEH exception handling + // and scopes for local variables. + // -------------------------------------------------------------------- + + // Emitting instructions generates a tree of seh specifications + // We then emit the exception handling specs separately. + // nb. ECMA spec says the SEH blocks must be returned inside-out + type SEHTree = + | Node of ExceptionClauseSpec option * SEHTree[] + + + // -------------------------------------------------------------------- + // Table of encodings for instructions without arguments, also indexes + // for all instructions. + // -------------------------------------------------------------------- + + let encodingsForNoArgInstrs = Dictionary<_, _>(300, HashIdentity.Structural) + let _ = + List.iter + (fun (x, mk) -> encodingsForNoArgInstrs.[mk] <- x) + (noArgInstrs.Force()) + let encodingsOfNoArgInstr si = encodingsForNoArgInstrs.[si] + + // -------------------------------------------------------------------- + // Emit instructions + // -------------------------------------------------------------------- + + /// Emit the code for an instruction + let emitInstrCode (codebuf: CodeBuffer) i = + if i > 0xFF then + assert (i >>> 8 = 0xFE) + codebuf.EmitByte ((i >>> 8) &&& 0xFF) + codebuf.EmitByte (i &&& 0xFF) + else + codebuf.EmitByte i + + let emitTypeInstr cenv codebuf env i ty = + emitInstrCode codebuf i + codebuf.EmitUncodedToken (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env ty)) + + let emitMethodSpecInfoInstr cenv codebuf env i mspecinfo = + emitInstrCode codebuf i + codebuf.EmitUncodedToken (GetMethodSpecInfoAsUncodedToken cenv env mspecinfo) + + let emitMethodSpecInstr cenv codebuf env i mspec = + emitInstrCode codebuf i + codebuf.EmitUncodedToken (GetMethodSpecAsUncodedToken cenv env mspec) + + let emitFieldSpecInstr cenv codebuf env i fspec = + emitInstrCode codebuf i + codebuf.EmitUncodedToken (GetFieldDefOrRefAsUncodedToken (GetFieldSpecAsFieldDefOrRef cenv env fspec)) + + let emitShortUInt16Instr codebuf (i_short, i) x = + let n = int32 x + if n <= 255 then + emitInstrCode codebuf i_short + codebuf.EmitByte n + else + emitInstrCode codebuf i + codebuf.EmitUInt16 x + + let emitShortInt32Instr codebuf (i_short, i) x = + if x >= (-128) && x <= 127 then + emitInstrCode codebuf i_short + codebuf.EmitByte (if x < 0x0 then x + 256 else x) + else + emitInstrCode codebuf i + codebuf.EmitInt32 x + + let emitTailness (cenv: cenv) codebuf tl = + if tl = Tailcall && cenv.emitTailcalls then emitInstrCode codebuf i_tail + + //let emitAfterTailcall codebuf tl = + // if tl = Tailcall then emitInstrCode codebuf i_ret + + let emitVolatility codebuf tl = + if tl = Volatile then emitInstrCode codebuf i_volatile + + let emitConstrained cenv codebuf env ty = + emitInstrCode codebuf i_constrained + codebuf.EmitUncodedToken (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env ty)) + + let emitAlignment codebuf tl = + match tl with + | Aligned -> () + | Unaligned1 -> emitInstrCode codebuf i_unaligned; codebuf.EmitByte 0x1 + | Unaligned2 -> emitInstrCode codebuf i_unaligned; codebuf.EmitByte 0x2 + | Unaligned4 -> emitInstrCode codebuf i_unaligned; codebuf.EmitByte 0x4 + + let rec emitInstr cenv codebuf env instr = + match instr with + | si when isNoArgInstr si -> + emitInstrCode codebuf (encodingsOfNoArgInstr si) + | I_brcmp (cmp, tg1) -> + codebuf.RecordReqdBrFixup (ILCmpInstrMap.Value.[cmp], Some ILCmpInstrRevMap.Value.[cmp]) tg1 + | I_br tg -> codebuf.RecordReqdBrFixup (i_br, Some i_br_s) tg +#if EMIT_DEBUG_INFO + | I_seqpoint s -> codebuf.EmitSeqPoint cenv s +#endif + | I_leave tg -> codebuf.RecordReqdBrFixup (i_leave, Some i_leave_s) tg + | I_call (tl, mspec, varargs) -> + emitTailness cenv codebuf tl + emitMethodSpecInstr cenv codebuf env i_call (mspec, varargs) + //emitAfterTailcall codebuf tl + | I_callvirt (tl, mspec, varargs) -> + emitTailness cenv codebuf tl + emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) + //emitAfterTailcall codebuf tl + | I_callconstraint (tl, ty, mspec, varargs) -> + emitTailness cenv codebuf tl + emitConstrained cenv codebuf env ty + emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) + //emitAfterTailcall codebuf tl + | I_newobj (mspec, varargs) -> + emitMethodSpecInstr cenv codebuf env i_newobj (mspec, varargs) + | I_ldftn mspec -> + emitMethodSpecInstr cenv codebuf env i_ldftn (mspec, None) + | I_ldvirtftn mspec -> + emitMethodSpecInstr cenv codebuf env i_ldvirtftn (mspec, None) + + | I_calli (tl, callsig, varargs) -> + emitTailness cenv codebuf tl + emitInstrCode codebuf i_calli + codebuf.EmitUncodedToken (getUncodedToken ILTableNames.StandAloneSig (GetCallsigAsStandAloneSigIdx cenv env (callsig, varargs))) + //emitAfterTailcall codebuf tl + + | I_ldarg x -> emitShortUInt16Instr codebuf (i_ldarg_s, i_ldarg) (uint16 x) + | I_starg x -> emitShortUInt16Instr codebuf (i_starg_s, i_starg) (uint16 x) + | I_ldarga x -> emitShortUInt16Instr codebuf (i_ldarga_s, i_ldarga) (uint16 x) + | I_ldloc x -> emitShortUInt16Instr codebuf (i_ldloc_s, i_ldloc) (uint16 x) + | I_stloc x -> emitShortUInt16Instr codebuf (i_stloc_s, i_stloc) (uint16 x) + | I_ldloca x -> emitShortUInt16Instr codebuf (i_ldloca_s, i_ldloca) (uint16 x) + + | I_cpblk (al, vol) -> + emitAlignment codebuf al + emitVolatility codebuf vol + emitInstrCode codebuf i_cpblk + | I_initblk (al, vol) -> + emitAlignment codebuf al + emitVolatility codebuf vol + emitInstrCode codebuf i_initblk + + | (I_ldc (DT_I4, ILConst.I4 x)) -> + emitShortInt32Instr codebuf (i_ldc_i4_s, i_ldc_i4) x + | (I_ldc (DT_I8, ILConst.I8 x)) -> + emitInstrCode codebuf i_ldc_i8 + codebuf.EmitInt64 x + | (I_ldc (_, ILConst.R4 x)) -> + emitInstrCode codebuf i_ldc_r4 + codebuf.EmitInt32 (bitsOfSingle x) + | (I_ldc (_, ILConst.R8 x)) -> + emitInstrCode codebuf i_ldc_r8 + codebuf.EmitInt64 (bitsOfDouble x) + + | I_ldind (al, vol, dt) -> + emitAlignment codebuf al + emitVolatility codebuf vol + emitInstrCode codebuf + (match dt with + | DT_I -> i_ldind_i + | DT_I1 -> i_ldind_i1 + | DT_I2 -> i_ldind_i2 + | DT_I4 -> i_ldind_i4 + | DT_U1 -> i_ldind_u1 + | DT_U2 -> i_ldind_u2 + | DT_U4 -> i_ldind_u4 + | DT_I8 -> i_ldind_i8 + | DT_R4 -> i_ldind_r4 + | DT_R8 -> i_ldind_r8 + | DT_REF -> i_ldind_ref + | _ -> failwith "ldind") + + | I_stelem dt -> + emitInstrCode codebuf + (match dt with + | DT_I | DT_U -> i_stelem_i + | DT_U1 | DT_I1 -> i_stelem_i1 + | DT_I2 | DT_U2 -> i_stelem_i2 + | DT_I4 | DT_U4 -> i_stelem_i4 + | DT_I8 | DT_U8 -> i_stelem_i8 + | DT_R4 -> i_stelem_r4 + | DT_R8 -> i_stelem_r8 + | DT_REF -> i_stelem_ref + | _ -> failwith "stelem") + + | I_ldelem dt -> + emitInstrCode codebuf + (match dt with + | DT_I -> i_ldelem_i + | DT_I1 -> i_ldelem_i1 + | DT_I2 -> i_ldelem_i2 + | DT_I4 -> i_ldelem_i4 + | DT_I8 -> i_ldelem_i8 + | DT_U1 -> i_ldelem_u1 + | DT_U2 -> i_ldelem_u2 + | DT_U4 -> i_ldelem_u4 + | DT_R4 -> i_ldelem_r4 + | DT_R8 -> i_ldelem_r8 + | DT_REF -> i_ldelem_ref + | _ -> failwith "ldelem") + + | I_stind (al, vol, dt) -> + emitAlignment codebuf al + emitVolatility codebuf vol + emitInstrCode codebuf + (match dt with + | DT_U | DT_I -> i_stind_i + | DT_U1 | DT_I1 -> i_stind_i1 + | DT_U2 | DT_I2 -> i_stind_i2 + | DT_U4 | DT_I4 -> i_stind_i4 + | DT_U8 | DT_I8 -> i_stind_i8 + | DT_R4 -> i_stind_r4 + | DT_R8 -> i_stind_r8 + | DT_REF -> i_stind_ref + | _ -> failwith "stelem") + + | I_switch labs -> codebuf.RecordReqdBrFixups (i_switch, None) labs + + | I_ldfld (al, vol, fspec) -> + emitAlignment codebuf al + emitVolatility codebuf vol + emitFieldSpecInstr cenv codebuf env i_ldfld fspec + | I_ldflda fspec -> + emitFieldSpecInstr cenv codebuf env i_ldflda fspec + | I_ldsfld (vol, fspec) -> + emitVolatility codebuf vol + emitFieldSpecInstr cenv codebuf env i_ldsfld fspec + | I_ldsflda fspec -> + emitFieldSpecInstr cenv codebuf env i_ldsflda fspec + | I_stfld (al, vol, fspec) -> + emitAlignment codebuf al + emitVolatility codebuf vol + emitFieldSpecInstr cenv codebuf env i_stfld fspec + | I_stsfld (vol, fspec) -> + emitVolatility codebuf vol + emitFieldSpecInstr cenv codebuf env i_stsfld fspec + + | I_ldtoken tok -> + emitInstrCode codebuf i_ldtoken + codebuf.EmitUncodedToken + (match tok with + | ILToken.ILType typ -> + match GetTypeAsTypeDefOrRef cenv env typ with + | (tag, idx) when tag = TypeDefOrRefOrSpecTag.TypeDef -> getUncodedToken ILTableNames.TypeDef idx + | (tag, idx) when tag = TypeDefOrRefOrSpecTag.TypeRef -> getUncodedToken ILTableNames.TypeRef idx + | (tag, idx) when tag = TypeDefOrRefOrSpecTag.TypeSpec -> getUncodedToken ILTableNames.TypeSpec idx + | _ -> failwith "?" + | ILToken.ILMethod mspec -> + match GetMethodSpecAsMethodDefOrRef cenv env (mspec, None) with + | (tag, idx) when tag = MethodDefOrRefTag.MethodDef -> getUncodedToken ILTableNames.Method idx + | (tag, idx) when tag = MethodDefOrRefTag.MemberRef -> getUncodedToken ILTableNames.MemberRef idx + | _ -> failwith "?" + + | ILToken.ILField fspec -> + match GetFieldSpecAsFieldDefOrRef cenv env fspec with + | (true, idx) -> getUncodedToken ILTableNames.Field idx + | (false, idx) -> getUncodedToken ILTableNames.MemberRef idx) + | I_ldstr s -> + emitInstrCode codebuf i_ldstr + codebuf.RecordReqdStringFixup (GetUserStringHeapIdx cenv s) + + | I_box ty -> emitTypeInstr cenv codebuf env i_box ty + | I_unbox ty -> emitTypeInstr cenv codebuf env i_unbox ty + | I_unbox_any ty -> emitTypeInstr cenv codebuf env i_unbox_any ty + + | I_newarr (shape, ty) -> + if (shape = ILArrayShape.SingleDimensional) then + emitTypeInstr cenv codebuf env i_newarr ty + else + let args = Array.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) + emitMethodSpecInfoInstr cenv codebuf env i_newobj (".ctor", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Void, None, [| |]) + + | I_stelem_any (shape, ty) -> + if (shape = ILArrayShape.SingleDimensional) then + emitTypeInstr cenv codebuf env i_stelem_any ty + else + let args = Array.init (shape.Rank+1) (fun i -> if i < shape.Rank then cenv.ilg.typ_Int32 else ty) + emitMethodSpecInfoInstr cenv codebuf env i_call ("Set", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Void, None, [| |]) + + | I_ldelem_any (shape, ty) -> + if (shape = ILArrayShape.SingleDimensional) then + emitTypeInstr cenv codebuf env i_ldelem_any ty + else + let args = Array.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) + emitMethodSpecInfoInstr cenv codebuf env i_call ("Get", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ty, None, [| |]) + + | I_ldelema (ro, shape, ty) -> + if (ro = ReadonlyAddress) then + emitInstrCode codebuf i_readonly + if (shape = ILArrayShape.SingleDimensional) then + emitTypeInstr cenv codebuf env i_ldelema ty + else + let args = Array.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) + emitMethodSpecInfoInstr cenv codebuf env i_call ("Address", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Byref ty, None, [| |]) + + | I_castclass ty -> emitTypeInstr cenv codebuf env i_castclass ty + | I_isinst ty -> emitTypeInstr cenv codebuf env i_isinst ty + | I_refanyval ty -> emitTypeInstr cenv codebuf env i_refanyval ty + | I_mkrefany ty -> emitTypeInstr cenv codebuf env i_mkrefany ty + | I_initobj ty -> emitTypeInstr cenv codebuf env i_initobj ty + | I_ldobj (al, vol, ty) -> + emitAlignment codebuf al + emitVolatility codebuf vol + emitTypeInstr cenv codebuf env i_ldobj ty + | I_stobj (al, vol, ty) -> + emitAlignment codebuf al + emitVolatility codebuf vol + emitTypeInstr cenv codebuf env i_stobj ty + | I_cpobj ty -> emitTypeInstr cenv codebuf env i_cpobj ty + | I_sizeof ty -> emitTypeInstr cenv codebuf env i_sizeof ty + | EI_ldlen_multi (_, m) -> + emitShortInt32Instr codebuf (i_ldc_i4_s, i_ldc_i4) m + let mspec = mkILMethSpecInTyRaw(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [|cenv.ilg.typ_Int32|], cenv.ilg.typ_Int32, [| |]) + emitInstr cenv codebuf env (mkNormalCall mspec) + + | _ -> failwith "an IL instruction cannot be emitted" + + + // Used to put local debug scopes and exception handlers into a tree form + let rangeInsideRange (start_pc1, end_pc1) (start_pc2, end_pc2) = + (start_pc1:int) >= start_pc2 && start_pc1 < end_pc2 && + (end_pc1:int) > start_pc2 && end_pc1 <= end_pc2 + + let lranges_of_clause cl = + match cl with + | ILExceptionClause.Finally r1 -> [r1] + | ILExceptionClause.Fault r1 -> [r1] + | ILExceptionClause.FilterCatch (r1, r2) -> [r1;r2] + | ILExceptionClause.TypeCatch (_ty, r1) -> [r1] + + + let labelsToRange (lab2pc: Dictionary) p = let (l1, l2) = p in lab2pc.[l1], lab2pc.[l2] + + let labelRangeInsideLabelRange lab2pc ls1 ls2 = + rangeInsideRange (labelsToRange lab2pc ls1) (labelsToRange lab2pc ls2) + +// This file still gets used when targeting FSharp.Core 3.1.0.0, e.g. in FSharp.Data +#if !ABOVE_FSCORE_4_0_0_0 + let mapFold f acc (array: _[]) = + match array.Length with + | 0 -> [| |], acc + | len -> + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f) + let mutable acc = acc + let res = Array.zeroCreate len + for i = 0 to array.Length-1 do + let h', s' = f.Invoke(acc, array.[i]) + res.[i] <- h' + acc <- s' + res, acc +#endif + let findRoots contains vs = + // For each item, either make it a root or make it a child of an existing root + let addToRoot roots x = + // Look to see if 'x' is inside one of the roots + let roots, found = + (false, roots) ||> mapFold (fun found (r, children) -> + if found then ((r, children), true) + elif contains x r then ((r, Array.append [| x |] children), true) + else ((r, children), false)) + + if found then roots + else + // Find the ones that 'x' encompasses and collapse them + let yes, others = roots |> Array.partition (fun (r, _) -> contains r x) + let yesChild = yes |> Array.collect (fun (r, ch) -> Array.append [| r |] ch) + Array.append [| (x, yesChild) |] others + + ([| |], vs) ||> Array.fold addToRoot + + let rec makeSEHTree cenv env (pc2pos: int[]) (lab2pc: Dictionary) (exs: ILExceptionSpec[]) = + + let clause_inside_lrange cl lr = + List.forall (fun lr1 -> labelRangeInsideLabelRange lab2pc lr1 lr) (lranges_of_clause cl) + + let tryspec_inside_lrange (tryspec1: ILExceptionSpec) lr = + (labelRangeInsideLabelRange lab2pc tryspec1.Range lr && clause_inside_lrange tryspec1.Clause lr) + + let tryspec_inside_clause tryspec1 cl = + List.exists (fun lr -> tryspec_inside_lrange tryspec1 lr) (lranges_of_clause cl) + + let tryspec_inside_tryspec tryspec1 (tryspec2: ILExceptionSpec) = + tryspec_inside_lrange tryspec1 tryspec2.Range || + tryspec_inside_clause tryspec1 tryspec2.Clause + + let roots = findRoots tryspec_inside_tryspec exs + let trees = + roots |> Array.map (fun (cl, ch) -> + let r1 = labelsToRange lab2pc cl.Range + let conv ((s1, e1), (s2, e2)) x = pc2pos.[s1], pc2pos.[e1] - pc2pos.[s1], pc2pos.[s2], pc2pos.[e2] - pc2pos.[s2], x + let children = makeSEHTree cenv env pc2pos lab2pc ch + let n = + match cl.Clause with + | ILExceptionClause.Finally r2 -> + conv (r1, labelsToRange lab2pc r2) ExceptionClauseKind.FinallyClause + | ILExceptionClause.Fault r2 -> + conv (r1, labelsToRange lab2pc r2) ExceptionClauseKind.FaultClause + | ILExceptionClause.FilterCatch ((filterStart, _), r3) -> + conv (r1, labelsToRange lab2pc r3) (ExceptionClauseKind.FilterClause (pc2pos.[lab2pc.[filterStart]])) + | ILExceptionClause.TypeCatch (typ, r2) -> + conv (r1, labelsToRange lab2pc r2) (TypeFilterClause (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env typ))) + SEHTree.Node (Some n, children) ) + + trees + +#if EMIT_DEBUG_INFO + let rec makeLocalsTree cenv localSigs (pc2pos: int[]) (lab2pc: Dictionary) (exs: ILLocalDebugInfo[]) = + let localInsideLocal (locspec1: ILLocalDebugInfo) (locspec2: ILLocalDebugInfo) = + labelRangeInsideLabelRange lab2pc locspec1.Range locspec2.Range + + let roots = findRoots localInsideLocal exs + + let trees = + roots |> Array.collect (fun (cl, ch) -> + let (s1, e1) = labelsToRange lab2pc cl.Range + let (s1, e1) = pc2pos.[s1], pc2pos.[e1] + let children = makeLocalsTree cenv localSigs pc2pos lab2pc ch + mkScopeNode cenv localSigs (s1, e1, cl.DebugMappings, children)) + trees +#endif + + + // Emit the SEH tree + let rec emitExceptionHandlerTree (codebuf: CodeBuffer) (Node (x, childSEH)) = + childSEH |> Array.iter (emitExceptionHandlerTree codebuf) // internal first + x |> Option.iter codebuf.EmitExceptionClause - // Attributes, etc.. - override _.GetAttributeFlagsImpl() = adjustTypeAttributes attributes this.IsNested - override _.IsArrayImpl() = false - override _.IsByRefImpl() = false - override _.IsPointerImpl() = false - override _.IsPrimitiveImpl() = false - override _.IsCOMObjectImpl() = false - override _.HasElementTypeImpl() = false - override _.Name = className - override _.DeclaringType = declaringType.Force() - override _.MemberType = if this.IsNested then MemberTypes.NestedType else MemberTypes.TypeInfo - override _.GetHashCode() = rootNamespace.GetHashCode() ^^^ className.GetHashCode() - override _.Equals(that:obj) = - match that with - | null -> false - | :? ProvidedTypeDefinition as ti -> System.Object.ReferenceEquals(this,ti) - | _ -> false - - override _.GetGenericArguments() = [||] - override _.ToString() = this.Name - + let emitCode cenv localSigs (codebuf: CodeBuffer) env (code: ILCode) = + let instrs = code.Instrs + + // Build a table mapping Abstract IL pcs to positions in the generated code buffer + let pc2pos = Array.zeroCreate (instrs.Length+1) + let pc2labs = Dictionary() + for (KeyValue(lab, pc)) in code.Labels do + if pc2labs.ContainsKey pc then pc2labs.[pc] <- lab :: pc2labs.[pc] else pc2labs.[pc] <- [lab] + + // Emit the instructions + for pc = 0 to instrs.Length do + if pc2labs.ContainsKey pc then + for lab in pc2labs.[pc] do + codebuf.RecordAvailBrFixup lab + pc2pos.[pc] <- codebuf.code.Position + if pc < instrs.Length then + match instrs.[pc] with + | I_br l when code.Labels.[l] = pc + 1 -> () // compress I_br to next instruction + | i -> emitInstr cenv codebuf env i + + // Build the exceptions and locals information, ready to emit + let SEHTree = makeSEHTree cenv env pc2pos code.Labels code.Exceptions + Array.iter (emitExceptionHandlerTree codebuf) SEHTree + +#if EMIT_DEBUG_INFO + // Build the locals information, ready to emit + let localsTree = makeLocalsTree cenv localSigs pc2pos code.Labels code.Locals + localsTree +#endif - override _.Module : Module = notRequired "Module" this.Name - override _.GUID = Guid.Empty - override _.GetConstructorImpl(_bindingAttr, _binder, _callConvention, _types, _modifiers) = null - override _.GetCustomAttributes(_inherit) = [| |] - override _.GetCustomAttributes(_attributeType, _inherit) = [| |] - override _.IsDefined(_attributeType: Type, _inherit) = false - - override _.GetElementType() = notRequired "Module" this.Name - override _.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired "Module" this.Name - override _.AssemblyQualifiedName = notRequired "Module" this.Name - member _.IsErased - with get() = (attributes &&& enum (int32 TypeProviderTypeAttributes.IsErased)) <> enum 0 - and set v = - if v then attributes <- attributes ||| enum (int32 TypeProviderTypeAttributes.IsErased) - else attributes <- attributes &&& ~~~(enum (int32 TypeProviderTypeAttributes.IsErased)) - - member _.SuppressRelocation - with get() = (attributes &&& enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) <> enum 0 - and set v = - if v then attributes <- attributes ||| enum (int32 TypeProviderTypeAttributes.SuppressRelocate) - else attributes <- attributes &&& ~~~(enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) - -type AssemblyGenerator(assemblyFileName) = - let assemblyShortName = Path.GetFileNameWithoutExtension assemblyFileName - let assemblyName = AssemblyName assemblyShortName -#if FX_NO_LOCAL_FILESYSTEM - let assembly = - System.AppDomain.CurrentDomain.DefineDynamicAssembly(name=assemblyName,access=AssemblyBuilderAccess.Run) - let assemblyMainModule = - assembly.DefineDynamicModule("MainModule") -#else - let assembly = - System.AppDomain.CurrentDomain.DefineDynamicAssembly(name=assemblyName,access=(AssemblyBuilderAccess.Save ||| AssemblyBuilderAccess.Run),dir=Path.GetDirectoryName assemblyFileName) - let assemblyMainModule = - assembly.DefineDynamicModule("MainModule", Path.GetFileName assemblyFileName) + let EmitTopCode cenv localSigs env nm code = + let codebuf = CodeBuffer.Create nm + let origScopes = emitCode cenv localSigs codebuf env code + let origCode = codebuf.code.Close() + let origExnClauses = codebuf.seh.ToArray() + let origReqdStringFixups = codebuf.reqdStringFixupsInMethod.ToArray() + let origAvailBrFixups = codebuf.availBrFixups + let origReqdBrFixups = codebuf.reqdBrFixups.ToArray() +#if EMIT_DEBUG_INFO + let origSeqPoints = codebuf.seqpoints.ToArray() #endif - let typeMap = Dictionary(HashIdentity.Reference) - let typeMapExtra = Dictionary(HashIdentity.Structural) - let uniqueLambdaTypeName() = - // lambda name should be unique across all types that all type provider might contribute in result assembly - sprintf "Lambda%O" (Guid.NewGuid()) - - member _.Assembly = assembly :> Assembly - - /// Emit the given provided type definitions into an assembly and adjust 'Assembly' property of all type definitions to return that - /// assembly. - member _.Generate(providedTypeDefinitions:(ProvidedTypeDefinition * string list option) list) = - let ALL = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static ||| BindingFlags.Instance - // phase 1 - set assembly fields and emit type definitions - begin - let rec typeMembers (tb:TypeBuilder) (td : ProvidedTypeDefinition) = - for ntd in td.GetNestedTypes(ALL) do - nestedType tb ntd - - and nestedType (tb:TypeBuilder) (ntd : Type) = - match ntd with - | :? ProvidedTypeDefinition as pntd -> - if pntd.IsErased then invalidOp ("The nested provided type "+pntd.Name+"is marked as erased and cannot be converted to a generated type. Set 'IsErased' to false on the ProvidedTypeDefinition") - // Adjust the attributes - we're codegen'ing this type as nested - let attributes = adjustTypeAttributes ntd.Attributes true - let ntb = tb.DefineNestedType(pntd.Name,attr=attributes) - pntd.SetAssembly null - typeMap.[pntd] <- ntb - typeMembers ntb pntd - | _ -> () - - for (pt,enclosingGeneratedTypeNames) in providedTypeDefinitions do - match enclosingGeneratedTypeNames with - | None -> - // Filter out the additional TypeProviderTypeAttributes flags - let attributes = pt.Attributes &&& ~~~(enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) - &&& ~~~(enum (int32 TypeProviderTypeAttributes.IsErased)) - // Adjust the attributes - we're codegen'ing as non-nested - let attributes = adjustTypeAttributes attributes false - let tb = assemblyMainModule.DefineType(name=pt.FullName,attr=attributes) - pt.SetAssembly null - typeMap.[pt] <- tb - typeMembers tb pt - | Some ns -> - let otb,_ = - ((None,""),ns) ||> List.fold (fun (otb:TypeBuilder option,fullName) n -> - let fullName = if fullName = "" then n else fullName + "." + n - let priorType = if typeMapExtra.ContainsKey(fullName) then Some typeMapExtra.[fullName] else None - let tb = - match priorType with - | Some tbb -> tbb - | None -> - // OK, the implied nested type is not defined, define it now - let attributes = - TypeAttributes.Public ||| - TypeAttributes.Class ||| - TypeAttributes.Sealed - // Filter out the additional TypeProviderTypeAttributes flags - let attributes = adjustTypeAttributes attributes otb.IsSome - let tb = - match otb with - | None -> assemblyMainModule.DefineType(name=n,attr=attributes) - | Some (otb:TypeBuilder) -> otb.DefineNestedType(name=n,attr=attributes) - typeMapExtra.[fullName] <- tb - tb - (Some tb, fullName)) - nestedType otb.Value pt - end - let rec convType (ty:Type) = - match ty with - | :? ProvidedTypeDefinition as ptd -> - if typeMap.ContainsKey ptd then typeMap.[ptd] :> Type else ty - | _ -> - if ty.IsGenericType then ty.GetGenericTypeDefinition().MakeGenericType (Array.map convType (ty.GetGenericArguments())) - elif ty.HasElementType then - let ety = convType (ty.GetElementType()) - if ty.IsArray then - let rank = ty.GetArrayRank() - if rank = 1 then ety.MakeArrayType() - else ety.MakeArrayType rank - elif ty.IsPointer then ety.MakePointerType() - elif ty.IsByRef then ety.MakeByRefType() - else ty - else ty - - let ctorMap = Dictionary(HashIdentity.Reference) - let methMap = Dictionary(HashIdentity.Reference) - let fieldMap = Dictionary(HashIdentity.Reference) - - let iterateTypes f = - let rec typeMembers (ptd : ProvidedTypeDefinition) = - let tb = typeMap.[ptd] - f tb (Some ptd) - for ntd in ptd.GetNestedTypes(ALL) do - nestedType ntd - and nestedType (ntd : Type) = - match ntd with - | :? ProvidedTypeDefinition as pntd -> typeMembers pntd - | _ -> () - - for (pt,enclosingGeneratedTypeNames) in providedTypeDefinitions do - match enclosingGeneratedTypeNames with - | None -> - typeMembers pt - | Some ns -> - let _fullName = - ("",ns) ||> List.fold (fun fullName n -> - let fullName = if fullName = "" then n else fullName + "." + n - f typeMapExtra.[fullName] None - fullName) - nestedType pt - - - // phase 1b - emit base types - iterateTypes (fun tb ptd -> - match ptd with - | None -> () - | Some ptd -> - match ptd.BaseType with null -> () | bt -> tb.SetParent(convType bt)) + let newCode, newReqdStringFixups, newExnClauses = + applyBrFixups origCode origExnClauses origReqdStringFixups origAvailBrFixups origReqdBrFixups - let defineCustomAttrs f (cattrs: IList) = - for attr in cattrs do - let constructorArgs = [ for x in attr.ConstructorArguments -> x.Value ] - let namedProps,namedPropVals = [ for x in attr.NamedArguments do match x.MemberInfo with :? PropertyInfo as pi -> yield (pi, x.TypedValue.Value) | _ -> () ] |> List.unzip - let namedFields,namedFieldVals = [ for x in attr.NamedArguments do match x.MemberInfo with :? FieldInfo as pi -> yield (pi, x.TypedValue.Value) | _ -> () ] |> List.unzip - let cab = CustomAttributeBuilder(attr.Constructor, Array.ofList constructorArgs, Array.ofList namedProps, Array.ofList namedPropVals, Array.ofList namedFields, Array.ofList namedFieldVals) - f cab - - // phase 2 - emit member definitions - iterateTypes (fun tb ptd -> - match ptd with - | None -> () - | Some ptd -> - for cinfo in ptd.GetConstructors(ALL) do - match cinfo with - | :? ProvidedConstructor as pcinfo when not (ctorMap.ContainsKey pcinfo) -> - let cb = - if pcinfo.IsTypeInitializer then - if (cinfo.GetParameters()).Length <> 0 then failwith "Type initializer should not have parameters" - tb.DefineTypeInitializer() - else - let cb = tb.DefineConstructor(cinfo.Attributes, CallingConventions.Standard, [| for p in cinfo.GetParameters() -> convType p.ParameterType |]) - for (i,p) in cinfo.GetParameters() |> Seq.mapi (fun i x -> (i,x)) do - cb.DefineParameter(i+1, ParameterAttributes.None, p.Name) |> ignore - cb - ctorMap.[pcinfo] <- cb - | _ -> () +#if EMIT_DEBUG_INFO + let rootScope = + { Children= newScopes + StartOffset=0 + EndOffset=newCode.Length + Locals=[| |] } +#endif + + (newReqdStringFixups, newExnClauses, newCode) + + // -------------------------------------------------------------------- + // ILMethodBody --> bytes + // -------------------------------------------------------------------- + let GetFieldDefTypeAsBlobIdx cenv env ty = + let bytes = emitBytesViaBuffer (fun bb -> bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_FIELD + EmitType cenv env bb ty) + GetBytesAsBlobIdx cenv bytes + + let GenILMethodBody mname cenv env (il: ILMethodBody) = + let localSigs = + if cenv.generatePdb then + il.Locals |> Array.map (fun l -> + // Write a fake entry for the local signature headed by e_IMAGE_CEE_CS_CALLCONV_FIELD. This is referenced by the PDB file + ignore (FindOrAddSharedRow cenv ILTableNames.StandAloneSig (SharedRow [| Blob (GetFieldDefTypeAsBlobIdx cenv env l.Type) |])) + // Now write the type + GetTypeOfLocalAsBytes cenv env l) + else + [| |] + + let requiredStringFixups, seh, code (* , seqpoints, scopes *) = Codebuf.EmitTopCode cenv localSigs env mname il.Code + let codeSize = code.Length + let methbuf = ByteBuffer.Create (codeSize * 3) + // Do we use the tiny format? + if isEmpty il.Locals && il.MaxStack <= 8 && isEmpty seh && codeSize < 64 then + // Use Tiny format + let alignedCodeSize = align 4 (codeSize + 1) + let codePadding = (alignedCodeSize - (codeSize + 1)) + let requiredStringFixups' = (1, requiredStringFixups) + methbuf.EmitByte (byte codeSize <<< 2 ||| e_CorILMethod_TinyFormat) + methbuf.EmitBytes code + methbuf.EmitPadding codePadding + 0x0, (requiredStringFixups', methbuf.Close()) // , seqpoints, scopes + else + // Use Fat format + let flags = + e_CorILMethod_FatFormat ||| + (if not (isEmpty seh) then e_CorILMethod_MoreSects else 0x0uy) ||| + (if il.IsZeroInit then e_CorILMethod_InitLocals else 0x0uy) + + let localToken = + if isEmpty il.Locals then 0x0 else + getUncodedToken ILTableNames.StandAloneSig + (FindOrAddSharedRow cenv ILTableNames.StandAloneSig (GetLocalSigAsStandAloneSigIdx cenv env il.Locals)) + + let alignedCodeSize = align 0x4 codeSize + let codePadding = (alignedCodeSize - codeSize) + + methbuf.EmitByte flags + methbuf.EmitByte 0x30uy // last four bits record size of fat header in 4 byte chunks - this is always 12 bytes = 3 four word chunks + methbuf.EmitUInt16 (uint16 il.MaxStack) + methbuf.EmitInt32 codeSize + methbuf.EmitInt32 localToken + methbuf.EmitBytes code + methbuf.EmitPadding codePadding + + if not (isEmpty seh) then + // Can we use the small exception handling table format? + let smallSize = (seh.Length * 12 + 4) + let canUseSmall = + smallSize <= 0xFF && + seh |> Array.forall (fun (st1, sz1, st2, sz2, _) -> + st1 <= 0xFFFF && st2 <= 0xFFFF && sz1 <= 0xFF && sz2 <= 0xFF) + + let kindAsInt32 k = + match k with + | FinallyClause -> e_COR_ILEXCEPTION_CLAUSE_FINALLY + | FaultClause -> e_COR_ILEXCEPTION_CLAUSE_FAULT + | FilterClause _ -> e_COR_ILEXCEPTION_CLAUSE_FILTER + | TypeFilterClause _ -> e_COR_ILEXCEPTION_CLAUSE_EXCEPTION + let kindAsExtraInt32 k = + match k with + | FinallyClause | FaultClause -> 0x0 + | FilterClause i -> i + | TypeFilterClause uncoded -> uncoded - if ptd.IsEnum then - tb.DefineField("value__", ptd.GetEnumUnderlyingType(), FieldAttributes.Public ||| FieldAttributes.SpecialName ||| FieldAttributes.RTSpecialName) - |> ignore - - for finfo in ptd.GetFields(ALL) do - let fieldInfo = - match finfo with - | :? ProvidedField as pinfo -> - Some (pinfo.Name, convType finfo.FieldType, finfo.Attributes, pinfo.GetCustomAttributesDataImpl(), None) - | :? ProvidedLiteralField as pinfo -> - Some (pinfo.Name, convType finfo.FieldType, finfo.Attributes, pinfo.GetCustomAttributesDataImpl(), Some (pinfo.GetRawConstantValue())) - | _ -> None - match fieldInfo with - | Some (name, ty, attr, cattr, constantVal) when not (fieldMap.ContainsKey finfo) -> - let fb = tb.DefineField(name, ty, attr) - if constantVal.IsSome then - fb.SetConstant constantVal.Value - defineCustomAttrs fb.SetCustomAttribute cattr - fieldMap.[finfo] <- fb - | _ -> () - for minfo in ptd.GetMethods(ALL) do - match minfo with - | :? ProvidedMethod as pminfo when not (methMap.ContainsKey pminfo) -> - let mb = tb.DefineMethod(minfo.Name, minfo.Attributes, convType minfo.ReturnType, [| for p in minfo.GetParameters() -> convType p.ParameterType |]) - for (i, p) in minfo.GetParameters() |> Seq.mapi (fun i x -> (i,x :?> ProvidedParameter)) do - // TODO: check why F# compiler doesn't emit default value when just p.Attributes is used (thus bad metadata is emitted) -// let mutable attrs = ParameterAttributes.None -// -// if p.IsOut then attrs <- attrs ||| ParameterAttributes.Out -// if p.HasDefaultParameterValue then attrs <- attrs ||| ParameterAttributes.Optional - - let pb = mb.DefineParameter(i+1, p.Attributes, p.Name) - if p.HasDefaultParameterValue then - do - let ctor = typeof.GetConstructor([|typeof|]) - let builder = new CustomAttributeBuilder(ctor, [|p.RawDefaultValue|]) - pb.SetCustomAttribute builder - do - let ctor = typeof.GetConstructor([||]) - let builder = new CustomAttributeBuilder(ctor, [||]) - pb.SetCustomAttribute builder - pb.SetConstant p.RawDefaultValue - methMap.[pminfo] <- mb - | _ -> () - - for ityp in ptd.GetInterfaceImplementations() do - tb.AddInterfaceImplementation ityp) - - // phase 3 - emit member code - iterateTypes (fun tb ptd -> - match ptd with + if canUseSmall then + methbuf.EmitByte e_CorILMethod_Sect_EHTable + methbuf.EmitByte (b0 smallSize |> byte) + methbuf.EmitByte 0x00uy + methbuf.EmitByte 0x00uy + seh |> Array.iter (fun (st1, sz1, st2, sz2, kind) -> + let k32 = kindAsInt32 kind + methbuf.EmitInt32AsUInt16 k32 + methbuf.EmitInt32AsUInt16 st1 + methbuf.EmitByte (b0 sz1 |> byte) + methbuf.EmitInt32AsUInt16 st2 + methbuf.EmitByte (b0 sz2 |> byte) + methbuf.EmitInt32 (kindAsExtraInt32 kind)) + else + let bigSize = (seh.Length * 24 + 4) + methbuf.EmitByte (e_CorILMethod_Sect_EHTable ||| e_CorILMethod_Sect_FatFormat) + methbuf.EmitByte (b0 bigSize |> byte) + methbuf.EmitByte (b1 bigSize |> byte) + methbuf.EmitByte (b2 bigSize |> byte) + seh |> Array.iter (fun (st1, sz1, st2, sz2, kind) -> + let k32 = kindAsInt32 kind + methbuf.EmitInt32 k32 + methbuf.EmitInt32 st1 + methbuf.EmitInt32 sz1 + methbuf.EmitInt32 st2 + methbuf.EmitInt32 sz2 + methbuf.EmitInt32 (kindAsExtraInt32 kind)) + + let requiredStringFixups' = (12, requiredStringFixups) + + localToken, (requiredStringFixups', methbuf.Close()) //, seqpoints, scopes + + // -------------------------------------------------------------------- + // ILFieldDef --> FieldDef Row + // -------------------------------------------------------------------- + + let rec GetFieldDefAsFieldDefRow cenv env (fd: ILFieldDef) = + let flags = int fd.Attributes ||| (if (fd.LiteralValue <> None) then 0x8000 else 0x0) //||| + //(if (fd.Marshal <> None) then 0x1000 else 0x0) ||| + //(if (fd.Data <> None) then 0x0100 else 0x0) + UnsharedRow + [| UShort (uint16 flags) + StringE (GetStringHeapIdx cenv fd.Name) + Blob (GetFieldDefSigAsBlobIdx cenv env fd ) |] + + and GetFieldDefSigAsBlobIdx cenv env fd = GetFieldDefTypeAsBlobIdx cenv env fd.FieldType + + and GenFieldDefPass3 cenv env fd = + let fidx = AddUnsharedRow cenv ILTableNames.Field (GetFieldDefAsFieldDefRow cenv env fd) + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.FieldDef, fidx) fd.CustomAttrs +#if EMIT_FIELD_DATA + // Write FieldRVA table - fixups into data section done later + match fd.Data with + | None -> () + | Some b -> + let offs = cenv.data.Position + cenv.data.EmitBytes b + AddUnsharedRow cenv ILTableNames.FieldRVA + (UnsharedRow [| Data (offs, false); SimpleIndex (ILTableNames.Field, fidx) |]) |> ignore + // Write FieldMarshal table + match fd.Marshal with | None -> () - | Some ptd -> - let cattr = ptd.GetCustomAttributesDataImpl() - defineCustomAttrs tb.SetCustomAttribute cattr - // Allow at most one constructor, and use its arguments as the fields of the type - let ctors = - ptd.GetConstructors(ALL) // exclude type initializer - |> Seq.choose (function :? ProvidedConstructor as pcinfo when not pcinfo.IsTypeInitializer -> Some pcinfo | _ -> None) - |> Seq.toList - let implictCtorArgs = - match ctors |> List.filter (fun x -> x.IsImplicitCtor) with - | [] -> [] - | [ pcinfo ] -> [ for p in pcinfo.GetParameters() -> p ] - | _ -> failwith "at most one implicit constructor allowed" - - let implicitCtorArgsAsFields = - [ for ctorArg in implictCtorArgs -> - tb.DefineField(ctorArg.Name, convType ctorArg.ParameterType, FieldAttributes.Private) ] + | Some ntyp -> + AddUnsharedRow cenv ILTableNames.FieldMarshal + (UnsharedRow [| HasFieldMarshal (hfm_FieldDef, fidx) + Blob (GetNativeTypeAsBlobIdx cenv ntyp) |]) |> ignore +#endif + // Write Content table + match fd.LiteralValue with + | None -> () + | Some i -> + AddUnsharedRow cenv ILTableNames.Constant + (UnsharedRow + [| GetFieldInitFlags i + HasConstant (HasConstantTag.FieldDef, fidx) + Blob (GetFieldInitAsBlobIdx cenv i) |]) |> ignore + // Write FieldLayout table + match fd.Offset with + | None -> () + | Some offset -> + AddUnsharedRow cenv ILTableNames.FieldLayout + (UnsharedRow [| ULong offset; SimpleIndex (ILTableNames.Field, fidx) |]) |> ignore + + + // -------------------------------------------------------------------- + // ILGenericParameterDef --> GenericParam Row + // -------------------------------------------------------------------- + + let rec GetGenericParamAsGenericParamRow cenv _env idx owner (gp: ILGenericParameterDef) = + let flags = + (if gp.IsCovariant then 0x0001 else 0x0000) ||| + (if gp.IsContravariant then 0x0002 else 0x0000) ||| + (if gp.HasReferenceTypeConstraint then 0x0004 else 0x0000) ||| + (if gp.HasNotNullableValueTypeConstraint then 0x0008 else 0x0000) ||| + (if gp.HasDefaultConstructorConstraint then 0x0010 else 0x0000) + + let mdVersionMajor, _ = metadataSchemaVersionSupportedByCLRVersion cenv.desiredMetadataVersion + if (mdVersionMajor = 1) then + SharedRow + [| UShort (uint16 idx) + UShort (uint16 flags) + TypeOrMethodDef (fst owner, snd owner) + StringE (GetStringHeapIdx cenv gp.Name) + TypeDefOrRefOrSpec (TypeDefOrRefOrSpecTag.TypeDef, 0) (* empty kind field in deprecated metadata *) |] + else + SharedRow + [| UShort (uint16 idx) + UShort (uint16 flags) + TypeOrMethodDef (fst owner, snd owner) + StringE (GetStringHeapIdx cenv gp.Name) |] + + and GenTypeAsGenericParamConstraintRow cenv env gpidx ty = + let tdorTag, tdorRow = GetTypeAsTypeDefOrRef cenv env ty + UnsharedRow + [| SimpleIndex (ILTableNames.GenericParam, gpidx) + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] + + and GenGenericParamConstraintPass4 cenv env gpidx ty = + AddUnsharedRow cenv ILTableNames.GenericParamConstraint (GenTypeAsGenericParamConstraintRow cenv env gpidx ty) |> ignore + + and GenGenericParamPass3 cenv env idx owner gp = + // here we just collect generic params, its constraints\custom attributes will be processed on pass4 + // shared since we look it up again below in GenGenericParamPass4 + AddSharedRow cenv ILTableNames.GenericParam (GetGenericParamAsGenericParamRow cenv env idx owner gp) + |> ignore + + + and GenGenericParamPass4 cenv env idx owner (gp: ILGenericParameterDef) = + let gpidx = FindOrAddSharedRow cenv ILTableNames.GenericParam (GetGenericParamAsGenericParamRow cenv env idx owner gp) + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.GenericParam, gpidx) gp.CustomAttrs + gp.Constraints |> Array.iter (GenGenericParamConstraintPass4 cenv env gpidx) + + // -------------------------------------------------------------------- + // param and return --> Param Row + // -------------------------------------------------------------------- + + let rec GetParamAsParamRow cenv _env seq (param: ILParameter) = + let flags = + (if param.IsIn then 0x0001 else 0x0000) ||| + (if param.IsOut then 0x0002 else 0x0000) ||| + (if param.IsOptional then 0x0010 else 0x0000) ||| + (if param.Default.HasValue then 0x1000 else 0x0000) //||| + //(if param.Marshal <> None then 0x2000 else 0x0000) - let rec emitLambda(callSiteIlg : ILGenerator, v : Quotations.Var, body : Quotations.Expr, freeVars : seq, locals : Dictionary<_, LocalBuilder>, parameters) = - let lambda = assemblyMainModule.DefineType(uniqueLambdaTypeName(), TypeAttributes.Class) - let baseType = typedefof>.MakeGenericType(v.Type, body.Type) - lambda.SetParent(baseType) - let ctor = lambda.DefineDefaultConstructor(MethodAttributes.Public) - let decl = baseType.GetMethod "Invoke" - let paramTypes = [| for p in decl.GetParameters() -> p.ParameterType |] - let invoke = lambda.DefineMethod("Invoke", MethodAttributes.Virtual ||| MethodAttributes.Final ||| MethodAttributes.Public, decl.ReturnType, paramTypes) - lambda.DefineMethodOverride(invoke, decl) - - // promote free vars to fields - let fields = ResizeArray() - for v in freeVars do - let f = lambda.DefineField(v.Name, v.Type, FieldAttributes.Assembly) - fields.Add(v, f) - - let copyOfLocals = Dictionary() - - let ilg = invoke.GetILGenerator() - for (v, f) in fields do - let l = ilg.DeclareLocal(v.Type) - ilg.Emit(OpCodes.Ldarg_0) - ilg.Emit(OpCodes.Ldfld, f) - ilg.Emit(OpCodes.Stloc, l) - copyOfLocals.[v] <- l - - let expectedState = if (invoke.ReturnType = typeof) then ExpectedStackState.Empty else ExpectedStackState.Value - emitExpr (ilg, copyOfLocals, [| Quotations.Var("this", lambda); v|]) expectedState body - ilg.Emit(OpCodes.Ret) - - lambda.CreateType() |> ignore - - callSiteIlg.Emit(OpCodes.Newobj, ctor) - for (v, f) in fields do - callSiteIlg.Emit(OpCodes.Dup) - match locals.TryGetValue v with - | true, loc -> - callSiteIlg.Emit(OpCodes.Ldloc, loc) - | false, _ -> - let index = parameters |> Array.findIndex ((=) v) - callSiteIlg.Emit(OpCodes.Ldarg, index) - callSiteIlg.Emit(OpCodes.Stfld, f) - - and emitExpr (ilg: ILGenerator, locals:Dictionary, parameterVars) expectedState expr = - let pop () = ilg.Emit(OpCodes.Pop) - let popIfEmptyExpected s = if isEmpty s then pop() - let emitConvIfNecessary t1 = - if t1 = typeof then - ilg.Emit(OpCodes.Conv_I2) - elif t1 = typeof then - ilg.Emit(OpCodes.Conv_U2) - elif t1 = typeof then - ilg.Emit(OpCodes.Conv_I1) - elif t1 = typeof then - ilg.Emit(OpCodes.Conv_U1) - /// emits given expression to corresponding IL - let rec emit (expectedState : ExpectedStackState) (expr: Quotations.Expr) = - match expr with - | Quotations.Patterns.ForIntegerRangeLoop(loopVar, first, last, body) -> - // for(loopVar = first..last) body - let lb = - match locals.TryGetValue loopVar with - | true, lb -> lb - | false, _ -> - let lb = ilg.DeclareLocal(convType loopVar.Type) - locals.Add(loopVar, lb) - lb - - // loopVar = first - emit ExpectedStackState.Value first - ilg.Emit(OpCodes.Stloc, lb) - - let before = ilg.DefineLabel() - let after = ilg.DefineLabel() - - ilg.MarkLabel before - ilg.Emit(OpCodes.Ldloc, lb) - - emit ExpectedStackState.Value last - ilg.Emit(OpCodes.Bgt, after) - - emit ExpectedStackState.Empty body - - // loopVar++ - ilg.Emit(OpCodes.Ldloc, lb) - ilg.Emit(OpCodes.Ldc_I4_1) - ilg.Emit(OpCodes.Add) - ilg.Emit(OpCodes.Stloc, lb) - - ilg.Emit(OpCodes.Br, before) - ilg.MarkLabel(after) - - | Quotations.Patterns.NewArray(elementTy, elements) -> - ilg.Emit(OpCodes.Ldc_I4, List.length elements) - ilg.Emit(OpCodes.Newarr, convType elementTy) - - elements - |> List.iteri (fun i el -> - ilg.Emit(OpCodes.Dup) - ilg.Emit(OpCodes.Ldc_I4, i) - emit ExpectedStackState.Value el - ilg.Emit(OpCodes.Stelem, convType elementTy) - ) - - popIfEmptyExpected expectedState - - | Quotations.Patterns.WhileLoop(cond, body) -> - let before = ilg.DefineLabel() - let after = ilg.DefineLabel() - - ilg.MarkLabel before - emit ExpectedStackState.Value cond - ilg.Emit(OpCodes.Brfalse, after) - emit ExpectedStackState.Empty body - ilg.Emit(OpCodes.Br, before) - - ilg.MarkLabel after - - | Quotations.Patterns.Var v -> - if isEmpty expectedState then () else - let methIdx = parameterVars |> Array.tryFindIndex (fun p -> p = v) - match methIdx with - | Some idx -> - ilg.Emit((if isAddress expectedState then OpCodes.Ldarga else OpCodes.Ldarg), idx) - | None -> - let implicitCtorArgFieldOpt = implicitCtorArgsAsFields |> List.tryFind (fun f -> f.Name = v.Name) - match implicitCtorArgFieldOpt with - | Some ctorArgField -> - ilg.Emit(OpCodes.Ldarg_0) - ilg.Emit(OpCodes.Ldfld, ctorArgField) - | None -> - match locals.TryGetValue v with - | true, localBuilder -> - ilg.Emit((if isAddress expectedState then OpCodes.Ldloca else OpCodes.Ldloc), localBuilder.LocalIndex) - | false, _ -> - failwith "unknown parameter/field" - - | Quotations.Patterns.Coerce (arg,ty) -> - // castClass may lead to observable side-effects - InvalidCastException - emit ExpectedStackState.Value arg - let argTy = convType arg.Type - let targetTy = convType ty - if argTy.IsValueType && not targetTy.IsValueType then - ilg.Emit(OpCodes.Box, argTy) - elif not argTy.IsValueType && targetTy.IsValueType then - ilg.Emit(OpCodes.Unbox_Any, targetTy) - // emit castclass if - // - targettype is not obj (assume this is always possible for ref types) - // AND - // - HACK: targettype is TypeBuilderInstantiationType - // (its implementation of IsAssignableFrom raises NotSupportedException so it will be safer to always emit castclass) - // OR - // - not (argTy :> targetTy) - elif targetTy <> typeof && (Misc.TypeBuilderInstantiationType.Equals(targetTy.GetType()) || not (targetTy.IsAssignableFrom(argTy))) then - ilg.Emit(OpCodes.Castclass, targetTy) - - popIfEmptyExpected expectedState - | Quotations.DerivedPatterns.SpecificCall <@ (-) @>(None, [t1; t2; _], [a1; a2]) -> - assert(t1 = t2) - emit ExpectedStackState.Value a1 - emit ExpectedStackState.Value a2 - if t1 = typeof then - ilg.Emit(OpCodes.Call, typeof.GetMethod "op_Subtraction") - else - ilg.Emit(OpCodes.Sub) - emitConvIfNecessary t1 + UnsharedRow + [| UShort (uint16 flags) + UShort (uint16 seq) + StringE (GetStringHeapIdxOption cenv param.Name) |] + + and GenParamPass3 cenv env seq (param: ILParameter) = + if not param.IsIn && not param.IsOut && not param.IsOptional && param.Default.IsNone && param.Name.IsNone // && Option.isNone param.Marshal + then () + else + let pidx = AddUnsharedRow cenv ILTableNames.Param (GetParamAsParamRow cenv env seq param) + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.ParamDef, pidx) param.CustomAttrs +#if EMIT_FIELD_MARSHAL + // Write FieldRVA table - fixups into data section done later + match param.Marshal with + | None -> () + | Some ntyp -> + AddUnsharedRow cenv ILTableNames.FieldMarshal + (UnsharedRow [| HasFieldMarshal (hfm_ParamDef, pidx); Blob (GetNativeTypeAsBlobIdx cenv ntyp) |]) |> ignore + // Write Content table for DefaultParameterValue attr +#endif + match param.Default with + | UNone -> () + | USome i -> + AddUnsharedRow cenv ILTableNames.Constant + (UnsharedRow + [| GetFieldInitFlags i + HasConstant (HasConstantTag.ParamDef, pidx) + Blob (GetFieldInitAsBlobIdx cenv i) |]) |> ignore + + let GenReturnAsParamRow (returnv: ILReturn) = + let flags = 0x0000 // || (if returnv.Marshal <> None then 0x2000 else 0x0000) + UnsharedRow + [| UShort (uint16 flags) + UShort 0us (* sequence num. *) + StringE 0 |] + + let GenReturnPass3 cenv (returnv: ILReturn) = + if (* Option.isSome returnv.Marshal || *) not (isEmpty returnv.CustomAttrs.Entries) then + let pidx = AddUnsharedRow cenv ILTableNames.Param (GenReturnAsParamRow returnv) + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.ParamDef, pidx) returnv.CustomAttrs +#if EMIT_MARSHAL + match returnv.Marshal with + | None -> () + | Some ntyp -> + AddUnsharedRow cenv ILTableNames.FieldMarshal + (UnsharedRow + [| HasFieldMarshal (hfm_ParamDef, pidx) + Blob (GetNativeTypeAsBlobIdx cenv ntyp) |]) |> ignore +#endif - popIfEmptyExpected expectedState + // -------------------------------------------------------------------- + // ILMethodDef --> ILMethodDef Row + // -------------------------------------------------------------------- + + let GetMethodDefSigAsBytes cenv env (mdef: ILMethodDef) = + emitBytesViaBuffer (fun bb -> + bb.EmitByte (callconvToByte mdef.GenericParams.Length mdef.CallingConv) + if mdef.GenericParams.Length > 0 then bb.EmitZ32 mdef.GenericParams.Length + bb.EmitZ32 mdef.Parameters.Length + EmitType cenv env bb mdef.Return.Type + mdef.ParameterTypes |> Array.iter (EmitType cenv env bb)) + + let GenMethodDefSigAsBlobIdx cenv env mdef = + GetBytesAsBlobIdx cenv (GetMethodDefSigAsBytes cenv env mdef) + + let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = + let flags = int md.Attributes + let implflags = int md.ImplAttributes + + if md.IsEntryPoint then + if cenv.entrypoint <> None then failwith "duplicate entrypoint" + else cenv.entrypoint <- Some (true, midx) + let codeAddr = + (match md.Body with + | Some ilmbody -> + let addr = cenv.nextCodeAddr + let (localToken, code (* , seqpoints, rootScope *) ) = GenILMethodBody md.Name cenv env ilmbody + +#if EMIT_DEBUG_INFO + // Now record the PDB record for this method - we write this out later. + if cenv.generatePdb then + cenv.pdbinfo.Add + { MethToken=getUncodedToken ILTableNames.Method midx + MethName=md.Name + LocalSignatureToken=localToken + Params= [| |] (* REVIEW *) + RootScope = Some rootScope + Range= + match ilmbody.SourceMarker with + | Some m when cenv.generatePdb -> + // table indexes are 1-based, document array indexes are 0-based + let doc = (cenv.documents.FindOrAddSharedEntry m.Document) - 1 + + Some ({ Document=doc + Line=m.Line + Column=m.Column }, + { Document=doc + Line=m.EndLine + Column=m.EndColumn }) + | _ -> None + SequencePoints=seqpoints } +#endif - | Quotations.DerivedPatterns.SpecificCall <@ (/) @> (None, [t1; t2; _], [a1; a2]) -> - assert (t1 = t2) - emit ExpectedStackState.Value a1 - emit ExpectedStackState.Value a2 - if t1 = typeof then - ilg.Emit(OpCodes.Call, typeof.GetMethod "op_Division") - else - match Type.GetTypeCode t1 with - | TypeCode.UInt32 - | TypeCode.UInt64 - | TypeCode.UInt16 - | TypeCode.Byte - | _ when t1 = typeof -> ilg.Emit (OpCodes.Div_Un) - | _ -> ilg.Emit(OpCodes.Div) - - emitConvIfNecessary t1 - - popIfEmptyExpected expectedState - - | Quotations.DerivedPatterns.SpecificCall <@ int @>(None, [sourceTy], [v]) -> - emit ExpectedStackState.Value v - match Type.GetTypeCode(sourceTy) with - | TypeCode.String -> - ilg.Emit(OpCodes.Call, Misc.ParseInt32Method) - | TypeCode.Single - | TypeCode.Double - | TypeCode.Int64 - | TypeCode.UInt64 - | TypeCode.UInt16 - | TypeCode.Char - | TypeCode.Byte - | _ when sourceTy = typeof || sourceTy = typeof -> - ilg.Emit(OpCodes.Conv_I4) - | TypeCode.Int32 - | TypeCode.UInt32 - | TypeCode.Int16 - | TypeCode.SByte -> () // no op - | _ -> failwith "TODO: search for op_Explicit on sourceTy" - - | Quotations.DerivedPatterns.SpecificCall <@ LanguagePrimitives.IntrinsicFunctions.GetArray @> (None, [ty], [arr; index]) -> - // observable side-effect - IndexOutOfRangeException - emit ExpectedStackState.Value arr - emit ExpectedStackState.Value index - if isAddress expectedState then - ilg.Emit(OpCodes.Readonly) - ilg.Emit(OpCodes.Ldelema, convType ty) - else - ilg.Emit(OpCodes.Ldelem, convType ty) - - popIfEmptyExpected expectedState - - | Quotations.DerivedPatterns.SpecificCall <@ LanguagePrimitives.IntrinsicFunctions.GetArray2D @> (None, _ty, arr::indices) - | Quotations.DerivedPatterns.SpecificCall <@ LanguagePrimitives.IntrinsicFunctions.GetArray3D @> (None, _ty, arr::indices) - | Quotations.DerivedPatterns.SpecificCall <@ LanguagePrimitives.IntrinsicFunctions.GetArray4D @> (None, _ty, arr::indices) -> - - let meth = - let name = if isAddress expectedState then "Address" else "Get" - arr.Type.GetMethod(name) - - // observable side-effect - IndexOutOfRangeException - emit ExpectedStackState.Value arr - for index in indices do - emit ExpectedStackState.Value index - - if isAddress expectedState then - ilg.Emit(OpCodes.Readonly) - - ilg.Emit(OpCodes.Call, meth) - - popIfEmptyExpected expectedState - - | Quotations.Patterns.FieldGet (objOpt,field) -> - match field with - | :? ProvidedLiteralField as plf when plf.DeclaringType.IsEnum -> - if expectedState <> ExpectedStackState.Empty then - emit expectedState (Quotations.Expr.Value(field.GetRawConstantValue(), field.FieldType.GetEnumUnderlyingType())) - | _ -> - match objOpt with - | None -> () - | Some e -> - let s = if e.Type.IsValueType then ExpectedStackState.Address else ExpectedStackState.Value - emit s e - let field = - match field with - | :? ProvidedField as pf when fieldMap.ContainsKey pf -> fieldMap.[pf] :> FieldInfo - | m -> m - if field.IsStatic then - ilg.Emit(OpCodes.Ldsfld, field) - else - ilg.Emit(OpCodes.Ldfld, field) - - | Quotations.Patterns.FieldSet (objOpt,field,v) -> - match objOpt with - | None -> () - | Some e -> - let s = if e.Type.IsValueType then ExpectedStackState.Address else ExpectedStackState.Value - emit s e - emit ExpectedStackState.Value v - let field = match field with :? ProvidedField as pf when fieldMap.ContainsKey pf -> fieldMap.[pf] :> FieldInfo | m -> m - if field.IsStatic then - ilg.Emit(OpCodes.Stsfld, field) - else - ilg.Emit(OpCodes.Stfld, field) - | Quotations.Patterns.Call (objOpt,meth,args) -> - match objOpt with - | None -> () - | Some e -> - let s = if e.Type.IsValueType then ExpectedStackState.Address else ExpectedStackState.Value - emit s e - for pe in args do - emit ExpectedStackState.Value pe - let getMeth (m:MethodInfo) = match m with :? ProvidedMethod as pm when methMap.ContainsKey pm -> methMap.[pm] :> MethodInfo | m -> m - // Handle the case where this is a generic method instantiated at a type being compiled - let mappedMeth = - if meth.IsGenericMethod then - let args = meth.GetGenericArguments() |> Array.map convType - let gmd = meth.GetGenericMethodDefinition() |> getMeth - gmd.GetGenericMethodDefinition().MakeGenericMethod args - elif meth.DeclaringType.IsGenericType then - let gdty = convType (meth.DeclaringType.GetGenericTypeDefinition()) - let gdtym = gdty.GetMethods() |> Seq.find (fun x -> x.Name = meth.Name) - assert (gdtym <> null) // ?? will never happen - if method is not found - KeyNotFoundException will be raised - let dtym = - match convType meth.DeclaringType with - | :? TypeBuilder as dty -> TypeBuilder.GetMethod(dty, gdtym) - | dty -> MethodBase.GetMethodFromHandle(meth.MethodHandle, dty.TypeHandle) :?> _ - - assert (dtym <> null) - dtym + cenv.AddCode code + addr +#if EMIT_DEBUG_INFO + | MethodBody.Abstract -> + // Now record the PDB record for this method - we write this out later. + if cenv.generatePdb then + cenv.pdbinfo.Add + { MethToken = getUncodedToken ILTableNames.Method midx + MethName = md.Name + LocalSignatureToken = 0x0 // No locals it's abstract + Params = [| |] + RootScope = None + Range = None + SequencePoints = [| |] } + 0x0000 + | MethodBody.Native -> + failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries" +#endif + | _ -> 0x0000) + + UnsharedRow + [| ULong codeAddr + UShort (uint16 implflags) + UShort (uint16 flags) + StringE (GetStringHeapIdx cenv md.Name) + Blob (GenMethodDefSigAsBlobIdx cenv env md) + SimpleIndex(ILTableNames.Param, cenv.GetTable(ILTableNames.Param).Count + 1) |] + + let GenMethodImplPass3 cenv env _tgparams tidx mimpl = + let midxTag, midxRow = GetMethodSpecAsMethodDef cenv env (mimpl.OverrideBy, None) + let midx2Tag, midx2Row = GetOverridesSpecAsMethodDefOrRef cenv env mimpl.Overrides + AddUnsharedRow cenv ILTableNames.MethodImpl + (UnsharedRow + [| SimpleIndex (ILTableNames.TypeDef, tidx) + MethodDefOrRef (midxTag, midxRow) + MethodDefOrRef (midx2Tag, midx2Row) |]) |> ignore + + let GenMethodDefPass3 cenv env (md:ILMethodDef) = + let midx = GetMethodDefIdx cenv md + let idx2 = AddUnsharedRow cenv ILTableNames.Method (GenMethodDefAsRow cenv env midx md) + if midx <> idx2 then failwith "index of method def on pass 3 does not match index on pass 2" + GenReturnPass3 cenv md.Return + md.Parameters |> Array.iteri (fun n param -> GenParamPass3 cenv env (n+1) param) + md.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.MethodDef, midx) +#if EMIT_SECURITY_DECLS + md.SecurityDecls.Entries |> GenSecurityDeclsPass3 cenv (hds_MethodDef, midx) +#endif + md.GenericParams |> Array.iteri (fun n gp -> GenGenericParamPass3 cenv env n (TypeOrMethodDefTag.MethodDef, midx) gp) +#if EMIT_PINVOKE + match md.Body.Contents with + | MethodBody.PInvoke attr -> + let flags = + begin match attr.CallingConv with + | PInvokeCallingConvention.None -> 0x0000 + | PInvokeCallingConvention.Cdecl -> 0x0200 + | PInvokeCallingConvention.Stdcall -> 0x0300 + | PInvokeCallingConvention.Thiscall -> 0x0400 + | PInvokeCallingConvention.Fastcall -> 0x0500 + | PInvokeCallingConvention.WinApi -> 0x0100 + end ||| + begin match attr.CharEncoding with + | PInvokeCharEncoding.None -> 0x0000 + | PInvokeCharEncoding.Ansi -> 0x0002 + | PInvokeCharEncoding.Unicode -> 0x0004 + | PInvokeCharEncoding.Auto -> 0x0006 + end ||| + begin match attr.CharBestFit with + | PInvokeCharBestFit.UseAssembly -> 0x0000 + | PInvokeCharBestFit.Enabled -> 0x0010 + | PInvokeCharBestFit.Disabled -> 0x0020 + end ||| + begin match attr.ThrowOnUnmappableChar with + | PInvokeThrowOnUnmappableChar.UseAssembly -> 0x0000 + | PInvokeThrowOnUnmappableChar.Enabled -> 0x1000 + | PInvokeThrowOnUnmappableChar.Disabled -> 0x2000 + end ||| + (if attr.NoMangle then 0x0001 else 0x0000) ||| + (if attr.LastError then 0x0040 else 0x0000) + AddUnsharedRow cenv ILTableNames.ImplMap + (UnsharedRow + [| UShort (uint16 flags) + MemberForwarded (mf_MethodDef, midx) + StringE (GetStringHeapIdx cenv attr.Name) + SimpleIndex (ILTableNames.ModuleRef, GetModuleRefAsIdx cenv attr.Where) |]) |> ignore + | _ -> () +#endif + + let GenMethodDefPass4 cenv env md = + let midx = GetMethodDefIdx cenv md + md.GenericParams |> Array.iteri (fun n gp -> GenGenericParamPass4 cenv env n (TypeOrMethodDefTag.MethodDef, midx) gp) + + let GenPropertyMethodSemanticsPass3 cenv pidx kind mref = + // REVIEW: why are we catching exceptions here? + let midx = try GetMethodRefAsMethodDefIdx cenv mref with MethodDefNotFound -> 1 + AddUnsharedRow cenv ILTableNames.MethodSemantics + (UnsharedRow + [| UShort (uint16 kind) + SimpleIndex (ILTableNames.Method, midx) + HasSemantics (HasSemanticsTag.Property, pidx) |]) |> ignore + + let rec GetPropertySigAsBlobIdx cenv env prop = + GetBytesAsBlobIdx cenv (GetPropertySigAsBytes cenv env prop) + + and GetPropertySigAsBytes cenv env prop = + emitBytesViaBuffer (fun bb -> + let b = ((hasthisToByte prop.CallingConv) ||| e_IMAGE_CEE_CS_CALLCONV_PROPERTY) + bb.EmitByte b + bb.EmitZ32 prop.IndexParameterTypes.Length + EmitType cenv env bb prop.PropertyType + prop.IndexParameterTypes |> Array.iter (EmitType cenv env bb)) + + and GetPropertyAsPropertyRow cenv env (prop:ILPropertyDef) = + let flags = + (if prop.IsSpecialName then 0x0200 else 0x0) ||| + (if prop.IsRTSpecialName then 0x0400 else 0x0) ||| + (if prop.Init <> None then 0x1000 else 0x0) + UnsharedRow + [| UShort (uint16 flags) + StringE (GetStringHeapIdx cenv prop.Name) + Blob (GetPropertySigAsBlobIdx cenv env prop) |] + + /// ILPropertyDef --> Property Row + MethodSemantics entries + and GenPropertyPass3 cenv env prop = + let pidx = AddUnsharedRow cenv ILTableNames.Property (GetPropertyAsPropertyRow cenv env prop) + prop.SetMethod |> Option.iter (GenPropertyMethodSemanticsPass3 cenv pidx 0x0001) + prop.GetMethod |> Option.iter (GenPropertyMethodSemanticsPass3 cenv pidx 0x0002) + // Write Constant table + match prop.Init with + | None -> () + | Some i -> + AddUnsharedRow cenv ILTableNames.Constant + (UnsharedRow + [| GetFieldInitFlags i + HasConstant (HasConstantTag.Property, pidx) + Blob (GetFieldInitAsBlobIdx cenv i) |]) |> ignore + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.Property, pidx) prop.CustomAttrs + + let rec GenEventMethodSemanticsPass3 cenv eidx kind mref = + let addIdx = try GetMethodRefAsMethodDefIdx cenv mref with MethodDefNotFound -> 1 + AddUnsharedRow cenv ILTableNames.MethodSemantics + (UnsharedRow + [| UShort (uint16 kind) + SimpleIndex (ILTableNames.Method, addIdx) + HasSemantics (HasSemanticsTag.Event, eidx) |]) |> ignore + + /// ILEventDef --> Event Row + MethodSemantics entries + and GenEventAsEventRow cenv env (md: ILEventDef) = + let flags = + (if md.IsSpecialName then 0x0200 else 0x0) ||| + (if md.IsRTSpecialName then 0x0400 else 0x0) + let tdorTag, tdorRow = GetTypeAsTypeDefOrRef cenv env md.EventHandlerType + UnsharedRow + [| UShort (uint16 flags) + StringE (GetStringHeapIdx cenv md.Name) + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] + + and GenEventPass3 cenv env (md: ILEventDef) = + let eidx = AddUnsharedRow cenv ILTableNames.Event (GenEventAsEventRow cenv env md) + md.AddMethod |> GenEventMethodSemanticsPass3 cenv eidx 0x0008 + md.RemoveMethod |> GenEventMethodSemanticsPass3 cenv eidx 0x0010 + //Option.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0020) md.FireMethod + //List.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0004) md.OtherMethods + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.Event, eidx) md.CustomAttrs + + + // -------------------------------------------------------------------- + // resource --> generate ... + // -------------------------------------------------------------------- + + let rec GetResourceAsManifestResourceRow cenv r = + let data, impl = + match r.Location with + | ILResourceLocation.Local bf -> + let b = bf() + // Embedded managed resources must be word-aligned. However resource format is + // not specified in ECMA. Some mscorlib resources appear to be non-aligned - it seems it doesn't matter.. + let offset = cenv.resources.Position + let alignedOffset = (align 0x8 offset) + let pad = alignedOffset - offset + let resourceSize = b.Length + cenv.resources.EmitPadding pad + cenv.resources.EmitInt32 resourceSize + cenv.resources.EmitBytes b + Data (alignedOffset, true), (ImplementationTag.File, 0) + | ILResourceLocation.File (mref, offset) -> ULong offset, (ImplementationTag.File, GetModuleRefAsFileIdx cenv mref) + | ILResourceLocation.Assembly aref -> ULong 0x0, (ImplementationTag.AssemblyRef, GetAssemblyRefAsIdx cenv aref) + UnsharedRow + [| data + ULong (match r.Access with ILResourceAccess.Public -> 0x01 | ILResourceAccess.Private -> 0x02) + StringE (GetStringHeapIdx cenv r.Name) + Implementation (fst impl, snd impl) |] + + and GenResourcePass3 cenv r = + let idx = AddUnsharedRow cenv ILTableNames.ManifestResource (GetResourceAsManifestResourceRow cenv r) + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.ManifestResource, idx) r.CustomAttrs + + // -------------------------------------------------------------------- + // ILTypeDef --> generate ILFieldDef, ILMethodDef, ILPropertyDef etc. rows + // -------------------------------------------------------------------- + + let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) = + try + let env = envForTypeDef td + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Namespace, td.Name)) + td.Properties.Entries |> Array.iter (GenPropertyPass3 cenv env) + td.Events.Entries |> Array.iter (GenEventPass3 cenv env) + td.Fields.Entries |> Array.iter (GenFieldDefPass3 cenv env) + td.Methods.Entries |> Array.iter (GenMethodDefPass3 cenv env) + td.MethodImpls.Entries |> Array.iter (GenMethodImplPass3 cenv env td.GenericParams.Length tidx) + // ClassLayout entry if needed + match td.Layout with + | ILTypeDefLayout.Auto -> () + | ILTypeDefLayout.Sequential layout | ILTypeDefLayout.Explicit layout -> + if Option.isSome layout.Pack || Option.isSome layout.Size then + AddUnsharedRow cenv ILTableNames.ClassLayout + (UnsharedRow + [| UShort (defaultArg layout.Pack (uint16 0x0)) + ULong (defaultArg layout.Size 0x0) + SimpleIndex (ILTableNames.TypeDef, tidx) |]) |> ignore + +#if EMIT_SECURITY_DECLS + td.SecurityDecls.Entries |> GenSecurityDeclsPass3 cenv (hds_TypeDef, tidx) +#endif + td.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.TypeDef, tidx) + td.GenericParams |> Array.iteri (fun n gp -> GenGenericParamPass3 cenv env n (TypeOrMethodDefTag.TypeDef, tidx) gp) + td.NestedTypes.Entries |> GenTypeDefsPass3 (addILTypeName enc td) cenv + with e -> + failwith ("Error in pass3 for type "+td.Name+", error: "+e.ToString()) + reraise() + raise e + + and GenTypeDefsPass3 enc cenv tds = + Array.iter (GenTypeDefPass3 enc cenv) tds + + /// ILTypeDef --> generate generic params on ILMethodDef: ensures + /// GenericParam table is built sorted by owner. + + let rec GenTypeDefPass4 enc cenv (td:ILTypeDef) = + try + let env = envForTypeDef td + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Namespace, td.Name)) + td.Methods.Entries |> Array.iter (GenMethodDefPass4 cenv env) + td.GenericParams |> Array.iteri (fun n gp -> GenGenericParamPass4 cenv env n (TypeOrMethodDefTag.TypeDef, tidx) gp) + GenTypeDefsPass4 (addILTypeName enc td) cenv td.NestedTypes.Entries + with e -> + failwith ("Error in pass4 for type "+td.Name+", error: "+e.Message) + reraise() + raise e + + and GenTypeDefsPass4 enc cenv tds = + Array.iter (GenTypeDefPass4 enc cenv) tds + + + let DateTime1970Jan01 = new System.DateTime(1970, 1, 1, 0, 0, 0, System.DateTimeKind.Utc) (* ECMA Spec (Oct2002), Part II, 24.2.2 PE File Header. *) + let timestamp = (System.DateTime.UtcNow - DateTime1970Jan01).TotalSeconds |> int + + // -------------------------------------------------------------------- + // ILExportedTypesAndForwarders --> ILExportedTypeOrForwarder table + // -------------------------------------------------------------------- + + let rec GenNestedExportedTypePass3 cenv cidx (ce: ILNestedExportedType) = + let flags = GetMemberAccessFlags ce.Access + let nidx = + AddUnsharedRow cenv ILTableNames.ExportedType + (UnsharedRow + [| ULong flags + ULong 0x0 + StringE (GetStringHeapIdx cenv ce.Name) + StringE 0 + Implementation (ImplementationTag.ExportedType, cidx) |]) + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.ExportedType, nidx) ce.CustomAttrs + GenNestedExportedTypesPass3 cenv nidx ce.Nested + + and GenNestedExportedTypesPass3 cenv nidx (nce: ILNestedExportedTypesAndForwarders) = + nce.Entries |> Array.iter (GenNestedExportedTypePass3 cenv nidx) + + and GenExportedTypePass3 cenv (ce: ILExportedTypeOrForwarder) = + let nselem, nelem = GetTypeNameAsElemPair cenv (ce.Namespace, ce.Name) + let flags = GetTypeAccessFlags ce.Access + let flags = if ce.IsForwarder then 0x00200000 ||| flags else flags + let impl = GetScopeRefAsImplementationElem cenv ce.ScopeRef + let cidx = + AddUnsharedRow cenv ILTableNames.ExportedType + (UnsharedRow + [| ULong flags + ULong 0x0 + nelem + nselem + Implementation (fst impl, snd impl) |]) + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.ExportedType, cidx) ce.CustomAttrs + GenNestedExportedTypesPass3 cenv cidx ce.Nested + + + + // -------------------------------------------------------------------- + // manifest --> generate Assembly row + // -------------------------------------------------------------------- + + and GetManifsetAsAssemblyRow cenv m = + UnsharedRow + [|ULong m.AuxModuleHashAlgorithm + UShort (match m.Version with UNone -> 0us | USome v -> uint16 v.Major) + UShort (match m.Version with UNone -> 0us | USome v -> uint16 v.Minor) + UShort (match m.Version with UNone -> 0us | USome v -> uint16 v.Build) + UShort (match m.Version with UNone -> 0us | USome v -> uint16 v.Revision) + ULong + ( //(match m.AssemblyLongevity with + //| ILAssemblyLongevity.Unspecified -> 0x0000 + //| ILAssemblyLongevity.Library -> 0x0002 + //| ILAssemblyLongevity.PlatformAppDomain -> 0x0004 + // | ILAssemblyLongevity.PlatformProcess -> 0x0006 + // | ILAssemblyLongevity.PlatformSystem -> 0x0008) ||| + (if m.Retargetable then 0x100 else 0x0) ||| + // Setting these causes peverify errors. Hence both ilread and ilwrite ignore them and refuse to set them. + // Any debugging customattributes will automatically propagate + // REVIEW: No longer appears to be the case + (if m.JitTracking then 0x8000 else 0x0) ||| + (match m.PublicKey with UNone -> 0x0000 | USome _ -> 0x0001) ||| 0x0000) + (match m.PublicKey with UNone -> Blob 0 | USome x -> Blob (GetBytesAsBlobIdx cenv x)) + StringE (GetStringHeapIdx cenv m.Name) + (match m.Locale with UNone -> StringE 0 | USome x -> StringE (GetStringHeapIdx cenv x)) |] + + and GenManifestPass3 cenv m = + let aidx = AddUnsharedRow cenv ILTableNames.Assembly (GetManifsetAsAssemblyRow cenv m) +#if EMIT_SECURITY_DECLS + GenSecurityDeclsPass3 cenv (hds_Assembly, aidx) m.SecurityDecls.Entries +#endif + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.Assembly, aidx) m.CustomAttrs + m.ExportedTypes.Entries |> Array.iter (GenExportedTypePass3 cenv) + // Record the entrypoint decl if needed. + match m.EntrypointElsewhere with + | Some mref -> + if cenv.entrypoint <> None then failwith "duplicate entrypoint" + else cenv.entrypoint <- Some (false, GetModuleRefAsIdx cenv mref) + | None -> () + + and newGuid (modul: ILModuleDef) = + let n = timestamp + let m = hash n + let m2 = hash modul.Name + [| b0 m; b1 m; b2 m; b3 m; b0 m2; b1 m2; b2 m2; b3 m2; 0xa7uy; 0x45uy; 0x03uy; 0x83uy; b0 n; b1 n; b2 n; b3 n |] + + and deterministicGuid (modul: ILModuleDef) = + let n = 16909060 + let m = hash n + let m2 = hash modul.Name + [| b0 m; b1 m; b2 m; b3 m; b0 m2; b1 m2; b2 m2; b3 m2; 0xa7uy; 0x45uy; 0x03uy; 0x83uy; b0 n; b1 n; b2 n; b3 n |] + + and GetModuleAsRow (cenv:cenv) (modul: ILModuleDef) = + // Store the generated MVID in the environment (needed for generating debug information) + let modulGuid = if cenv.deterministic then deterministicGuid modul else newGuid modul + cenv.moduleGuid <- modulGuid + UnsharedRow + [| UShort (uint16 0x0) + StringE (GetStringHeapIdx cenv modul.Name) + Guid (GetGuidIdx cenv modulGuid) + Guid 0 + Guid 0 |] + + + let rowElemCompare (e1: RowElement) (e2: RowElement) = + let c = compare e1.Val e2.Val + if c <> 0 then c else + compare e1.Tag e2.Tag + + module List = + let rec assoc x l = + match l with + | [] -> failwith "index not found" + | ((h, r)::t) -> if x = h then r else assoc x t + + let rec memAssoc x l = + match l with + | [] -> false + | ((h, _)::t) -> x = h || memAssoc x t + + let TableRequiresSorting tab = + List.memAssoc tab ILTableNames.sortedTableInfo + + let SortTableRows tab (rows:GenericRow[]) = + assert (TableRequiresSorting tab) + let col = List.assoc tab ILTableNames.sortedTableInfo + rows + // This needs to be a stable sort, so we use List.sortWith + |> Array.toList + |> List.sortWith (fun r1 r2 -> rowElemCompare r1.[col] r2.[col]) + |> Array.ofList + //|> Array.map SharedRow + + + let mkILSimpleClass (ilg: ILGlobals) (nsp, nm, methods, fields, nestedTypes, props, events, attrs) = + { Namespace=nsp + Name=nm + GenericParams= [| |] + Implements = [| |] + Attributes = TypeAttributes.Class ||| TypeAttributes.BeforeFieldInit ||| TypeAttributes.Public + Layout=ILTypeDefLayout.Auto + Extends = Some ilg.typ_Object + Methods= methods + Fields= fields + NestedTypes=nestedTypes + CustomAttrs=attrs + MethodImpls=emptyILMethodImpls + Properties=props + Events=events + Token=0 + //SecurityDecls=emptyILSecurityDecls; + //HasSecurity=false; + } + let mkILTypeDefForGlobalFunctions ilg (methods, fields) = + mkILSimpleClass ilg (UNone, typeNameForGlobalFunctions, methods, fields, emptyILTypeDefs, emptyILProperties, emptyILEvents, emptyILCustomAttrs) + + let destTypeDefsWithGlobalFunctionsFirst ilg (tdefs: ILTypeDefs) = + let l = tdefs.Entries + let top, nontop = l |> Array.partition (fun td -> td.Name = typeNameForGlobalFunctions) + let top2 = if isEmpty top then [| mkILTypeDefForGlobalFunctions ilg (emptyILMethods, emptyILFields) |] else top + Array.append top2 nontop + + let GenModule (cenv: cenv) (modul: ILModuleDef) = + let midx = AddUnsharedRow cenv ILTableNames.Module (GetModuleAsRow cenv modul) + Array.iter (GenResourcePass3 cenv) modul.Resources.Entries + let tds = destTypeDefsWithGlobalFunctionsFirst cenv.ilg modul.TypeDefs + GenTypeDefsPass1 [] cenv tds + GenTypeDefsPass2 0 [] cenv tds + (match modul.Manifest with None -> () | Some m -> GenManifestPass3 cenv m) + GenTypeDefsPass3 [] cenv tds + GenCustomAttrsPass3Or4 cenv (HasCustomAttributeTag.Module, midx) modul.CustomAttrs + // GenericParam is the only sorted table indexed by Columns in other tables (GenericParamConstraint\CustomAttributes). + // Hence we need to sort it before we emit any entries in GenericParamConstraint\CustomAttributes that are attached to generic params. + // Note this mutates the rows in a table. 'SetRowsOfTable' clears + // the key --> index map since it is no longer valid + cenv.GetTable(ILTableNames.GenericParam).SetRowsOfSharedTable (SortTableRows ILTableNames.GenericParam (cenv.GetTable(ILTableNames.GenericParam).GenericRowsOfTable)) + GenTypeDefsPass4 [] cenv tds + + let generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg: ILGlobals, emitTailcalls, deterministic, showTimes) (m: ILModuleDef) cilStartAddress = + let isDll = m.IsDLL + + let cenv = + { emitTailcalls=emitTailcalls + deterministic = deterministic + showTimes=showTimes + ilg = ilg + desiredMetadataVersion=desiredMetadataVersion + requiredDataFixups= requiredDataFixups + requiredStringFixups = ResizeArray() + codeChunks=ByteBuffer.Create 40000 + nextCodeAddr = cilStartAddress + data = ByteBuffer.Create 200 + resources = ByteBuffer.Create 200 + tables= + Array.init 64 (fun i -> + if (i = ILTableNames.AssemblyRef.Index || + i = ILTableNames.MemberRef.Index || + i = ILTableNames.ModuleRef.Index || + i = ILTableNames.File.Index || + i = ILTableNames.TypeRef.Index || + i = ILTableNames.TypeSpec.Index || + i = ILTableNames.MethodSpec.Index || + i = ILTableNames.StandAloneSig.Index || + i = ILTableNames.GenericParam.Index) then + MetadataTable.Shared (MetadataTable.New ("row table "+string i, EqualityComparer.Default)) else - getMeth meth - match objOpt with - | Some obj when mappedMeth.IsAbstract || mappedMeth.IsVirtual -> - if obj.Type.IsValueType then ilg.Emit(OpCodes.Constrained, convType obj.Type) - ilg.Emit(OpCodes.Callvirt, mappedMeth) - | _ -> - ilg.Emit(OpCodes.Call, mappedMeth) - - let returnTypeIsVoid = mappedMeth.ReturnType = typeof - match returnTypeIsVoid, (isEmpty expectedState) with - | false, true -> - // method produced something, but we don't need it - pop() - | true, false when expr.Type = typeof -> - // if we need result and method produce void and result should be unit - push null as unit value on stack - ilg.Emit(OpCodes.Ldnull) - | _ -> () + MetadataTable.Unshared (MetadataTable.New ("row table "+string i, EqualityComparer.Default))) - | Quotations.Patterns.NewObject (ctor,args) -> - for pe in args do - emit ExpectedStackState.Value pe - let meth = match ctor with :? ProvidedConstructor as pc when ctorMap.ContainsKey pc -> ctorMap.[pc] :> ConstructorInfo | c -> c - ilg.Emit(OpCodes.Newobj, meth) - - popIfEmptyExpected expectedState - - | Quotations.Patterns.Value (obj, _ty) -> - let rec emitC (v:obj) = - match v with - | :? string as x -> ilg.Emit(OpCodes.Ldstr, x) - | :? int8 as x -> ilg.Emit(OpCodes.Ldc_I4, int32 x) - | :? uint8 as x -> ilg.Emit(OpCodes.Ldc_I4, int32 (int8 x)) - | :? int16 as x -> ilg.Emit(OpCodes.Ldc_I4, int32 x) - | :? uint16 as x -> ilg.Emit(OpCodes.Ldc_I4, int32 (int16 x)) - | :? int32 as x -> ilg.Emit(OpCodes.Ldc_I4, x) - | :? uint32 as x -> ilg.Emit(OpCodes.Ldc_I4, int32 x) - | :? int64 as x -> ilg.Emit(OpCodes.Ldc_I8, x) - | :? uint64 as x -> ilg.Emit(OpCodes.Ldc_I8, int64 x) - | :? char as x -> ilg.Emit(OpCodes.Ldc_I4, int32 x) - | :? bool as x -> ilg.Emit(OpCodes.Ldc_I4, if x then 1 else 0) - | :? float32 as x -> ilg.Emit(OpCodes.Ldc_R4, x) - | :? float as x -> ilg.Emit(OpCodes.Ldc_R8, x) -#if FX_NO_GET_ENUM_UNDERLYING_TYPE + AssemblyRefs = MetadataTable<_>.New("ILAssemblyRef", EqualityComparer.Default) + //documents=MetadataTable<_>.New("pdbdocs", EqualityComparer.Default) + trefCache=new Dictionary<_, _>(100) +#if EMIT_DEBUG_INFO + pdbinfo= new ResizeArray<_>(200) +#endif + moduleGuid= Array.zeroCreate 16 + fieldDefs= MetadataTable<_>.New("field defs", EqualityComparer.Default) + methodDefIdxsByKey = MetadataTable<_>.New("method defs", EqualityComparer.Default) + // This uses reference identity on ILMethodDef objects + methodDefIdxs = new Dictionary<_, _>(100, HashIdentity.Reference) + propertyDefs = MetadataTable<_>.New("property defs", EqualityComparer.Default) + eventDefs = MetadataTable<_>.New("event defs", EqualityComparer.Default) + typeDefs = MetadataTable<_>.New("type defs", EqualityComparer.Default) + entrypoint=None + generatePdb=generatePdb + // These must use structural comparison since they are keyed by arrays + guids=MetadataTable<_>.New("guids", HashIdentity.Structural) + blobs= MetadataTable<_>.New("blobs", HashIdentity.Structural) + strings= MetadataTable<_>.New("strings", EqualityComparer.Default) + userStrings= MetadataTable<_>.New("user strings", EqualityComparer.Default) } + + // Now the main compilation step + GenModule cenv m + + // .exe files have a .entrypoint instruction. Do not write it to the entrypoint when writing dll. + let entryPointToken = + match cenv.entrypoint with + | Some (epHere, tok) -> + if isDll then 0x0 + else getUncodedToken (if epHere then ILTableNames.Method else ILTableNames.File) tok + | None -> + if not isDll then printfn "warning: no entrypoint specified in executable binary" + 0x0 + +#if EMIT_DEBUG_INFO + let pdbData = + { EntryPoint= (if isDll then None else Some entryPointToken) + Timestamp = timestamp + ModuleID = cenv.moduleGuid + Documents = cenv.documents.EntriesAsArray + Methods = cenv.pdbinfo.ToArray() + TableRowCounts = cenv.tables |> Seq.map(fun t -> t.Count) |> Seq.toArray } #else - | :? System.Enum as x when x.GetType().GetEnumUnderlyingType() = typeof -> ilg.Emit(OpCodes.Ldc_I4, unbox v) + let pdbData = () #endif - | :? Type as ty -> - ilg.Emit(OpCodes.Ldtoken, convType ty) - ilg.Emit(OpCodes.Call, Misc.GetTypeFromHandleMethod) - | :? decimal as x -> - let bits = System.Decimal.GetBits x - ilg.Emit(OpCodes.Ldc_I4, bits.[0]) - ilg.Emit(OpCodes.Ldc_I4, bits.[1]) - ilg.Emit(OpCodes.Ldc_I4, bits.[2]) - do - let sign = (bits.[3] &&& 0x80000000) <> 0 - ilg.Emit(if sign then OpCodes.Ldc_I4_1 else OpCodes.Ldc_I4_0) - do - let scale = byte ((bits.[3] >>> 16) &&& 0x7F) - ilg.Emit(OpCodes.Ldc_I4_S, scale) - ilg.Emit(OpCodes.Newobj, Misc.DecimalConstructor) - | :? DateTime as x -> - ilg.Emit(OpCodes.Ldc_I8, x.Ticks) - ilg.Emit(OpCodes.Ldc_I4, int x.Kind) - ilg.Emit(OpCodes.Newobj, Misc.DateTimeConstructor) - | :? DateTimeOffset as x -> - ilg.Emit(OpCodes.Ldc_I8, x.Ticks) - ilg.Emit(OpCodes.Ldc_I8, x.Offset.Ticks) - ilg.Emit(OpCodes.Newobj, Misc.TimeSpanConstructor) - ilg.Emit(OpCodes.Newobj, Misc.DateTimeOffsetConstructor) - | null -> ilg.Emit(OpCodes.Ldnull) - | _ -> failwithf "unknown constant '%A' in generated method" v - if isEmpty expectedState then () - else emitC obj - - | Quotations.Patterns.Let(v,e,b) -> - let lb = ilg.DeclareLocal (convType v.Type) - locals.Add (v, lb) - emit ExpectedStackState.Value e - ilg.Emit(OpCodes.Stloc, lb.LocalIndex) - emit expectedState b - - | Quotations.Patterns.Sequential(e1, e2) -> - emit ExpectedStackState.Empty e1 - emit expectedState e2 - - | Quotations.Patterns.IfThenElse(cond, ifTrue, ifFalse) -> - let ifFalseLabel = ilg.DefineLabel() - let endLabel = ilg.DefineLabel() - - emit ExpectedStackState.Value cond - - ilg.Emit(OpCodes.Brfalse, ifFalseLabel) - - emit expectedState ifTrue - ilg.Emit(OpCodes.Br, endLabel) - - ilg.MarkLabel(ifFalseLabel) - emit expectedState ifFalse - - ilg.Emit(OpCodes.Nop) - ilg.MarkLabel(endLabel) - - | Quotations.Patterns.TryWith(body, _filterVar, _filterBody, catchVar, catchBody) -> - - let stres, ldres = - if isEmpty expectedState then ignore, ignore - else - let local = ilg.DeclareLocal (convType body.Type) - let stres = fun () -> ilg.Emit(OpCodes.Stloc, local) - let ldres = fun () -> ilg.Emit(OpCodes.Ldloc, local) - stres, ldres - - let exceptionVar = ilg.DeclareLocal(convType catchVar.Type) - locals.Add(catchVar, exceptionVar) - - let _exnBlock = ilg.BeginExceptionBlock() - - emit expectedState body - stres() - - ilg.BeginCatchBlock(convType catchVar.Type) - ilg.Emit(OpCodes.Stloc, exceptionVar) - emit expectedState catchBody - stres() - ilg.EndExceptionBlock() - - ldres() - - | Quotations.Patterns.VarSet(v,e) -> - emit ExpectedStackState.Value e - match locals.TryGetValue v with - | true, localBuilder -> - ilg.Emit(OpCodes.Stloc, localBuilder.LocalIndex) - | false, _ -> - failwith "unknown parameter/field in assignment. Only assignments to locals are currently supported by TypeProviderEmit" - | Quotations.Patterns.Lambda(v, body) -> - emitLambda(ilg, v, body, expr.GetFreeVars(), locals, parameterVars) - popIfEmptyExpected expectedState - | n -> - failwith (sprintf "unknown expression '%A' in generated method" n) - emit expectedState expr - - - // Emit the constructor (if any) - for pcinfo in ctors do - assert ctorMap.ContainsKey pcinfo - let cb = ctorMap.[pcinfo] - let cattr = pcinfo.GetCustomAttributesDataImpl() - defineCustomAttrs cb.SetCustomAttribute cattr - let ilg = cb.GetILGenerator() - let locals = Dictionary() - let parameterVars = - [| yield Quotations.Var("this", pcinfo.DeclaringType) - for p in pcinfo.GetParameters() do - yield Quotations.Var(p.Name, p.ParameterType) |] - let parameters = - [| for v in parameterVars -> Quotations.Expr.Var v |] - match pcinfo.GetBaseConstructorCallInternal true with - | None -> - ilg.Emit(OpCodes.Ldarg_0) - let cinfo = ptd.BaseType.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance, null, [| |], null) - ilg.Emit(OpCodes.Call,cinfo) - | Some f -> - // argExprs should always include 'this' - let (cinfo,argExprs) = f (Array.toList parameters) - for argExpr in argExprs do - emitExpr (ilg, locals, parameterVars) ExpectedStackState.Value argExpr - ilg.Emit(OpCodes.Call,cinfo) - - if pcinfo.IsImplicitCtor then - for ctorArgsAsFieldIdx,ctorArgsAsField in List.mapi (fun i x -> (i,x)) implicitCtorArgsAsFields do - ilg.Emit(OpCodes.Ldarg_0) - ilg.Emit(OpCodes.Ldarg, ctorArgsAsFieldIdx+1) - ilg.Emit(OpCodes.Stfld, ctorArgsAsField) - else - let code = pcinfo.GetInvokeCodeInternal true - let code = code parameters - emitExpr (ilg, locals, parameterVars) ExpectedStackState.Empty code - ilg.Emit(OpCodes.Ret) + + let idxForNextedTypeDef (tds:ILTypeDef list, td:ILTypeDef) = + let enc = tds |> List.map (fun td -> td.Name) + GetIdxForTypeDef cenv (TdKey(enc, td.Namespace, td.Name)) + + let strings = Array.map Bytes.stringAsUtf8NullTerminated cenv.strings.EntriesAsArray + let userStrings = cenv.userStrings.EntriesAsArray |> Array.map Encoding.Unicode.GetBytes + let blobs = cenv.blobs.EntriesAsArray + let guids = cenv.guids.EntriesAsArray + let tables = cenv.tables + let code = cenv.GetCode() + // turn idx tbls into token maps + let mappings = + { TypeDefTokenMap = (fun t -> + getUncodedToken ILTableNames.TypeDef (idxForNextedTypeDef t)) + FieldDefTokenMap = (fun t fd -> + let tidx = idxForNextedTypeDef t + getUncodedToken ILTableNames.Field (GetFieldDefAsFieldDefIdx cenv tidx fd)) + MethodDefTokenMap = (fun t md -> + let tidx = idxForNextedTypeDef t + getUncodedToken ILTableNames.Method (FindMethodDefIdx cenv (GetKeyForMethodDef tidx md))) + PropertyTokenMap = (fun t pd -> + let tidx = idxForNextedTypeDef t + getUncodedToken ILTableNames.Property (cenv.propertyDefs.GetTableEntry (GetKeyForPropertyDef tidx pd))) + EventTokenMap = (fun t ed -> + let tidx = idxForNextedTypeDef t + getUncodedToken ILTableNames.Event (cenv.eventDefs.GetTableEntry (EventKey (tidx, ed.Name)))) } + // New return the results + let data = cenv.data.Close() + let resources = cenv.resources.Close() + (strings, userStrings, blobs, guids, tables, entryPointToken, code, cenv.requiredStringFixups, data, resources, pdbData, mappings) + + + //===================================================================== + // TABLES+BLOBS --> PHYSICAL METADATA+BLOBS + //===================================================================== + let chunk sz next = ({addr=next; size=sz}, next + sz) + let nochunk next = ({addr= 0x0;size= 0x0; } , next) + + let count f arr = + Array.fold (fun x y -> x + f y) 0x0 arr + + let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailcalls, deterministic, showTimes) modul cilStartAddress = + + // When we know the real RVAs of the data section we fixup the references for the FieldRVA table. + // These references are stored as offsets into the metadata we return from this function + let requiredDataFixups = ResizeArray() + + let next = cilStartAddress + + let strings, userStrings, blobs, guids, tables, entryPointToken, code, requiredStringFixups, data, resources, pdbData, mappings = + generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg, emitTailcalls, deterministic, showTimes) modul cilStartAddress + + let tableSize (tab: ILTableName) = tables.[tab.Index].Count + + // Now place the code + let codeSize = code.Length + let alignedCodeSize = align 0x4 codeSize + let codep, next = chunk codeSize next + let codePadding = Array.create (alignedCodeSize - codeSize) 0x0uy + let _codePaddingChunk, next = chunk codePadding.Length next + + // Now layout the chunks of metadata and IL + let metadataHeaderStartChunk, _next = chunk 0x10 next + + let numStreams = 0x05 + + let (mdtableVersionMajor, mdtableVersionMinor) = metadataSchemaVersionSupportedByCLRVersion desiredMetadataVersion + + let version = + Encoding.UTF8.GetBytes (sprintf "v%d.%d.%d" desiredMetadataVersion.Major desiredMetadataVersion.Minor desiredMetadataVersion.Build) + + + let paddedVersionLength = align 0x4 (Array.length version) + + // Most addresses after this point are measured from the MD root + // Switch to md-rooted addresses + let next = metadataHeaderStartChunk.size + let _metadataHeaderVersionChunk, next = chunk paddedVersionLength next + let _metadataHeaderEndChunk, next = chunk 0x04 next + let _tablesStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#~".Length + 0x01))) next + let _stringsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#Strings".Length + 0x01))) next + let _userStringsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#US".Length + 0x01))) next + let _guidsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#GUID".Length + 0x01))) next + let _blobsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#Blob".Length + 0x01))) next + + let tablesStreamStart = next + + let stringsStreamUnpaddedSize = count (fun (s:byte[]) -> s.Length) strings + 1 + let stringsStreamPaddedSize = align 4 stringsStreamUnpaddedSize - match ptd.GetConstructors(ALL) |> Seq.tryPick (function :? ProvidedConstructor as pc when pc.IsTypeInitializer -> Some pc | _ -> None) with - | None -> () - | Some pc -> - let cb = ctorMap.[pc] - let ilg = cb.GetILGenerator() - let cattr = pc.GetCustomAttributesDataImpl() - defineCustomAttrs cb.SetCustomAttribute cattr - let expr = pc.GetInvokeCodeInternal true [||] - emitExpr(ilg, new Dictionary<_, _>(), [||]) ExpectedStackState.Empty expr - ilg.Emit OpCodes.Ret - - // Emit the methods - for minfo in ptd.GetMethods(ALL) do - match minfo with - | :? ProvidedMethod as pminfo -> - let mb = methMap.[pminfo] - let ilg = mb.GetILGenerator() - let cattr = pminfo.GetCustomAttributesDataImpl() - defineCustomAttrs mb.SetCustomAttribute cattr - - let parameterVars = - [| if not pminfo.IsStatic then - yield Quotations.Var("this", pminfo.DeclaringType) - for p in pminfo.GetParameters() do - yield Quotations.Var(p.Name, p.ParameterType) |] - let parameters = - [| for v in parameterVars -> Quotations.Expr.Var v |] - - let expr = pminfo.GetInvokeCodeInternal true parameters - - let locals = Dictionary() - //printfn "Emitting linqCode for %s::%s, code = %s" pminfo.DeclaringType.FullName pminfo.Name (try linqCode.ToString() with _ -> "") - - - let expectedState = if (minfo.ReturnType = typeof) then ExpectedStackState.Empty else ExpectedStackState.Value - emitExpr (ilg, locals, parameterVars) expectedState expr - ilg.Emit OpCodes.Ret - | _ -> () - - for (bodyMethInfo,declMethInfo) in ptd.GetMethodOverrides() do - let bodyMethBuilder = methMap.[bodyMethInfo] - tb.DefineMethodOverride(bodyMethBuilder,declMethInfo) - - for evt in ptd.GetEvents(ALL) |> Seq.choose (function :? ProvidedEvent as pe -> Some pe | _ -> None) do - let eb = tb.DefineEvent(evt.Name, evt.Attributes, evt.EventHandlerType) - defineCustomAttrs eb.SetCustomAttribute (evt.GetCustomAttributesDataImpl()) - eb.SetAddOnMethod(methMap.[evt.GetAddMethod(true) :?> _]) - eb.SetRemoveOnMethod(methMap.[evt.GetRemoveMethod(true) :?> _]) - // TODO: add raiser + let userStringsStreamUnpaddedSize = count (fun (s:byte[]) -> let n = s.Length + 1 in n + ByteBuffer.Z32Size n) userStrings + 1 + let userStringsStreamPaddedSize = align 4 userStringsStreamUnpaddedSize + + let guidsStreamUnpaddedSize = (Array.length guids) * 0x10 + let guidsStreamPaddedSize = align 4 guidsStreamUnpaddedSize + + let blobsStreamUnpaddedSize = count (fun (blob:byte[]) -> let n = blob.Length in n + ByteBuffer.Z32Size n) blobs + 1 + let blobsStreamPaddedSize = align 4 blobsStreamUnpaddedSize + + let guidsBig = guidsStreamPaddedSize >= 0x10000 + let stringsBig = stringsStreamPaddedSize >= 0x10000 + let blobsBig = blobsStreamPaddedSize >= 0x10000 + + // 64bit bitvector indicating which tables are in the metadata. + let (valid1, valid2), _ = + (((0, 0), 0), tables) ||> Array.fold (fun ((valid1, valid2) as valid, n) rows -> + let valid = + if rows.Count = 0 then valid else + ( (if n < 32 then valid1 ||| (1 <<< n ) else valid1), + (if n >= 32 then valid2 ||| (1 <<< (n-32)) else valid2) ) + (valid, n+1)) + + // 64bit bitvector indicating which tables are sorted. + // Constant - REVIEW: make symbolic! compute from sorted table info! + let sorted1 = 0x3301fa00 + let sorted2 = + // If there are any generic parameters in the binary we're emitting then mark that + // table as sorted, otherwise don't. This maximizes the number of assemblies we emit + // which have an ECMA-v.1. compliant set of sorted tables. + (if tableSize (ILTableNames.GenericParam) > 0 then 0x00000400 else 0x00000000) ||| + (if tableSize (ILTableNames.GenericParamConstraint) > 0 then 0x00001000 else 0x00000000) ||| + 0x00000200 - for pinfo in ptd.GetProperties(ALL) |> Seq.choose (function :? ProvidedProperty as pe -> Some pe | _ -> None) do - let pb = tb.DefineProperty(pinfo.Name, pinfo.Attributes, convType pinfo.PropertyType, [| for p in pinfo.GetIndexParameters() -> convType p.ParameterType |]) - let cattr = pinfo.GetCustomAttributesDataImpl() - defineCustomAttrs pb.SetCustomAttribute cattr - if pinfo.CanRead then - let minfo = pinfo.GetGetMethod(true) - pb.SetGetMethod (methMap.[minfo :?> ProvidedMethod ]) - if pinfo.CanWrite then - let minfo = pinfo.GetSetMethod(true) - pb.SetSetMethod (methMap.[minfo :?> ProvidedMethod ])) + let guidAddress n = (if n = 0 then 0 else (n - 1) * 0x10 + 0x01) - // phase 4 - complete types - iterateTypes (fun tb _ptd -> tb.CreateType() |> ignore) + let stringAddressTable = + let tab = Array.create (strings.Length + 1) 0 + let pos = ref 1 + for i = 1 to strings.Length do + tab.[i] <- !pos + let s = strings.[i - 1] + pos := !pos + s.Length + tab -#if FX_NO_LOCAL_FILESYSTEM + let stringAddress n = + if n >= Array.length stringAddressTable then failwith ("string index "+string n+" out of range") + stringAddressTable.[n] + + let userStringAddressTable = + let tab = Array.create (Array.length userStrings + 1) 0 + let pos = ref 1 + for i = 1 to Array.length userStrings do + tab.[i] <- !pos + let s = userStrings.[i - 1] + let n = s.Length + 1 + pos := !pos + n + ByteBuffer.Z32Size n + tab + + let userStringAddress n = + if n >= Array.length userStringAddressTable then failwith "userString index out of range" + userStringAddressTable.[n] + + let blobAddressTable = + let tab = Array.create (blobs.Length + 1) 0 + let pos = ref 1 + for i = 1 to blobs.Length do + tab.[i] <- !pos + let blob = blobs.[i - 1] + pos := !pos + blob.Length + ByteBuffer.Z32Size blob.Length + tab + + let blobAddress n = + if n >= blobAddressTable.Length then failwith "blob index out of range" + blobAddressTable.[n] + + + let sortedTables = + Array.init 64 (fun i -> + let tab = tables.[i] + let tabName = ILTableName.FromIndex i + let rows = tab.GenericRowsOfTable + if TableRequiresSorting tabName then SortTableRows tabName rows else rows) + + + let codedTables = + + let bignessTable = Array.map (fun rows -> Array.length rows >= 0x10000) sortedTables + let bigness (tab:int32) = bignessTable.[tab] + + let codedBigness nbits tab = + (tableSize tab) >= (0x10000 >>> nbits) + + let tdorBigness = + codedBigness 2 ILTableNames.TypeDef || + codedBigness 2 ILTableNames.TypeRef || + codedBigness 2 ILTableNames.TypeSpec + + let tomdBigness = + codedBigness 1 ILTableNames.TypeDef || + codedBigness 1 ILTableNames.Method + + let hcBigness = + codedBigness 2 ILTableNames.Field || + codedBigness 2 ILTableNames.Param || + codedBigness 2 ILTableNames.Property + + let hcaBigness = + codedBigness 5 ILTableNames.Method || + codedBigness 5 ILTableNames.Field || + codedBigness 5 ILTableNames.TypeRef || + codedBigness 5 ILTableNames.TypeDef || + codedBigness 5 ILTableNames.Param || + codedBigness 5 ILTableNames.InterfaceImpl || + codedBigness 5 ILTableNames.MemberRef || + codedBigness 5 ILTableNames.Module || + codedBigness 5 ILTableNames.Permission || + codedBigness 5 ILTableNames.Property || + codedBigness 5 ILTableNames.Event || + codedBigness 5 ILTableNames.StandAloneSig || + codedBigness 5 ILTableNames.ModuleRef || + codedBigness 5 ILTableNames.TypeSpec || + codedBigness 5 ILTableNames.Assembly || + codedBigness 5 ILTableNames.AssemblyRef || + codedBigness 5 ILTableNames.File || + codedBigness 5 ILTableNames.ExportedType || + codedBigness 5 ILTableNames.ManifestResource || + codedBigness 5 ILTableNames.GenericParam || + codedBigness 5 ILTableNames.GenericParamConstraint || + codedBigness 5 ILTableNames.MethodSpec + + + let hfmBigness = + codedBigness 1 ILTableNames.Field || + codedBigness 1 ILTableNames.Param + + let hdsBigness = + codedBigness 2 ILTableNames.TypeDef || + codedBigness 2 ILTableNames.Method || + codedBigness 2 ILTableNames.Assembly + + let mrpBigness = + codedBigness 3 ILTableNames.TypeRef || + codedBigness 3 ILTableNames.ModuleRef || + codedBigness 3 ILTableNames.Method || + codedBigness 3 ILTableNames.TypeSpec + + let hsBigness = + codedBigness 1 ILTableNames.Event || + codedBigness 1 ILTableNames.Property + + let mdorBigness = + codedBigness 1 ILTableNames.Method || + codedBigness 1 ILTableNames.MemberRef + + let mfBigness = + codedBigness 1 ILTableNames.Field || + codedBigness 1 ILTableNames.Method + + let iBigness = + codedBigness 2 ILTableNames.File || + codedBigness 2 ILTableNames.AssemblyRef || + codedBigness 2 ILTableNames.ExportedType + + let catBigness = + codedBigness 3 ILTableNames.Method || + codedBigness 3 ILTableNames.MemberRef + + let rsBigness = + codedBigness 2 ILTableNames.Module || + codedBigness 2 ILTableNames.ModuleRef || + codedBigness 2 ILTableNames.AssemblyRef || + codedBigness 2 ILTableNames.TypeRef + + let tablesBuf = ByteBuffer.Create 20000 + + // Now the coded tables themselves - first the schemata header + tablesBuf.EmitIntsAsBytes + [| 0x00; 0x00; 0x00; 0x00; + mdtableVersionMajor // major version of table schemata + mdtableVersionMinor // minor version of table schemata + + ((if stringsBig then 0x01 else 0x00) ||| // bit vector for heap size + (if guidsBig then 0x02 else 0x00) ||| + (if blobsBig then 0x04 else 0x00)) + 0x01 (* reserved, always 1 *) |] + + tablesBuf.EmitInt32 valid1 + tablesBuf.EmitInt32 valid2 + tablesBuf.EmitInt32 sorted1 + tablesBuf.EmitInt32 sorted2 + + // Numbers of rows in various tables + for rows in sortedTables do + if rows.Length <> 0 then + tablesBuf.EmitInt32 rows.Length + + + + // The tables themselves + for rows in sortedTables do + for row in rows do + for x in row do + // Emit the coded token for the array element + let t = x.Tag + let n = x.Val + match t with + | _ when t = RowElementTags.UShort -> tablesBuf.EmitUInt16 (uint16 n) + | _ when t = RowElementTags.ULong -> tablesBuf.EmitInt32 n + | _ when t = RowElementTags.Data -> recordRequiredDataFixup requiredDataFixups tablesBuf (tablesStreamStart + tablesBuf.Position) (n, false) + | _ when t = RowElementTags.DataResources -> recordRequiredDataFixup requiredDataFixups tablesBuf (tablesStreamStart + tablesBuf.Position) (n, true) + | _ when t = RowElementTags.Guid -> tablesBuf.EmitZUntaggedIndex guidsBig (guidAddress n) + | _ when t = RowElementTags.Blob -> tablesBuf.EmitZUntaggedIndex blobsBig (blobAddress n) + | _ when t = RowElementTags.String -> tablesBuf.EmitZUntaggedIndex stringsBig (stringAddress n) + | _ when t <= RowElementTags.SimpleIndexMax -> tablesBuf.EmitZUntaggedIndex (bigness (t - RowElementTags.SimpleIndexMin)) n + | _ when t <= RowElementTags.TypeDefOrRefOrSpecMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.TypeDefOrRefOrSpecMin) 2 tdorBigness n + | _ when t <= RowElementTags.TypeOrMethodDefMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.TypeOrMethodDefMin) 1 tomdBigness n + | _ when t <= RowElementTags.HasConstantMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasConstantMin) 2 hcBigness n + | _ when t <= RowElementTags.HasCustomAttributeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasCustomAttributeMin) 5 hcaBigness n + | _ when t <= RowElementTags.HasFieldMarshalMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasFieldMarshalMin) 1 hfmBigness n + | _ when t <= RowElementTags.HasDeclSecurityMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasDeclSecurityMin) 2 hdsBigness n + | _ when t <= RowElementTags.MemberRefParentMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MemberRefParentMin) 3 mrpBigness n + | _ when t <= RowElementTags.HasSemanticsMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasSemanticsMin) 1 hsBigness n + | _ when t <= RowElementTags.MethodDefOrRefMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MethodDefOrRefMin) 1 mdorBigness n + | _ when t <= RowElementTags.MemberForwardedMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.MemberForwardedMin) 1 mfBigness n + | _ when t <= RowElementTags.ImplementationMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.ImplementationMin) 2 iBigness n + | _ when t <= RowElementTags.CustomAttributeTypeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.CustomAttributeTypeMin) 3 catBigness n + | _ when t <= RowElementTags.ResolutionScopeMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.ResolutionScopeMin) 2 rsBigness n + | _ -> failwith "invalid tag in row element" + + tablesBuf.Close() + + + let tablesStreamUnpaddedSize = codedTables.Length + // QUERY: extra 4 empty bytes in array.exe - why? Include some extra padding after + // the tables just in case there is a mistake in the ECMA spec. + let tablesStreamPaddedSize = align 4 (tablesStreamUnpaddedSize + 4) + let tablesChunk, next = chunk tablesStreamPaddedSize next + let tablesStreamPadding = tablesChunk.size - tablesStreamUnpaddedSize + + let stringsChunk, next = chunk stringsStreamPaddedSize next + let stringsStreamPadding = stringsChunk.size - stringsStreamUnpaddedSize + let userStringsChunk, next = chunk userStringsStreamPaddedSize next + let userStringsStreamPadding = userStringsChunk.size - userStringsStreamUnpaddedSize + let guidsChunk, next = chunk (0x10 * guids.Length) next + let blobsChunk, _next = chunk blobsStreamPaddedSize next + let blobsStreamPadding = blobsChunk.size - blobsStreamUnpaddedSize + + + let metadata, guidStart = + let mdbuf = ByteBuffer.Create 500000 + mdbuf.EmitIntsAsBytes + [| 0x42; 0x53; 0x4a; 0x42; // Magic signature + 0x01; 0x00; // Major version + 0x01; 0x00; // Minor version + |]; + mdbuf.EmitInt32 0x0; // Reserved + + mdbuf.EmitInt32 paddedVersionLength; + mdbuf.EmitBytes version; + for i = 1 to (paddedVersionLength - Array.length version) do + mdbuf.EmitIntAsByte 0x00; + + mdbuf.EmitBytes + [| 0x00uy; 0x00uy; // flags, reserved + b0 numStreams; b1 numStreams; |]; + mdbuf.EmitInt32 tablesChunk.addr; + mdbuf.EmitInt32 tablesChunk.size; + mdbuf.EmitIntsAsBytes [| 0x23; 0x7e; 0x00; 0x00; (* #~00 *)|]; + mdbuf.EmitInt32 stringsChunk.addr; + mdbuf.EmitInt32 stringsChunk.size; + mdbuf.EmitIntsAsBytes [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; 0x00; 0x00; 0x00; 0x00 (* "#Strings0000" *)|]; + mdbuf.EmitInt32 userStringsChunk.addr; + mdbuf.EmitInt32 userStringsChunk.size; + mdbuf.EmitIntsAsBytes [| 0x23; 0x55; 0x53; 0x00; (* #US0*) |]; + mdbuf.EmitInt32 guidsChunk.addr; + mdbuf.EmitInt32 guidsChunk.size; + mdbuf.EmitIntsAsBytes [| 0x23; 0x47; 0x55; 0x49; 0x44; 0x00; 0x00; 0x00; (* #GUID000 *)|]; + mdbuf.EmitInt32 blobsChunk.addr; + mdbuf.EmitInt32 blobsChunk.size; + mdbuf.EmitIntsAsBytes [| 0x23; 0x42; 0x6c; 0x6f; 0x62; 0x00; 0x00; 0x00; (* #Blob000 *)|]; + + // Now the coded tables themselves + mdbuf.EmitBytes codedTables; + for i = 1 to tablesStreamPadding do + mdbuf.EmitIntAsByte 0x00; + + // The string stream + mdbuf.EmitByte 0x00uy; + for s in strings do + mdbuf.EmitBytes s; + for i = 1 to stringsStreamPadding do + mdbuf.EmitIntAsByte 0x00; + // The user string stream + mdbuf.EmitByte 0x00uy; + for s in userStrings do + mdbuf.EmitZ32 (s.Length + 1); + mdbuf.EmitBytes s; + mdbuf.EmitIntAsByte (markerForUnicodeBytes s) + for i = 1 to userStringsStreamPadding do + mdbuf.EmitIntAsByte 0x00; + + // The GUID stream + let guidStart = mdbuf.Position + Array.iter mdbuf.EmitBytes guids; + + // The blob stream + mdbuf.EmitByte 0x00uy; + for s in blobs do + mdbuf.EmitZ32 s.Length; + mdbuf.EmitBytes s + for i = 1 to blobsStreamPadding do + mdbuf.EmitIntAsByte 0x00; + // Done - close the buffer and return the result. + mdbuf.Close(), guidStart + + + // Now we know the user string tables etc. we can fixup the + // uses of strings in the code + for (codeStartAddr, l) in requiredStringFixups do + for (codeOffset, userStringIndex) in l do + if codeStartAddr < codep.addr || codeStartAddr >= codep.addr + codep.size then failwith "strings-in-code fixup: a group of fixups is located outside the code array"; + let locInCode = ((codeStartAddr + codeOffset) - codep.addr) + checkFixup32 code locInCode 0xdeadbeef; + let token = getUncodedToken ILTableNames.UserStrings (userStringAddress userStringIndex) + if (Bytes.get code (locInCode-1) <> i_ldstr) then failwith "strings-in-code fixup: not at ldstr instruction!"; + applyFixup32 code locInCode token + + entryPointToken, code, codePadding, metadata, data, resources, requiredDataFixups.ToArray(), pdbData, mappings, guidStart + + //--------------------------------------------------------------------- + // PHYSICAL METADATA+BLOBS --> PHYSICAL PE FORMAT + //--------------------------------------------------------------------- + + // THIS LAYS OUT A 2-SECTION .NET PE BINARY + // SECTIONS + // TEXT: physical 0x0200 --> RVA 0x00020000 + // e.g. raw size 0x9600, + // e.g. virt size 0x9584 + // RELOC: physical 0x9800 --> RVA 0x0000c000 + // i.e. physbase --> rvabase + // where physbase = textbase + text raw size + // phsrva = roundup(0x2000, 0x0002000 + text virt size) + + let msdosHeader: byte[] = + [| 0x4duy; 0x5auy; 0x90uy; 0x00uy; 0x03uy; 0x00uy; 0x00uy; 0x00uy + 0x04uy; 0x00uy; 0x00uy; 0x00uy; 0xFFuy; 0xFFuy; 0x00uy; 0x00uy + 0xb8uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy + 0x40uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy + 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy + 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy + 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy + 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x80uy; 0x00uy; 0x00uy; 0x00uy + 0x0euy; 0x1fuy; 0xbauy; 0x0euy; 0x00uy; 0xb4uy; 0x09uy; 0xcduy + 0x21uy; 0xb8uy; 0x01uy; 0x4cuy; 0xcduy; 0x21uy; 0x54uy; 0x68uy + 0x69uy; 0x73uy; 0x20uy; 0x70uy; 0x72uy; 0x6fuy; 0x67uy; 0x72uy + 0x61uy; 0x6duy; 0x20uy; 0x63uy; 0x61uy; 0x6euy; 0x6euy; 0x6fuy + 0x74uy; 0x20uy; 0x62uy; 0x65uy; 0x20uy; 0x72uy; 0x75uy; 0x6euy + 0x20uy; 0x69uy; 0x6euy; 0x20uy; 0x44uy; 0x4fuy; 0x53uy; 0x20uy + 0x6duy; 0x6fuy; 0x64uy; 0x65uy; 0x2euy; 0x0duy; 0x0duy; 0x0auy + 0x24uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy |] + + let writeInt64 (os: BinaryWriter) x = + os.Write (dw0 x); + os.Write (dw1 x); + os.Write (dw2 x); + os.Write (dw3 x); + os.Write (dw4 x); + os.Write (dw5 x); + os.Write (dw6 x); + os.Write (dw7 x) + + let writeInt32 (os: BinaryWriter) x = + os.Write (b0 x) + os.Write (b1 x) + os.Write (b2 x) + os.Write (b3 x) + + let writeInt32AsUInt16 (os: BinaryWriter) x = + os.Write (b0 x) + os.Write (b1 x) + + let writeDirectory os dict = + writeInt32 os (if dict.size = 0x0 then 0x0 else dict.addr); + writeInt32 os dict.size + + let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk, 0, chunk.Length) + + let writeBinaryAndReportMappings (outfile: string, + ilg: ILGlobals, pdbfile: string option, (* signer: ILStrongNameSigner option, *) portablePDB, embeddedPDB, + embedAllSource, embedSourceList, sourceLink, emitTailcalls, deterministic, showTimes, dumpDebugInfo ) modul = + let isDll = modul.IsDLL + + let os = + try + // Ensure the output directory exists otherwise it will fail + let dir = Path.GetDirectoryName(outfile) + if not (Directory.Exists(dir)) then Directory.CreateDirectory(dir) |>ignore + new BinaryWriter(System.IO.File.OpenWrite(outfile)) + with e -> + failwith ("Could not open file for writing (binary mode): " + outfile + "\n" + e.ToString()) + + let pdbData, pdbOpt, debugDirectoryChunk, debugDataChunk, debugEmbeddedPdbChunk, textV2P, mappings = + try + + let imageBaseReal = modul.ImageBase // FIXED CHOICE + let alignVirt = modul.VirtualAlignment // FIXED CHOICE + let alignPhys = modul.PhysicalAlignment // FIXED CHOICE + + let isItanium = modul.Platform = Some(IA64) + + let numSections = 3 // .text, .sdata, .reloc + + + // HEADERS + let next = 0x0 + let headerSectionPhysLoc = 0x0 + let headerAddr = next + let next = headerAddr + + let msdosHeaderSize = 0x80 + let msdosHeaderChunk, next = chunk msdosHeaderSize next + + let peSignatureSize = 0x04 + let peSignatureChunk, next = chunk peSignatureSize next + + let peFileHeaderSize = 0x14 + let peFileHeaderChunk, next = chunk peFileHeaderSize next + + let peOptionalHeaderSize = if modul.Is64Bit then 0xf0 else 0xe0 + let peOptionalHeaderChunk, next = chunk peOptionalHeaderSize next + + let textSectionHeaderSize = 0x28 + let textSectionHeaderChunk, next = chunk textSectionHeaderSize next + + let dataSectionHeaderSize = 0x28 + let dataSectionHeaderChunk, next = chunk dataSectionHeaderSize next + + let relocSectionHeaderSize = 0x28 + let relocSectionHeaderChunk, next = chunk relocSectionHeaderSize next + + let headerSize = next - headerAddr + let nextPhys = align alignPhys (headerSectionPhysLoc + headerSize) + let headerSectionPhysSize = nextPhys - headerSectionPhysLoc + let next = align alignVirt (headerAddr + headerSize) + + // TEXT SECTION: 8 bytes IAT table 72 bytes CLI header + + let textSectionPhysLoc = nextPhys + let textSectionAddr = next + let next = textSectionAddr + + let importAddrTableChunk, next = chunk 0x08 next + let cliHeaderPadding = (if isItanium then (align 16 next) else next) - next + let next = next + cliHeaderPadding + let cliHeaderChunk, next = chunk 0x48 next + + let desiredMetadataVersion = + if modul.MetadataVersion <> "" then + Version.Parse modul.MetadataVersion + else + match ilg.systemRuntimeScopeRef with + | ILScopeRef.Local -> failwith "Expected mscorlib to be ILScopeRef.Assembly was ILScopeRef.Local" + | ILScopeRef.Module(_) -> failwith "Expected mscorlib to be ILScopeRef.Assembly was ILScopeRef.Module" + | ILScopeRef.Assembly(aref) -> + match aref.Version with + | USome v -> v + | UNone -> failwith "Expected msorlib to have a version number" + + let entryPointToken, code, codePadding, metadata, data, resources, requiredDataFixups, pdbData, mappings, guidStart = + writeILMetadataAndCode ((pdbfile <> None), desiredMetadataVersion, ilg, emitTailcalls, deterministic, showTimes) modul next + + let _codeChunk, next = chunk code.Length next + let _codePaddingChunk, next = chunk codePadding.Length next + + let metadataChunk, next = chunk metadata.Length next + +#if EMIT_STRONG_NAME + let strongnameChunk, next = + match signer with + | None -> nochunk next + | Some s -> chunk s.SignatureSize next #else - assembly.Save (Path.GetFileName assemblyFileName) + let strongnameChunk, next = nochunk next #endif - let assemblyLoadedInMemory = assemblyMainModule.Assembly + let resourcesChunk, next = chunk resources.Length next + + let rawdataChunk, next = chunk data.Length next + + let vtfixupsChunk, next = nochunk next // Note: only needed for mixed mode assemblies + let importTableChunkPrePadding = (if isItanium then (align 16 next) else next) - next + let next = next + importTableChunkPrePadding + let importTableChunk, next = chunk 0x28 next + let importLookupTableChunk, next = chunk 0x14 next + let importNameHintTableChunk, next = chunk 0x0e next + let mscoreeStringChunk, next = chunk 0x0c next + + let next = align 0x10 (next + 0x05) - 0x05 + let importTableChunk = { addr=importTableChunk.addr; size = next - importTableChunk.addr} + let importTableChunkPadding = importTableChunk.size - (0x28 + 0x14 + 0x0e + 0x0c) + + let next = next + 0x03 + let entrypointCodeChunk, next = chunk 0x06 next + let globalpointerCodeChunk, next = chunk (if isItanium then 0x8 else 0x0) next + +#if EMIT_DEBUG_INFO + let pdbOpt = + match portablePDB with + | true -> + let (uncompressedLength, contentId, stream) as pdbStream = generatePortablePdb embedAllSource embedSourceList sourceLink showTimes pdbData deterministic + if embeddedPDB then Some (compressPortablePdbStream uncompressedLength contentId stream) + else Some (pdbStream) + | _ -> None + + let debugDirectoryChunk, next = + chunk (if pdbfile = None then + 0x0 + else if embeddedPDB && portablePDB then + sizeof_IMAGE_DEBUG_DIRECTORY * 2 + else + sizeof_IMAGE_DEBUG_DIRECTORY + ) next + + // The debug data is given to us by the PDB writer and appears to + // typically be the type of the data plus the PDB file name. We fill + // this in after we've written the binary. We approximate the size according + // to what PDB writers seem to require and leave extra space just in case... + let debugDataJustInCase = 40 + let debugDataChunk, next = + chunk (align 0x4 (match pdbfile with + | None -> 0 + | Some f -> (24 + + Encoding.Unicode.GetByteCount(f) // See bug 748444 + + debugDataJustInCase))) next + + let debugEmbeddedPdbChunk, next = + let streamLength = + match pdbOpt with + | Some (_, _, stream) -> int(stream.Length) + | None -> 0 + chunk (align 0x4 (match embeddedPDB with + | true -> 8 + streamLength + | _ -> 0 )) next - iterateTypes (fun _tb ptd -> - match ptd with - | None -> () - | Some ptd -> ptd.SetAssembly assemblyLoadedInMemory) +#else + let pdbOpt = None + let debugDirectoryChunk, next = chunk 0x0 next + let debugDataChunk, next = chunk (align 0x4 0) next + let debugEmbeddedPdbChunk, next = chunk (align 0x4 0) next +#endif -#if FX_NO_LOCAL_FILESYSTEM + let textSectionSize = next - textSectionAddr + let nextPhys = align alignPhys (textSectionPhysLoc + textSectionSize) + let textSectionPhysSize = nextPhys - textSectionPhysLoc + let next = align alignVirt (textSectionAddr + textSectionSize) + + // .RSRC SECTION (DATA) + let dataSectionPhysLoc = nextPhys + let dataSectionAddr = next + let dataSectionVirtToPhys v = v - dataSectionAddr + dataSectionPhysLoc + + +#if EMIT_NATIVE_RESOURCES + let resourceFormat = if modul.Is64Bit then Support.X64 else Support.X86 + let nativeResources = + match modul.NativeResources with + | [] -> [||] + | resources -> + if runningOnMono then + [||] + else + let unlinkedResources = List.map Lazy.force resources + begin + try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName(outfile)) + with e -> failwith ("Linking a native resource failed: "+e.Message+"") + end + let nativeResourcesSize = nativeResources.Length + let nativeResourcesChunk, next = chunk nativeResourcesSize next #else - member _.GetFinalBytes() = - let assemblyBytes = File.ReadAllBytes assemblyFileName - let _assemblyLoadedInMemory = System.Reflection.Assembly.Load(assemblyBytes,null,System.Security.SecurityContextSource.CurrentAppDomain) - //printfn "final bytes in '%s'" assemblyFileName - //File.Delete assemblyFileName - assemblyBytes + let nativeResourcesChunk, next = chunk 0x0 next #endif -type ProvidedAssembly(assemblyFileName: string) = - let theTypes = ResizeArray<_>() - let assemblyGenerator = AssemblyGenerator(assemblyFileName) - let assemblyLazy = - lazy - assemblyGenerator.Generate(theTypes |> Seq.toList) - assemblyGenerator.Assembly -#if FX_NO_LOCAL_FILESYSTEM + + let dummydatap, next = chunk (if next = dataSectionAddr then 0x01 else 0x0) next + + let dataSectionSize = next - dataSectionAddr + let nextPhys = align alignPhys (dataSectionPhysLoc + dataSectionSize) + let dataSectionPhysSize = nextPhys - dataSectionPhysLoc + let next = align alignVirt (dataSectionAddr + dataSectionSize) + + // .RELOC SECTION base reloc table: 0x0c size + let relocSectionPhysLoc = nextPhys + let relocSectionAddr = next + let baseRelocTableChunk, next = chunk 0x0c next + + let relocSectionSize = next - relocSectionAddr + let nextPhys = align alignPhys (relocSectionPhysLoc + relocSectionSize) + let relocSectionPhysSize = nextPhys - relocSectionPhysLoc + let next = align alignVirt (relocSectionAddr + relocSectionSize) + + // Now we know where the data section lies we can fix up the + // references into the data section from the metadata tables. + begin + requiredDataFixups |> Array.iter + (fun (metadataOffset32, (dataOffset, kind)) -> + let metadataOffset = metadataOffset32 + if metadataOffset < 0 || metadataOffset >= metadata.Length - 4 then failwith "data RVA fixup: fixup located outside metadata"; + checkFixup32 metadata metadataOffset 0xdeaddddd; + let dataRva = + if kind then + let res = dataOffset + if res >= resourcesChunk.size then printfn ("resource offset bigger than resource data section"); + res + else + let res = rawdataChunk.addr + dataOffset + if res < rawdataChunk.addr then printfn ("data rva before data section"); + if res >= rawdataChunk.addr + rawdataChunk.size then printfn "%s" ("data rva after end of data section, dataRva = "+string res+", rawdataChunk.addr = "+string rawdataChunk.addr+", rawdataChunk.size = "+string rawdataChunk.size); + res + applyFixup32 metadata metadataOffset dataRva); + end; + + // IMAGE TOTAL SIZE + let imageEndSectionPhysLoc = nextPhys + let imageEndAddr = next + + + let write p (os: BinaryWriter) chunkName chunk = + match p with + | None -> () + | Some pExpected -> + os.Flush(); + let pCurrent = int32 os.BaseStream.Position + if pCurrent <> pExpected then + failwith ("warning: "+chunkName+" not where expected, pCurrent = "+string pCurrent+", p.addr = "+string pExpected) + writeBytes os chunk + + let writePadding (os: BinaryWriter) _comment sz = + if sz < 0 then failwith "writePadding: size < 0"; + for i = 0 to sz - 1 do + os.Write 0uy + + // Now we've computed all the offsets, write the image + + write (Some msdosHeaderChunk.addr) os "msdos header" msdosHeader; + + write (Some peSignatureChunk.addr) os "pe signature" [| |]; + + writeInt32 os 0x4550; + + write (Some peFileHeaderChunk.addr) os "pe file header" [| |]; + + if (modul.Platform = Some(AMD64)) then + writeInt32AsUInt16 os 0x8664 // Machine - IMAGE_FILE_MACHINE_AMD64 + elif isItanium then + writeInt32AsUInt16 os 0x200 + else + writeInt32AsUInt16 os 0x014c; // Machine - IMAGE_FILE_MACHINE_I386 + + writeInt32AsUInt16 os numSections; + +#if EMIT_DEBUG_INFO + let pdbData = + if deterministic then + // Hash code, data and metadata + use sha = System.Security.Cryptography.SHA1.Create() // IncrementalHash is core only + let hCode = sha.ComputeHash code + let hData = sha.ComputeHash data + let hMeta = sha.ComputeHash metadata + let final = [| hCode; hData; hMeta |] |> Array.collect id |> sha.ComputeHash + + // Confirm we have found the correct data and aren't corrupting the metadata + if metadata.[ guidStart..guidStart+3] <> [| 4uy; 3uy; 2uy; 1uy |] then failwith "Failed to find MVID" + if metadata.[ guidStart+12..guidStart+15] <> [| 4uy; 3uy; 2uy; 1uy |] then failwith "Failed to find MVID" + + // Update MVID guid in metadata + Array.blit final 0 metadata guidStart 16 + + // Use last 4 bytes for timestamp - High bit set, to stop tool chains becoming confused + let timestamp = int final.[16] ||| (int final.[17] <<< 8) ||| (int final.[18] <<< 16) ||| (int (final.[19] ||| 128uy) <<< 24) + writeInt32 os timestamp + // Update pdbData with new guid and timestamp. Portable and embedded PDBs don't need the ModuleID + // Full and PdbOnly aren't supported under deterministic builds currently, they rely on non-determinsitic Windows native code + { pdbData with ModuleID = final.[0..15] ; Timestamp = timestamp } + else + writeInt32 os timestamp // date since 1970 + pdbData #else - let theAssemblyBytesLazy = - lazy - assemblyGenerator.GetFinalBytes() + writeInt32 os timestamp // date since 1970 +#endif + + writeInt32 os 0x00; // Pointer to Symbol Table Always 0 + // 00000090 + writeInt32 os 0x00; // Number of Symbols Always 0 + writeInt32AsUInt16 os peOptionalHeaderSize; // Size of the optional header, the format is described below. + + // 64bit: IMAGE_FILE_32BIT_MACHINE ||| IMAGE_FILE_LARGE_ADDRESS_AWARE + // 32bit: IMAGE_FILE_32BIT_MACHINE + // Yes, 32BIT_MACHINE is set for AMD64... + let iMachineCharacteristic = match modul.Platform with | Some IA64 -> 0x20 | Some AMD64 -> 0x0120 | _ -> 0x0100 + + writeInt32AsUInt16 os ((if isDll then 0x2000 else 0x0000) ||| 0x0002 ||| 0x0004 ||| 0x0008 ||| iMachineCharacteristic); + + // Now comes optional header + + let peOptionalHeaderByte = peOptionalHeaderByteByCLRVersion desiredMetadataVersion + + write (Some peOptionalHeaderChunk.addr) os "pe optional header" [| |]; + if modul.Is64Bit then + writeInt32AsUInt16 os 0x020B // Magic number is 0x020B for 64-bit + else + writeInt32AsUInt16 os 0x010b; // Always 0x10B (see Section 23.1). + writeInt32AsUInt16 os peOptionalHeaderByte; // ECMA spec says 6, some binaries, e.g. fscmanaged.exe say 7, Whidbey binaries say 8 + writeInt32 os textSectionPhysSize; // Size of the code (text) section, or the sum of all code sections if there are multiple sections. + // 000000a0 + writeInt32 os dataSectionPhysSize; // Size of the initialized data section, or the sum of all such sections if there are multiple data sections. + writeInt32 os 0x00; // Size of the uninitialized data section, or the sum of all such sections if there are multiple uninitialized data sections. + writeInt32 os entrypointCodeChunk.addr; // RVA of entry point , needs to point to bytes 0xFF 0x25 followed by the RVA+!0x4000000 in a section marked execute/read for EXEs or 0 for DLLs e.g. 0x0000b57e + writeInt32 os textSectionAddr; // e.g. 0x0002000 + // 000000b0 + if modul.Is64Bit then + writeInt64 os ((int64)imageBaseReal) // REVIEW: For 64-bit, we should use a 64-bit image base + else + writeInt32 os dataSectionAddr; // e.g. 0x0000c000 + writeInt32 os imageBaseReal; // Image Base Always 0x400000 (see Section 23.1). - QUERY: no it's not always 0x400000, e.g. 0x034f0000 + + writeInt32 os alignVirt; // Section Alignment Always 0x2000 (see Section 23.1). + writeInt32 os alignPhys; // File Alignment Either 0x200 or 0x1000. + // 000000c0 + writeInt32AsUInt16 os 0x04; // OS Major Always 4 (see Section 23.1). + writeInt32AsUInt16 os 0x00; // OS Minor Always 0 (see Section 23.1). + writeInt32AsUInt16 os 0x00; // User Major Always 0 (see Section 23.1). + writeInt32AsUInt16 os 0x00; // User Minor Always 0 (see Section 23.1). + do + let (major, minor) = modul.SubsystemVersion + writeInt32AsUInt16 os major; + writeInt32AsUInt16 os minor; + writeInt32 os 0x00; // Reserved Always 0 (see Section 23.1). + // 000000d0 + writeInt32 os imageEndAddr; // Image Size: Size, in bytes, of image, including all headers and padding; shall be a multiple of Section Alignment. e.g. 0x0000e000 + writeInt32 os headerSectionPhysSize; // Header Size Combined size of MS-DOS Header, PE Header, PE Optional Header and padding; shall be a multiple of the file alignment. + writeInt32 os 0x00; // File Checksum Always 0 (see Section 23.1). QUERY: NOT ALWAYS ZERO + writeInt32AsUInt16 os modul.SubSystemFlags; // SubSystem Subsystem required to run this image. Shall be either IMAGE_SUBSYSTEM_WINDOWS_CE_GUI (0x3) or IMAGE_SUBSYSTEM_WINDOWS_GUI (0x2). QUERY: Why is this 3 on the images ILASM produces + // DLL Flags Always 0x400 (no unmanaged windows exception handling - see Section 23.1). + // Itanium: see notes at end of file + // IMAGE_DLLCHARACTERISTICS_NX_COMPAT: See FSharp 1.0 bug 5019 and http://blogs.msdn.com/ed_maurer/archive/2007/12/14/nxcompat-and-the-c-compiler.aspx + // Itanium: IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE | IMAGE_DLLCHARACTERISTICS_ NO_SEH | IMAGE_DLL_CHARACTERISTICS_DYNAMIC_BASE | IMAGE_DLLCHARACTERISTICS_NX_COMPAT + // x86: IMAGE_DLLCHARACTERISTICS_ NO_SEH | IMAGE_DLL_CHARACTERISTICS_DYNAMIC_BASE | IMAGE_DLLCHARACTERISTICS_NX_COMPAT + // x64: IMAGE_DLLCHARACTERISTICS_ NO_SEH | IMAGE_DLL_CHARACTERISTICS_DYNAMIC_BASE | IMAGE_DLLCHARACTERISTICS_NX_COMPAT + let dllCharacteristics = + let flags = + if modul.Is64Bit then (if isItanium then 0x8540 else 0x540) + else 0x540 + if modul.UseHighEntropyVA then flags ||| 0x20 // IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA + else flags + writeInt32AsUInt16 os dllCharacteristics + // 000000e0 + // Note that the defaults differ between x86 and x64 + if modul.Is64Bit then + let size = defaultArg modul.StackReserveSize 0x400000 |> int64 + writeInt64 os size // Stack Reserve Size Always 0x400000 (4Mb) (see Section 23.1). + writeInt64 os 0x4000L // Stack Commit Size Always 0x4000 (16Kb) (see Section 23.1). + writeInt64 os 0x100000L // Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). + writeInt64 os 0x2000L // Heap Commit Size Always 0x800 (8Kb) (see Section 23.1). + else + let size = defaultArg modul.StackReserveSize 0x100000 + writeInt32 os size // Stack Reserve Size Always 0x100000 (1Mb) (see Section 23.1). + writeInt32 os 0x1000 // Stack Commit Size Always 0x1000 (4Kb) (see Section 23.1). + writeInt32 os 0x100000 // Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). + writeInt32 os 0x1000 // Heap Commit Size Always 0x1000 (4Kb) (see Section 23.1). + // 000000f0 - x86 location, moving on, for x64, add 0x10 + writeInt32 os 0x00 // Loader Flags Always 0 (see Section 23.1) + writeInt32 os 0x10 // Number of Data Directories: Always 0x10 (see Section 23.1). + writeInt32 os 0x00 + writeInt32 os 0x00 // Export Table Always 0 (see Section 23.1). + // 00000100 + writeDirectory os importTableChunk // Import Table RVA of Import Table, (see clause 24.3.1). e.g. 0000b530 + // Native Resource Table: ECMA says Always 0 (see Section 23.1), but mscorlib and other files with resources bound into executable do not. For the moment assume the resources table is always the first resource in the file. + writeDirectory os nativeResourcesChunk + + // 00000110 + writeInt32 os 0x00 // Exception Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Exception Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Certificate Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Certificate Table Always 0 (see Section 23.1). + // 00000120 + writeDirectory os baseRelocTableChunk + writeDirectory os debugDirectoryChunk // Debug Directory + // 00000130 + writeInt32 os 0x00 // Copyright Always 0 (see Section 23.1). + writeInt32 os 0x00 // Copyright Always 0 (see Section 23.1). + writeInt32 os 0x00 // Global Ptr Always 0 (see Section 23.1). + writeInt32 os 0x00 // Global Ptr Always 0 (see Section 23.1). + // 00000140 + writeInt32 os 0x00 // Load Config Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Load Config Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // TLS Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // TLS Table Always 0 (see Section 23.1). + // 00000150 + writeInt32 os 0x00 // Bound Import Always 0 (see Section 23.1). + writeInt32 os 0x00 // Bound Import Always 0 (see Section 23.1). + writeDirectory os importAddrTableChunk // Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 + // 00000160 + writeInt32 os 0x00 // Delay Import Descriptor Always 0 (see Section 23.1). + writeInt32 os 0x00 // Delay Import Descriptor Always 0 (see Section 23.1). + writeDirectory os cliHeaderChunk + // 00000170 + writeInt32 os 0x00 // Reserved Always 0 (see Section 23.1). + writeInt32 os 0x00 // Reserved Always 0 (see Section 23.1). + + write (Some textSectionHeaderChunk.addr) os "text section header" [| |] + + // 00000178 + writeBytes os [| 0x2euy; 0x74uy; 0x65uy; 0x78uy; 0x74uy; 0x00uy; 0x00uy; 0x00uy; |] // ".text\000\000\000" + // 00000180 + writeInt32 os textSectionSize // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x00009584 + writeInt32 os textSectionAddr // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x00020000 + writeInt32 os textSectionPhysSize // SizeOfRawData Size of the initialized data on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized data, this field should be 0. 0x00009600 + writeInt32 os textSectionPhysLoc // PointerToRawData RVA to section's first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized data, this field should be 0. e.g. 00000200 + // 00000190 + writeInt32 os 0x00 // PointerToRelocations RVA of Relocation section. + writeInt32 os 0x00 // PointerToLineNumbers Always 0 (see Section 23.1). + // 00000198 + writeInt32AsUInt16 os 0x00// NumberOfRelocations Number of relocations, set to 0 if unused. + writeInt32AsUInt16 os 0x00 // NumberOfLinenumbers Always 0 (see Section 23.1). + writeBytes os [| 0x20uy; 0x00uy; 0x00uy; 0x60uy |] // Characteristics Flags describing section's characteristics, see below. IMAGE_SCN_CNT_CODE || IMAGE_SCN_MEM_EXECUTE || IMAGE_SCN_MEM_READ + + write (Some dataSectionHeaderChunk.addr) os "data section header" [| |] + + // 000001a0 + writeBytes os [| 0x2euy; 0x72uy; 0x73uy; 0x72uy; 0x63uy; 0x00uy; 0x00uy; 0x00uy; |] // ".rsrc\000\000\000" + // writeBytes os [| 0x2e; 0x73; 0x64; 0x61; 0x74; 0x61; 0x00; 0x00; |] // ".sdata\000\000" + writeInt32 os dataSectionSize // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x0000000c + writeInt32 os dataSectionAddr // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x0000c000 + // 000001b0 + writeInt32 os dataSectionPhysSize // SizeOfRawData Size of the initialized data on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized data, this field should be 0. e.g. 0x00000200 + writeInt32 os dataSectionPhysLoc // PointerToRawData QUERY: Why does ECMA say "RVA" here? Offset to section's first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized data, this field should be 0. e.g. 0x00009800 + // 000001b8 + writeInt32 os 0x00 // PointerToRelocations RVA of Relocation section. + writeInt32 os 0x00 // PointerToLineNumbers Always 0 (see Section 23.1). + // 000001c0 + writeInt32AsUInt16 os 0x00 // NumberOfRelocations Number of relocations, set to 0 if unused. + writeInt32AsUInt16 os 0x00 // NumberOfLinenumbers Always 0 (see Section 23.1). + writeBytes os [| 0x40uy; 0x00uy; 0x00uy; 0x40uy |] // Characteristics Flags: IMAGE_SCN_MEM_READ | IMAGE_SCN_CNT_INITIALIZED_DATA + + write (Some relocSectionHeaderChunk.addr) os "reloc section header" [| |] + // 000001a0 + writeBytes os [| 0x2euy; 0x72uy; 0x65uy; 0x6cuy; 0x6fuy; 0x63uy; 0x00uy; 0x00uy; |] // ".reloc\000\000" + writeInt32 os relocSectionSize // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x0000000c + writeInt32 os relocSectionAddr // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x0000c000 + // 000001b0 + writeInt32 os relocSectionPhysSize // SizeOfRawData Size of the initialized reloc on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized reloc, this field should be 0. e.g. 0x00000200 + writeInt32 os relocSectionPhysLoc // PointerToRawData QUERY: Why does ECMA say "RVA" here? Offset to section's first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized reloc, this field should be 0. e.g. 0x00009800 + // 000001b8 + writeInt32 os 0x00 // PointerToRelocations RVA of Relocation section. + writeInt32 os 0x00 // PointerToLineNumbers Always 0 (see Section 23.1). + // 000001c0 + writeInt32AsUInt16 os 0x00 // NumberOfRelocations Number of relocations, set to 0 if unused. + writeInt32AsUInt16 os 0x00 // NumberOfLinenumbers Always 0 (see Section 23.1). + writeBytes os [| 0x40uy; 0x00uy; 0x00uy; 0x42uy |] // Characteristics Flags: IMAGE_SCN_CNT_INITIALIZED_DATA | IMAGE_SCN_MEM_READ | + + writePadding os "pad to text begin" (textSectionPhysLoc - headerSize) + + // TEXT SECTION: e.g. 0x200 + + let textV2P v = v - textSectionAddr + textSectionPhysLoc + + // e.g. 0x0200 + write (Some (textV2P importAddrTableChunk.addr)) os "import addr table" [| |] + writeInt32 os importNameHintTableChunk.addr + writeInt32 os 0x00 // QUERY 4 bytes of zeros not 2 like ECMA 24.3.1 says + + // e.g. 0x0208 + + let flags = + (if modul.IsILOnly then 0x01 else 0x00) ||| + (if modul.Is32Bit then 0x02 else 0x00) ||| + (if modul.Is32BitPreferred then 0x00020003 else 0x00) ||| +#if EMIT_STRONG_NAME + (if (match signer with None -> false | Some s -> s.IsFullySigned) then 0x08 else 0x00) ||| +#endif + 0x0000 + + let headerVersionMajor, headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion + + writePadding os "pad to cli header" cliHeaderPadding + write (Some (textV2P cliHeaderChunk.addr)) os "cli header" [| |] + writeInt32 os 0x48 // size of header + writeInt32AsUInt16 os headerVersionMajor // Major part of minimum version of CLR reqd. + writeInt32AsUInt16 os headerVersionMinor // Minor part of minimum version of CLR reqd. ... + // e.g. 0x0210 + writeDirectory os metadataChunk + writeInt32 os flags + + writeInt32 os entryPointToken + write None os "rest of cli header" [| |] + + // e.g. 0x0220 + writeDirectory os resourcesChunk + writeDirectory os strongnameChunk + // e.g. 0x0230 + writeInt32 os 0x00 // code manager table, always 0 + writeInt32 os 0x00 // code manager table, always 0 + writeDirectory os vtfixupsChunk + // e.g. 0x0240 + writeInt32 os 0x00 // export addr table jumps, always 0 + writeInt32 os 0x00 // export addr table jumps, always 0 + writeInt32 os 0x00 // managed native header, always 0 + writeInt32 os 0x00 // managed native header, always 0 + + writeBytes os code + write None os "code padding" codePadding + + writeBytes os metadata + +#if EMIT_STRONG_NAME + // write 0x80 bytes of empty space for encrypted SHA1 hash, written by SN.EXE or call to signing API + if signer <> None then + write (Some (textV2P strongnameChunk.addr)) os "strongname" (Array.create strongnameChunk.size 0x0uy) +#endif - do - GlobalProvidedAssemblyElementsTable.theTable.Add(assemblyGenerator.Assembly, theAssemblyBytesLazy) + write (Some (textV2P resourcesChunk.addr)) os "raw resources" [| |] + writeBytes os resources + write (Some (textV2P rawdataChunk.addr)) os "raw data" [| |] + writeBytes os data + + writePadding os "start of import table" importTableChunkPrePadding + + // vtfixups would go here + write (Some (textV2P importTableChunk.addr)) os "import table" [| |] + + writeInt32 os importLookupTableChunk.addr + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os mscoreeStringChunk.addr + writeInt32 os importAddrTableChunk.addr + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 + + write (Some (textV2P importLookupTableChunk.addr)) os "import lookup table" [| |] + writeInt32 os importNameHintTableChunk.addr + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 + + + write (Some (textV2P importNameHintTableChunk.addr)) os "import name hint table" [| |] + // Two zero bytes of hint, then Case sensitive, null-terminated ASCII string containing name to import. + // Shall _CorExeMain a .exe file _CorDllMain for a .dll file. + if isDll then + writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy ; 0x6fuy; 0x72uy; 0x44uy; 0x6cuy; 0x6cuy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |] + else + writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy; 0x6fuy; 0x72uy; 0x45uy; 0x78uy; 0x65uy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |] + + write (Some (textV2P mscoreeStringChunk.addr)) os "mscoree string" + [| 0x6duy; 0x73uy; 0x63uy; 0x6fuy ; 0x72uy; 0x65uy ; 0x65uy; 0x2euy ; 0x64uy; 0x6cuy ; 0x6cuy; 0x00uy ; |] + + writePadding os "end of import tab" importTableChunkPadding + + writePadding os "head of entrypoint" 0x03 + let ep = (imageBaseReal + textSectionAddr) + write (Some (textV2P entrypointCodeChunk.addr)) os " entrypoint code" + [| 0xFFuy; 0x25uy; (* x86 Instructions for entry *) b0 ep; b1 ep; b2 ep; b3 ep |] + if isItanium then + write (Some (textV2P globalpointerCodeChunk.addr)) os " itanium global pointer" + [| 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy |] + + if pdbfile.IsSome then + write (Some (textV2P debugDirectoryChunk.addr)) os "debug directory" (Array.create debugDirectoryChunk.size 0x0uy) + write (Some (textV2P debugDataChunk.addr)) os "debug data" (Array.create debugDataChunk.size 0x0uy) + + if embeddedPDB then + write (Some (textV2P debugEmbeddedPdbChunk.addr)) os "debug data" (Array.create debugEmbeddedPdbChunk.size 0x0uy) + + writePadding os "end of .text" (dataSectionPhysLoc - textSectionPhysLoc - textSectionSize) + + // DATA SECTION +#if EMIT_NATIVE_RESOURCES + match nativeResources with + | [||] -> () + | resources -> + write (Some (dataSectionVirtToPhys nativeResourcesChunk.addr)) os "raw native resources" [| |] + writeBytes os resources +#endif + if dummydatap.size <> 0x0 then + write (Some (dataSectionVirtToPhys dummydatap.addr)) os "dummy data" [| 0x0uy |] + + writePadding os "end of .rsrc" (relocSectionPhysLoc - dataSectionPhysLoc - dataSectionSize) + + // RELOC SECTION + + // See ECMA 24.3.2 + let relocV2P v = v - relocSectionAddr + relocSectionPhysLoc + + let entrypointFixupAddr = entrypointCodeChunk.addr + 0x02 + let entrypointFixupBlock = (entrypointFixupAddr / 4096) * 4096 + let entrypointFixupOffset = entrypointFixupAddr - entrypointFixupBlock + let reloc = (if modul.Is64Bit then 0xA000 (* IMAGE_REL_BASED_DIR64 *) else 0x3000 (* IMAGE_REL_BASED_HIGHLOW *)) ||| entrypointFixupOffset + // For the itanium, you need to set a relocation entry for the global pointer + let reloc2 = + if not isItanium then + 0x0 + else + 0xA000 ||| (globalpointerCodeChunk.addr - ((globalpointerCodeChunk.addr / 4096) * 4096)) + + write (Some (relocV2P baseRelocTableChunk.addr)) os "base reloc table" + [| b0 entrypointFixupBlock; b1 entrypointFixupBlock; b2 entrypointFixupBlock; b3 entrypointFixupBlock; + 0x0cuy; 0x00uy; 0x00uy; 0x00uy; + b0 reloc; b1 reloc; + b0 reloc2; b1 reloc2; |] + writePadding os "end of .reloc" (imageEndSectionPhysLoc - relocSectionPhysLoc - relocSectionSize) + + os.Dispose() + + pdbData, pdbOpt, debugDirectoryChunk, debugDataChunk, debugEmbeddedPdbChunk, textV2P, mappings + + // Looks like a finally + with e -> + (try + os.Dispose() + File.Delete outfile + with _ -> ()) + reraise() + + //Finished writing and signing the binary and debug info... + mappings + + type options = + { ilg: ILGlobals + pdbfile: string option + portablePDB: bool + embeddedPDB: bool + embedAllSource: bool + embedSourceList: string list + sourceLink: string +#if EMIT_STRONG_NAME + signer: ILStrongNameSigner option #endif + emitTailcalls: bool + deterministic: bool + showTimes: bool + dumpDebugInfo:bool } - let add (providedTypeDefinitions:ProvidedTypeDefinition list, enclosingTypeNames: string list option) = - for pt in providedTypeDefinitions do - if pt.IsErased then invalidOp ("The provided type "+pt.Name+"is marked as erased and cannot be converted to a generated type. Set 'IsErased' to false on the ProvidedTypeDefinition") - theTypes.Add(pt,enclosingTypeNames) - pt.SetAssemblyLazy assemblyLazy + let WriteILBinary (outfile, (args: options), modul) = + writeBinaryAndReportMappings (outfile, + args.ilg, args.pdbfile, (* args.signer, *) args.portablePDB, args.embeddedPDB, args.embedAllSource, + args.embedSourceList, args.sourceLink, args.emitTailcalls, args.deterministic, args.showTimes, args.dumpDebugInfo) modul + |> ignore - member x.AddNestedTypes (providedTypeDefinitions, enclosingTypeNames) = add (providedTypeDefinitions, Some enclosingTypeNames) - member x.AddTypes (providedTypeDefinitions) = add (providedTypeDefinitions, None) -#if FX_NO_LOCAL_FILESYSTEM +//==================================================================================================== +// ProvidedAssembly - model for generated assembly fragments + +namespace ProviderImplementation.ProvidedTypes + + #nowarn "1182" + open System + open System.Diagnostics + open System.IO + open System.Collections.Concurrent + open System.Collections.Generic + open System.Reflection + + open Microsoft.FSharp.Quotations + open Microsoft.FSharp.Quotations.DerivedPatterns + open Microsoft.FSharp.Quotations.Patterns + open Microsoft.FSharp.Quotations.ExprShape + open Microsoft.FSharp.Core.CompilerServices + open Microsoft.FSharp.Reflection + + open ProviderImplementation.ProvidedTypes + open ProviderImplementation.ProvidedTypes.AssemblyReader + open ProviderImplementation.ProvidedTypes.UncheckedQuotations + + + type ILLocalBuilder(i: int) = + member __.LocalIndex = i + + [] + type ILExceptionClauseBuilder = + | Finally of ILCodeLabel + | Fault of ILCodeLabel + | FilterCatch of ILCodeLabel * (ILCodeLabel * ILCodeLabel) + | TypeCatch of ILCodeLabel * ILType + + type ILExceptionBlockBuilder(i: ILCodeLabel, leave: ILCodeLabel) = + member __.StartIndex = i + member __.Leave = leave + member val EndIndex : int = 0 with get, set + member val Clause : ILExceptionClauseBuilder option = None with get, set + + type ILGenerator(methodName) = + let mutable locals = ResizeArray() + let mutable instrs = ResizeArray() + let mutable exceptions = ResizeArray() + let mutable labelCount = 0 + let mutable labels = Dictionary() + let mutable exceptionBlocks = Stack() + + member __.Content = + { IsZeroInit = true + MaxStack = instrs.Count + Locals = locals.ToArray() + Code = + { Labels = labels + Instrs = instrs.ToArray() + Exceptions = exceptions.ToArray() + Locals = [| |] (* TODO ILLocalDebugInfo *) } + } + + member __.DeclareLocal(ty: ILType) = + let idx = locals.Count + let local = { Type = ty; IsPinned = false; DebugInfo = None } + locals.Add(local) + ILLocalBuilder(idx) + + member ilg.BeginExceptionBlock() = + exceptionBlocks.Push(ILExceptionBlockBuilder(ilg.DefineLabelHere(), ilg.DefineLabel())) + + member ilg.EndGuardedBlock() = + let block = exceptionBlocks.Peek() + ilg.Emit(I_leave block.Leave) + block.EndIndex <- ilg.DefineLabelHere() + + member ilg.BeginCatchBlock(typ: ILType) = + exceptionBlocks.Peek().Clause <- Some <| + ILExceptionClauseBuilder.TypeCatch(ilg.DefineLabelHere(), typ) + + member ilg.BeginCatchFilterBlock(range: ILCodeLabel * ILCodeLabel) = + exceptionBlocks.Peek().Clause <- Some <| + ILExceptionClauseBuilder.FilterCatch(ilg.DefineLabelHere(), range) + + member ilg.BeginFinallyBlock() = + exceptionBlocks.Peek().Clause <- Some <| + ILExceptionClauseBuilder.Finally (ilg.DefineLabelHere()) + + member ilg.BeginFaultBlock() = + exceptionBlocks.Peek().Clause <- Some <| + ILExceptionClauseBuilder.Fault (ilg.DefineLabelHere()) + + member ilg.EndExceptionBlock() = + let exnBlock = exceptionBlocks.Pop() + match exnBlock.Clause.Value with + | ILExceptionClauseBuilder.Finally(start) -> + ilg.Emit(I_endfinally) + | ILExceptionClauseBuilder.Fault(start) -> + ilg.Emit(I_endfinally) + | ILExceptionClauseBuilder.FilterCatch _ -> + ilg.Emit(I_leave exnBlock.Leave) + | ILExceptionClauseBuilder.TypeCatch _ -> + ilg.Emit(I_leave exnBlock.Leave) + let endIndex = ilg.DefineLabelHere() + ilg.MarkLabel(exnBlock.Leave) + let clause = + match exnBlock.Clause.Value with + | ILExceptionClauseBuilder.Finally(start) -> + ILExceptionClause.Finally (start, endIndex) + | ILExceptionClauseBuilder.Fault(start) -> + ILExceptionClause.Fault (start, endIndex) + | ILExceptionClauseBuilder.FilterCatch(start, range) -> + ILExceptionClause.FilterCatch (range, (start, endIndex)) + | ILExceptionClauseBuilder.TypeCatch(start, typ) -> + ILExceptionClause.TypeCatch(typ, (start, endIndex)) + + exceptions.Add { Range = (exnBlock.StartIndex, exnBlock.EndIndex) + ; Clause = clause + } + + member __.DefineLabel() = labelCount <- labelCount + 1; labelCount + member __.MarkLabel(label) = labels.[label] <- instrs.Count + member this.DefineLabelHere() = let label = this.DefineLabel() in this.MarkLabel(label); label + member __.Emit(opcode) = instrs.Add(opcode) + override __.ToString() = "generator for " + methodName + + + type ILFieldBuilder(enclosing: ILType, nm: string, fty: ILType, attrs: FieldAttributes) = + + let mutable lit = None + let cattrs = ResizeArray() + + member __.SetConstant(lit2) = (lit <- Some lit2) + member __.SetCustomAttribute(ca) = cattrs.Add(ca) + member __.FormalFieldRef = ILFieldRef(enclosing.TypeRef, nm, fty) + member this.FormalFieldSpec = ILFieldSpec(this.FormalFieldRef, enclosing) + member __.Name = nm + + member __.Content = + { Name = nm + FieldType = fty + LiteralValue = lit + Attributes = attrs + Offset = None + CustomAttrs = mkILCustomAttrs (cattrs.ToArray()) + Token = genToken() } + override __.ToString() = "builder for " + nm + + type ILGenericParameterBuilder(nm, attrs: GenericParameterAttributes) = + + let mutable constraints = ResizeArray() + let cattrs = ResizeArray() + + member __.AddConstraint(ty) = constraints.Add(ty) + member __.SetCustomAttribute(ca) = cattrs.Add(ca) + + member __.Content = + { Name=nm + Constraints= constraints.ToArray() + Attributes = attrs + CustomAttrs = mkILCustomAttrs (cattrs.ToArray()) + Token = genToken() } + override __.ToString() = "builder for " + nm + + type ILParameterBuilder(ty: ILType) = + + let mutable attrs = ParameterAttributes.None + let mutable nm = UNone + let mutable dflt = UNone + let cattrs = ResizeArray() + + member __.SetData(attrs2, nm2) = attrs <- attrs2; nm <- USome nm2 + member __.SetConstant(obj) = dflt <- USome obj + member __.SetCustomAttribute(ca) = cattrs.Add(ca) + + member __.Content = + { Name=nm + ParameterType=ty + Default=dflt + Attributes = attrs + CustomAttrs = mkILCustomAttrs (cattrs.ToArray()) } + + type ILMethodBuilder(enclosing: ILType, methodName: string, attrs: MethodAttributes, retty: ILType, argtys:ILType[]) = + + let ilParams = [| yield ILParameterBuilder(retty); for argty in argtys do yield ILParameterBuilder(argty) |] + let mutable implflags = MethodImplAttributes.IL + let gparams = ResizeArray() + let cattrs = ResizeArray() + let mutable body = None + + member __.DefineGenericParameter(name, attrs) = let eb = ILGenericParameterBuilder(name, attrs) in gparams.Add eb; eb + member __.DefineParameter(i, attrs, parameterName) = ilParams.[i].SetData(attrs, parameterName) ; ilParams.[i] + member __.SetCustomAttribute(ca) = cattrs.Add(ca) + member __.GetILGenerator() = let ilg = ILGenerator(methodName) in body <- Some ilg; ilg + member __.FormalMethodRef = + let cc = (if ILMethodDef.ComputeIsStatic attrs then ILCallingConv.Static else ILCallingConv.Instance) + ILMethodRef (enclosing.TypeRef, cc, gparams.Count, methodName, argtys, retty) + member this.FormalMethodSpec = + ILMethodSpec(this.FormalMethodRef, enclosing, mkILFormalGenericArgs enclosing.TypeSpec.GenericArgs.Length gparams.Count) + + member __.Content = + { Token = genToken() + Name = methodName + Attributes = attrs + ImplAttributes = implflags + GenericParams = [| for x in gparams -> x.Content |] + CustomAttrs = mkILCustomAttrs (cattrs.ToArray()) + Parameters = [| for p in ilParams.[1..] -> p.Content |] + CallingConv = (if attrs &&& MethodAttributes.Static <> enum<_>(0) then ILCallingConv.Static else ILCallingConv.Instance) + Return = (let p = ilParams.[0].Content in { Type = p.ParameterType; CustomAttrs = p.CustomAttrs }) + Body = body |> Option.map (fun b -> b.Content) + IsEntryPoint = false } + override __.ToString() = "builder for " + methodName + + type ILPropertyBuilder(nm, attrs: PropertyAttributes, retty: ILType, argtys: ILType[]) = + + let mutable setMethod = None + let mutable getMethod = None + let cattrs = ResizeArray() + + member __.SetGetMethod(mb: ILMethodBuilder) = getMethod <- Some mb + member __.SetSetMethod(mb: ILMethodBuilder) = setMethod <- Some mb + member __.SetCustomAttribute(ca) = cattrs.Add(ca) + + member __.Content = + { Name=nm + CallingConv = + (if (getMethod.IsSome && getMethod.Value.Content.IsStatic) || + (setMethod.IsSome && setMethod.Value.Content.IsStatic) then + ILThisConvention.Static + else ILThisConvention.Instance) + Attributes = attrs + GetMethod = (getMethod |> Option.map (fun mb -> mb.FormalMethodRef)) + SetMethod = (setMethod |> Option.map (fun mb -> mb.FormalMethodRef)) + CustomAttrs = mkILCustomAttrs (cattrs.ToArray()) + PropertyType=retty + Init= None // TODO if (attrs &&& PropertyAttributes.HasDefault) = 0 then None else + IndexParameterTypes=argtys + Token = genToken() } + override __.ToString() = "builder for " + nm + + type ILEventBuilder(nm, attrs: EventAttributes) = + + let mutable addMethod = None + let mutable removeMethod = None + let cattrs = ResizeArray() + + member __.SetAddOnMethod(mb: ILMethodBuilder) = addMethod <- Some mb + member __.SetRemoveOnMethod(mb: ILMethodBuilder) = removeMethod <- Some mb + member __.SetCustomAttribute(ca) = cattrs.Add(ca) + member __.Content = + { Name = nm + Attributes = attrs + AddMethod = addMethod.Value.FormalMethodRef + RemoveMethod = removeMethod.Value.FormalMethodRef + CustomAttrs = mkILCustomAttrs (cattrs.ToArray()) + Token = genToken()} + override __.ToString() = "builder for " + nm + + type ILTypeBuilder(scoref, nsp: string uoption, nm: string, attrs: TypeAttributes) = + + let mutable extends = None + let implements = ResizeArray() + let nestedTypes = ResizeArray() + let methods = ResizeArray() + let fields = ResizeArray() + let props = ResizeArray() + let events = ResizeArray() + let gparams = ResizeArray() + let methodImpls = ResizeArray() + let cattrs = ResizeArray() + + member __.ILTypeRef = ILTypeRef(scoref, nsp, nm) + member this.ILTypeSpec = ILTypeSpec(this.ILTypeRef, mkILFormalGenericArgs 0 gparams.Count) + member this.ILType = + match ILTypeDef.ComputeKind (int attrs) extends nsp nm with + | ILTypeDefKind.ValueType | ILTypeDefKind.Enum -> ILType.Value this.ILTypeSpec + | _ -> ILType.Boxed this.ILTypeSpec + + member this.DefineNestedType(name, attrs) = let tb = ILTypeBuilder(ILTypeRefScope.Nested this.ILTypeRef, UNone, name, attrs) in nestedTypes.Add tb; tb + + member this.DefineField(name, retty, attrs) = let fb = ILFieldBuilder(this.ILType, name, retty, attrs) in fields.Add fb; fb + member this.DefineMethod(name, attrs, retty, argtys) = let mb = ILMethodBuilder(this.ILType, name, attrs, retty, argtys) in methods.Add mb; mb + member this.DefineConstructor(attrs, argtys) = let mb = ILMethodBuilder(this.ILType, ".ctor", attrs ||| MethodAttributes.SpecialName ||| MethodAttributes.RTSpecialName, ILType.Void, argtys) in methods.Add mb; mb + member __.DefineProperty(name, attrs, propty, argtys) = let pb = ILPropertyBuilder(name, attrs, propty, argtys) in props.Add pb; pb + member __.DefineEvent(name, attrs) = let eb = ILEventBuilder(name, attrs) in events.Add eb; eb + member __.DefineMethodOverride(mimpl) = methodImpls.Add (mimpl) + member __.DefineGenericParameter(name, attrs) = let eb = ILGenericParameterBuilder(name, attrs) in gparams.Add eb; eb + member __.SetCustomAttribute(ca) = cattrs.Add(ca) + member __.AddInterfaceImplementation(ty) = implements.Add(ty) + member this.DefineTypeInitializer () = let mb = ILMethodBuilder(this.ILType, ".cctor", MethodAttributes.Static ||| MethodAttributes.SpecialName ||| MethodAttributes.RTSpecialName ||| MethodAttributes.Private, ILType.Void, [| |]) in methods.Add mb; mb + member __.SetParent ty = (extends <- Some ty) + member this.DefineDefaultConstructor(attrs, baseCtor: ILMethodSpec) = + let ctor = this.DefineConstructor(attrs, [| |]) + let ilg = ctor.GetILGenerator() + ilg.Emit(I_ldarg 0) + ilg.Emit(I_call (Normalcall, baseCtor, None)) + ilg.Emit(I_ret) + ctor + + + member __.Content = + { Namespace=nsp + Name=nm + GenericParams= [| for x in gparams -> x.Content |] + Implements = implements.ToArray() + Attributes = attrs + Layout=ILTypeDefLayout.Auto + Extends=extends + Token=genToken() + //SecurityDecls=emptyILSecurityDecls; + //HasSecurity=false; + NestedTypes = ILTypeDefs( lazy [| for x in nestedTypes -> let td = x.Content in td.Namespace, td.Name, lazy td |] ) + Fields = { new ILFieldDefs with member __.Entries = [| for x in fields -> x.Content |] } + Properties = { new ILPropertyDefs with member __.Entries = [| for x in props -> x.Content |] } + Events = { new ILEventDefs with member __.Entries = [| for x in events -> x.Content |] } + Methods = ILMethodDefs (lazy [| for x in methods -> x.Content |]) + MethodImpls = { new ILMethodImplDefs with member __.Entries = methodImpls.ToArray() } + CustomAttrs = mkILCustomAttrs (cattrs.ToArray()) + } + override __.ToString() = "builder for " + joinILTypeName nsp nm + + type ILModuleBuilder(scoref, moduleName, manifest) = + let typeDefs = ResizeArray() + let cattrs = ResizeArray() + + member __.DefineType(nsp, name, attrs) = let tb = ILTypeBuilder(ILTypeRefScope.Top scoref, nsp, name, attrs) in typeDefs.Add tb; tb + member __.SetCustomAttribute(ca) = cattrs.Add(ca) + + member __.Content = + { Manifest=manifest + Name=moduleName + SubsystemVersion = (4, 0) + UseHighEntropyVA = false + SubSystemFlags=3 + IsDLL=true + IsILOnly=true + Platform=None + StackReserveSize=None + Is32Bit=false + Is32BitPreferred=false + Is64Bit=false + PhysicalAlignment=512 + VirtualAlignment=0x2000 + ImageBase=0x034f0000 + MetadataVersion="" + Resources=ILResources (lazy [| |]) + TypeDefs = ILTypeDefs( lazy [| for x in typeDefs-> let td = x.Content in td.Namespace, td.Name, lazy td |] ) + CustomAttrs = { new ILCustomAttrs with member __.Entries = cattrs.ToArray() } + } + override __.ToString() = "builder for " + moduleName + + type ILAssemblyBuilder(assemblyName: AssemblyName, fileName, ilg, attrs : ILCustomAttribute seq) = + let cattrs = ResizeArray(attrs) + let manifest = + { Name = assemblyName.Name + AuxModuleHashAlgorithm = 0x8004 // SHA1 + PublicKey = UNone + Version = UNone + Locale = UNone + CustomAttrs = { new ILCustomAttrs with member __.Entries = cattrs.ToArray() } + //AssemblyLongevity=ILAssemblyLongevity.Unspecified + DisableJitOptimizations = false + JitTracking = true + IgnoreSymbolStoreSequencePoints = false + Retargetable = false + ExportedTypes = ILExportedTypesAndForwarders (lazy [| |]) + EntrypointElsewhere=None } + let mb = ILModuleBuilder(ILScopeRef.Local, "MainModule", Some manifest) + member __.MainModule = mb + member __.Save() = + let il = mb.Content + let options: BinaryWriter.options = { ilg = ilg; pdbfile = None; portablePDB = false; embeddedPDB = false; embedAllSource = false; embedSourceList = []; sourceLink = ""; emitTailcalls = true; deterministic = false; showTimes = false; dumpDebugInfo = false } + BinaryWriter.WriteILBinary (fileName, options, il) + override __.ToString() = "builder for " + (assemblyName.ToString()) + + + type ExpectedStackState = + | Empty = 1 + | Address = 2 + | Value = 3 + + type CodeGenerator(assemblyMainModule: ILModuleBuilder, + genUniqueTypeName: (unit -> string), + implicitCtorArgsAsFields: ILFieldBuilder list, + convTypeToTgt: Type -> Type, + transType: Type -> ILType, + transFieldSpec: FieldInfo -> ILFieldSpec, + transMeth: MethodInfo -> ILMethodSpec, + transMethRef: MethodInfo -> ILMethodRef, + transCtorSpec: ConstructorInfo -> ILMethodSpec, + ilg: ILGenerator, + localsMap:Dictionary, + parameterVars) = + + // TODO: this works over FSharp.Core 4.4.0.0 types and methods. These types need to be retargeted to the target runtime. + + let getTypeFromHandleMethod() = (convTypeToTgt typeof).GetMethod("GetTypeFromHandle") + let languagePrimitivesType() = (convTypeToTgt (typedefof>.Assembly.GetType("Microsoft.FSharp.Core.LanguagePrimitives"))) + let parseInt32Method() = (convTypeToTgt (languagePrimitivesType())).GetMethod "ParseInt32" + let decimalConstructor() = (convTypeToTgt typeof).GetConstructor([| typeof; typeof; typeof; typeof; typeof |]) + let dateTimeConstructor() = (convTypeToTgt typeof).GetConstructor([| typeof; typeof |]) + let dateTimeOffsetConstructor() = (convTypeToTgt typeof).GetConstructor([| typeof; typeof |]) + let timeSpanConstructor() = (convTypeToTgt typeof).GetConstructor([|typeof|]) + + let decimalTypeTgt = convTypeToTgt typeof + let convertTypeTgt = convTypeToTgt typeof + let stringTypeTgt = convTypeToTgt typeof + let mathTypeTgt = convTypeToTgt typeof + + let makeTypePattern tp = + let tt = convTypeToTgt tp + fun (t : Type) -> if t = tt then Some() else None + + let (|Bool|_|) = makeTypePattern(typeof) + let (|SByte|_|) = makeTypePattern(typeof) + let (|Int16|_|) = makeTypePattern(typeof) + let (|Int32|_|) = makeTypePattern(typeof) + let (|Int64|_|) = makeTypePattern(typeof) + let (|Byte|_|) = makeTypePattern(typeof) + let (|UInt16|_|) = makeTypePattern(typeof) + let (|UInt32|_|) = makeTypePattern(typeof) + let (|UInt64|_|) = makeTypePattern(typeof) + let (|Single|_|) = makeTypePattern(typeof) + let (|Double|_|) = makeTypePattern(typeof) + let (|Char|_|) = makeTypePattern(typeof) + let (|Decimal|_|) = makeTypePattern(typeof) + let (|String|_|) = makeTypePattern(typeof) + + let (|StaticMethod|_|) name tps (t : Type) = + match t.GetMethod(name, BindingFlags.Static ||| BindingFlags.Public, null, tps, null) with + | null -> None + | m -> Some m + + let (|StaticMethodWithReturnType|_|) name tps returnType (t : Type) = + t.GetMethods(BindingFlags.Static ||| BindingFlags.Public) + |> Array.tryFind + (fun x -> + x.Name = name + && x.ReturnType = returnType + && (x.GetParameters() |> Array.map (fun i -> i.ParameterType)) = tps) + + + let (|SpecificCall|_|) templateParameter = + // Note: precomputation + match templateParameter with + | (Lambdas(_, Call(_, minfo1, _)) | Call(_, minfo1, _)) -> + let targetType = convTypeToTgt minfo1.DeclaringType + let minfo1 = targetType.GetMethod(minfo1.Name, bindAll) + let isg1 = minfo1.IsGenericMethod + let gmd = + if minfo1.IsGenericMethodDefinition then + minfo1 + elif isg1 then + minfo1.GetGenericMethodDefinition() + else null + + // end-of-precomputation + + (fun tm -> + match tm with + | Call(obj, minfo2, args) + #if FX_NO_REFLECTION_METADATA_TOKENS + when ( // if metadata tokens are not available we'll rely only on equality of method references + #else + when (minfo1.MetadataToken = minfo2.MetadataToken && + #endif + if isg1 then + minfo2.IsGenericMethod && gmd = minfo2.GetGenericMethodDefinition() + else + minfo1 = minfo2) -> + Some(obj, (minfo2.GetGenericArguments() |> Array.toList), args) + | _ -> None) + | _ -> + invalidArg "templateParameter" "The parameter is not a recognized method name" + + let (|MakeDecimal|_|) = + let minfo1 = languagePrimitivesType().GetNestedType("IntrinsicFunctions").GetMethod("MakeDecimal") + (fun tm -> + match tm with + | Call(None, minfo2, args) + #if FX_NO_REFLECTION_METADATA_TOKENS + when ( // if metadata tokens are not available we'll rely only on equality of method references + #else + when (minfo1.MetadataToken = minfo2.MetadataToken && + #endif + minfo1 = minfo2) -> + Some(args) + | _ -> None) + + let (|NaN|_|) = + let operatorsType = convTypeToTgt (typedefof>.Assembly.GetType("Microsoft.FSharp.Core.Operators")) + let minfo1 = operatorsType.GetProperty("NaN").GetGetMethod() + (fun e -> + match e with + | Call(None, minfo2, []) + #if FX_NO_REFLECTION_METADATA_TOKENS + when ( // if metadata tokens are not available we'll rely only on equality of method references + #else + when (minfo1.MetadataToken = minfo2.MetadataToken && + #endif + minfo1 = minfo2) -> + Some() + | _ -> None) + + let (|NaNSingle|_|) = + let operatorsType = convTypeToTgt (typedefof>.Assembly.GetType("Microsoft.FSharp.Core.Operators")) + let minfo1 = operatorsType.GetProperty("NaNSingle").GetGetMethod() + (fun e -> + match e with + | Call(None, minfo2, []) + #if FX_NO_REFLECTION_METADATA_TOKENS + when ( // if metadata tokens are not available we'll rely only on equality of method references + #else + when (minfo1.MetadataToken = minfo2.MetadataToken && + #endif + minfo1 = minfo2) -> + Some() + | _ -> None) + + let (|TypeOf|_|) = (|SpecificCall|_|) <@ typeof @> + + let (|LessThan|_|) = (|SpecificCall|_|) <@ (<) @> + let (|GreaterThan|_|) = (|SpecificCall|_|) <@ (>) @> + let (|LessThanOrEqual|_|) = (|SpecificCall|_|) <@ (<=) @> + let (|GreaterThanOrEqual|_|) = (|SpecificCall|_|) <@ (>=) @> + let (|Equals|_|) = (|SpecificCall|_|) <@ (=) @> + let (|NotEquals|_|) = (|SpecificCall|_|) <@ (<>) @> + let (|Multiply|_|) = (|SpecificCall|_|) <@ (*) @> + let (|Addition|_|) = (|SpecificCall|_|) <@ (+) @> + let (|Subtraction|_|) = (|SpecificCall|_|) <@ (-) @> + let (|UnaryNegation|_|) = (|SpecificCall|_|) <@ (~-) @> + let (|Division|_|) = (|SpecificCall|_|) <@ (/) @> + let (|UnaryPlus|_|) = (|SpecificCall|_|) <@ (~+) @> + let (|Modulus|_|) = (|SpecificCall|_|) <@ (%) @> + let (|LeftShift|_|) = (|SpecificCall|_|) <@ (<<<) @> + let (|RightShift|_|) = (|SpecificCall|_|) <@ (>>>) @> + let (|And|_|) = (|SpecificCall|_|) <@ (&&&) @> + let (|Or|_|) = (|SpecificCall|_|) <@ (|||) @> + let (|Xor|_|) = (|SpecificCall|_|) <@ (^^^) @> + let (|Not|_|) = (|SpecificCall|_|) <@ (~~~) @> + //let (|Compare|_|) = (|SpecificCall|_|) <@ compare @> + let (|Max|_|) = (|SpecificCall|_|) <@ max @> + let (|Min|_|) = (|SpecificCall|_|) <@ min @> + //let (|Hash|_|) = (|SpecificCall|_|) <@ hash @> + let (|CallByte|_|) = (|SpecificCall|_|) <@ byte @> + let (|CallSByte|_|) = (|SpecificCall|_|) <@ sbyte @> + let (|CallUInt16|_|) = (|SpecificCall|_|) <@ uint16 @> + let (|CallInt16|_|) = (|SpecificCall|_|) <@ int16 @> + let (|CallUInt32|_|) = (|SpecificCall|_|) <@ uint32 @> + let (|CallInt|_|) = (|SpecificCall|_|) <@ int @> + let (|CallInt32|_|) = (|SpecificCall|_|) <@ int32 @> + let (|CallUInt64|_|) = (|SpecificCall|_|) <@ uint64 @> + let (|CallInt64|_|) = (|SpecificCall|_|) <@ int64 @> + let (|CallSingle|_|) = (|SpecificCall|_|) <@ single @> + let (|CallFloat32|_|) = (|SpecificCall|_|) <@ float32 @> + let (|CallDouble|_|) = (|SpecificCall|_|) <@ double @> + let (|CallFloat|_|) = (|SpecificCall|_|) <@ float @> + let (|CallDecimal|_|) = (|SpecificCall|_|) <@ decimal @> + let (|CallChar|_|) = (|SpecificCall|_|) <@ char @> + let (|Ignore|_|) = (|SpecificCall|_|) <@ ignore @> + let (|GetArray|_|) = (|SpecificCall|_|) <@ LanguagePrimitives.IntrinsicFunctions.GetArray @> + let (|GetArray2D|_|) = (|SpecificCall|_|) <@ LanguagePrimitives.IntrinsicFunctions.GetArray2D @> + let (|GetArray3D|_|) = (|SpecificCall|_|) <@ LanguagePrimitives.IntrinsicFunctions.GetArray3D @> + let (|GetArray4D|_|) = (|SpecificCall|_|) <@ LanguagePrimitives.IntrinsicFunctions.GetArray4D @> + + let (|Abs|_|) = (|SpecificCall|_|) <@ abs @> + let (|Acos|_|) = (|SpecificCall|_|) <@ acos @> + let (|Asin|_|) = (|SpecificCall|_|) <@ asin @> + let (|Atan|_|) = (|SpecificCall|_|) <@ atan @> + let (|Atan2|_|) = (|SpecificCall|_|) <@ atan2 @> + let (|Ceil|_|) = (|SpecificCall|_|) <@ ceil @> + let (|Exp|_|) = (|SpecificCall|_|) <@ exp @> + let (|Floor|_|) = (|SpecificCall|_|) <@ floor @> + let (|Truncate|_|) = (|SpecificCall|_|) <@ truncate @> + let (|Round|_|) = (|SpecificCall|_|) <@ round @> + let (|Sign|_|) = (|SpecificCall|_|) <@ sign @> + let (|Log|_|) = (|SpecificCall|_|) <@ log @> + let (|Log10|_|) = (|SpecificCall|_|) <@ log10 @> + let (|Sqrt|_|) = (|SpecificCall|_|) <@ sqrt @> + let (|Cos|_|) = (|SpecificCall|_|) <@ cos @> + let (|Cosh|_|) = (|SpecificCall|_|) <@ cosh @> + let (|Sin|_|) = (|SpecificCall|_|) <@ sin @> + let (|Sinh|_|) = (|SpecificCall|_|) <@ sinh @> + let (|Tan|_|) = (|SpecificCall|_|) <@ tan @> + let (|Tanh|_|) = (|SpecificCall|_|) <@ tanh @> + //let (|Range|_|) = (|SpecificCall|_|) <@ (..) @> + //let (|RangeStep|_|) = (|SpecificCall|_|) <@ (.. ..) @> + let (|Pow|_|) = (|SpecificCall|_|) <@ ( ** ) @> + //let (|Pown|_|) = (|SpecificCall|_|) <@ pown @> + + let mathOp t1 name = + match t1 with + | Double -> + let m = mathTypeTgt.GetMethod(name, [|t1|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | Single -> + ilg.Emit(I_conv DT_R8) + let m = mathTypeTgt.GetMethod(name, [|convTypeToTgt typeof|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv DT_R4) + | StaticMethod name [|t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "%s not supported for type %s" name t1.Name + + let lessThan (a1 : Expr) (a2 : Expr) = + match <@@ (<) @@> with + | DerivedPatterns.Lambdas(vars, Call(None, meth, _)) -> + let targetType = convTypeToTgt meth.DeclaringType + let m = targetType.GetMethod(meth.Name, bindAll).MakeGenericMethod(a1.Type) + Expr.Call(m, [a1; a2]) + | _ -> failwith "Unreachable" + + let isEmpty s = (s = ExpectedStackState.Empty) + let isAddress s = (s = ExpectedStackState.Address) + let rec emitLambda(callSiteIlg: ILGenerator, v: Var, body: Expr, freeVars: seq, lambdaLocals: Dictionary<_, ILLocalBuilder>, parameters) = + let lambda: ILTypeBuilder = assemblyMainModule.DefineType(UNone, genUniqueTypeName(), TypeAttributes.Class) + + let fsharpFuncType = convTypeToTgt (typedefof>) + let voidType = convTypeToTgt typeof + let rec lambdaType (t : Type) = + if t.IsGenericType then + let args = t.GetGenericArguments() + let gdef = t.GetGenericTypeDefinition() + if args.Length = 2 && gdef.FullName = fsharpFuncType.FullName && args.[1] = voidType then + gdef.MakeGenericType(lambdaType args.[0], typeof) + else + gdef.MakeGenericType(args |> Array.map lambdaType) + else + t + + let baseType = convTypeToTgt (lambdaType (typedefof>.MakeGenericType(v.Type, body.Type))) + lambda.SetParent(transType baseType) + let baseCtor = baseType.GetConstructor(bindAll, null, [| |], null) + if isNull baseCtor then failwithf "Couldn't find default constructor on %O" baseType + let ctor = lambda.DefineDefaultConstructor(MethodAttributes.Public, transCtorSpec baseCtor) + let decl = baseType.GetMethod "Invoke" + let paramTypes = [| for p in decl.GetParameters() -> transType p.ParameterType |] + let retType = transType decl.ReturnType + let invoke = lambda.DefineMethod("Invoke", MethodAttributes.Virtual ||| MethodAttributes.Final ||| MethodAttributes.Public, retType, paramTypes) + lambda.DefineMethodOverride + { Overrides = OverridesSpec(transMethRef decl, transType decl.DeclaringType) + OverrideBy = invoke.FormalMethodSpec } + + // promote free vars to fields + let fields = ResizeArray() + for v in freeVars do + let f = lambda.DefineField(v.Name, transType v.Type, FieldAttributes.Assembly) + //Debug.Assert (v.Name <> "formatValue") + fields.Add(v, f) + + let lambdaLocals = Dictionary() + + let ilg = invoke.GetILGenerator() + for (v, f) in fields do + let l = ilg.DeclareLocal(transType v.Type) + ilg.Emit(I_ldarg 0) + ilg.Emit(I_ldfld (ILAlignment.Aligned, ILVolatility.Nonvolatile, f.FormalFieldSpec)) + ilg.Emit(I_stloc l.LocalIndex) + lambdaLocals.[v] <- l + + let unitType = transType (convTypeToTgt (typeof)) + let expectedState = if (retType = ILType.Void || retType.QualifiedName = unitType.QualifiedName) then ExpectedStackState.Empty else ExpectedStackState.Value + let lambadParamVars = [| Var("this", typeof); v|] + let codeGen = CodeGenerator(assemblyMainModule, genUniqueTypeName, implicitCtorArgsAsFields, convTypeToTgt, transType, transFieldSpec, transMeth, transMethRef, transCtorSpec, ilg, lambdaLocals, lambadParamVars) + codeGen.EmitExpr (expectedState, body) + if retType.QualifiedName = unitType.QualifiedName then + ilg.Emit(I_ldnull) + ilg.Emit(I_ret) + + callSiteIlg.Emit(I_newobj (ctor.FormalMethodSpec, None)) + for (v, f) in fields do + callSiteIlg.Emit(I_dup) + match localsMap.TryGetValue v with + | true, loc -> + callSiteIlg.Emit(I_ldloc loc.LocalIndex) + | false, _ -> + let index = parameters |> Array.findIndex ((=) v) + callSiteIlg.Emit(I_ldarg index) + callSiteIlg.Emit(I_stfld (ILAlignment.Aligned, ILVolatility.Nonvolatile, f.FormalFieldSpec)) + + and emitExpr expectedState expr = + let pop () = ilg.Emit(I_pop) + let popIfEmptyExpected s = if isEmpty s then pop() + let emitConvIfNecessary t1 = + if t1 = typeof then + ilg.Emit(I_conv DT_I2) + elif t1 = typeof then + ilg.Emit(I_conv DT_U2) + elif t1 = typeof then + ilg.Emit(I_conv DT_I1) + elif t1 = typeof then + ilg.Emit(I_conv DT_U1) + /// emits given expression to corresponding IL + match expr with + | ForIntegerRangeLoop(loopVar, first, last, body) -> + // for(loopVar = first..last) body + let lb = + match localsMap.TryGetValue loopVar with + | true, lb -> lb + | false, _ -> + let lb = ilg.DeclareLocal(transType loopVar.Type) + localsMap.Add(loopVar, lb) + lb + + // loopVar = first + emitExpr ExpectedStackState.Value first + ilg.Emit(I_stloc lb.LocalIndex) + + let before = ilg.DefineLabel() + let after = ilg.DefineLabel() + + ilg.MarkLabel before + ilg.Emit(I_ldloc lb.LocalIndex) + + emitExpr ExpectedStackState.Value last + ilg.Emit(I_brcmp (I_bgt, after)) + + emitExpr ExpectedStackState.Empty body + + // loopVar++ + ilg.Emit(I_ldloc lb.LocalIndex) + ilg.Emit(mk_ldc 1) + ilg.Emit(I_add) + ilg.Emit(I_stloc lb.LocalIndex) + + ilg.Emit(I_br before) + ilg.MarkLabel(after) + + | NewArray(elementTy, elements) -> + ilg.Emit(mk_ldc (List.length elements)) + ilg.Emit(I_newarr (ILArrayShape.SingleDimensional, transType elementTy)) + + elements + |> List.iteri (fun i el -> + ilg.Emit(I_dup) + ilg.Emit(mk_ldc i) + emitExpr ExpectedStackState.Value el + ilg.Emit(I_stelem_any (ILArrayShape.SingleDimensional, transType elementTy))) + + popIfEmptyExpected expectedState + + | WhileLoop(cond, body) -> + let before = ilg.DefineLabel() + let after = ilg.DefineLabel() + + ilg.MarkLabel before + emitExpr ExpectedStackState.Value cond + ilg.Emit(I_brcmp (I_brfalse, after)) + emitExpr ExpectedStackState.Empty body + ilg.Emit(I_br before) + + ilg.MarkLabel after + + | Var v -> + if isEmpty expectedState then () else + + // Try to interpret this as a method parameter + let methIdx = parameterVars |> Array.tryFindIndex (fun p -> p = v) + match methIdx with + | Some idx -> + ilg.Emit((if isAddress expectedState then I_ldarga idx else I_ldarg idx) ) + | None -> + + // Try to interpret this as an implicit field in a class + let implicitCtorArgFieldOpt = implicitCtorArgsAsFields |> List.tryFind (fun f -> f.Name = v.Name) + match implicitCtorArgFieldOpt with + | Some ctorArgField -> + ilg.Emit(I_ldarg 0) + ilg.Emit(I_ldfld (ILAlignment.Aligned, ILVolatility.Nonvolatile, ctorArgField.FormalFieldSpec)) + | None -> + + // Try to interpret this as a local + match localsMap.TryGetValue v with + | true, localBuilder -> + let idx = localBuilder.LocalIndex + ilg.Emit(if isAddress expectedState then I_ldloca idx else I_ldloc idx) + | false, _ -> + failwith "unknown parameter/field" + + | Coerce (arg, ty) -> + // castClass may lead to observable side-effects - InvalidCastException + emitExpr ExpectedStackState.Value arg + let argTy = arg.Type + let targetTy = ty + if argTy.IsValueType && not targetTy.IsValueType then + ilg.Emit(I_box (transType argTy)) + elif not argTy.IsValueType && targetTy.IsValueType then + ilg.Emit(I_unbox_any (transType targetTy)) + else + ilg.Emit(I_castclass (transType targetTy)) + + popIfEmptyExpected expectedState + + | TypeOf(None, [t1], []) -> emitExpr expectedState (Expr.Value(t1)) + + | NaN -> emitExpr ExpectedStackState.Value <@@ Double.NaN @@> + + | NaNSingle -> emitExpr ExpectedStackState.Value <@@ Single.NaN @@> + + | MakeDecimal(args) -> + emitExpr ExpectedStackState.Value (Expr.NewObjectUnchecked(decimalConstructor(), args)) + + | LessThan(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Bool | SByte | Char + | Double | Single + | Int16 | Int32 | Int64 -> ilg.Emit(I_clt) + | Byte + | UInt16 | UInt32 | UInt64 -> ilg.Emit(I_clt_un) + | String -> + ilg.Emit(I_call(Normalcall, (convTypeToTgt typeof).GetMethod("CompareOrdinal", [|t1; t1|]) |> transMeth, None)) + emitExpr ExpectedStackState.Value <@@ 0 @@> + ilg.Emit(I_clt) + | StaticMethod "op_LessThan" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (<) not supported for type %s" t1.Name + + + | GreaterThan(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Bool | SByte | Char + | Double | Single + | Int16 | Int32 | Int64 -> ilg.Emit(I_cgt) + | Byte + | UInt16 | UInt32 | UInt64 -> ilg.Emit(I_cgt_un) + | String -> + ilg.Emit(I_call(Normalcall, (convTypeToTgt typeof).GetMethod("CompareOrdinal", [|t1; t1|]) |> transMeth, None)) + emitExpr ExpectedStackState.Value <@@ 0 @@> + ilg.Emit(I_cgt) + | StaticMethod "op_GreaterThan" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (>) not supported for type %s" t1.Name + + + | LessThanOrEqual(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Bool | SByte | Char + | Int16 | Int32 | Int64 -> + ilg.Emit(I_cgt) + emitExpr ExpectedStackState.Value <@@ false @@> + ilg.Emit(I_ceq) + | Byte + | Double | Single + | UInt16 | UInt32 | UInt64 -> + ilg.Emit(I_cgt_un) + emitExpr ExpectedStackState.Value <@@ false @@> + ilg.Emit(I_ceq) + | String -> + ilg.Emit(I_call(Normalcall, (convTypeToTgt typeof).GetMethod("CompareOrdinal", [|t1; t1|]) |> transMeth, None)) + emitExpr ExpectedStackState.Value <@@ 0 @@> + ilg.Emit(I_cgt) + emitExpr ExpectedStackState.Value <@@ false @@> + ilg.Emit(I_ceq) + | StaticMethod "op_LessThanOrEqual" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (<=) not supported for type %s" t1.Name + + + | GreaterThanOrEqual(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Bool | SByte | Char + | Int16 | Int32 | Int64 -> + ilg.Emit(I_clt) + emitExpr ExpectedStackState.Value <@@ false @@> + ilg.Emit(I_ceq) + | Byte + | Double | Single + | UInt16 | UInt32 | UInt64 -> + ilg.Emit(I_clt_un) + emitExpr ExpectedStackState.Value <@@ false @@> + ilg.Emit(I_ceq) + | String -> + ilg.Emit(I_call(Normalcall, (convTypeToTgt typeof).GetMethod("CompareOrdinal", [|t1; t1|]) |> transMeth, None)) + emitExpr ExpectedStackState.Value <@@ 0 @@> + ilg.Emit(I_clt) + emitExpr ExpectedStackState.Value <@@ false @@> + ilg.Emit(I_ceq) + | StaticMethod "op_GreaterThanOrEqual" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (>=) not supported for type %s" t1.Name + + | Equals(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Bool | SByte | Char + | Double | Single + | Int16 | Int32 | Int64 + | Byte + | UInt16 | UInt32 | UInt64 -> ilg.Emit(I_ceq) + | String -> + ilg.Emit(I_call(Normalcall, (convTypeToTgt typeof).GetMethod("Equals", [|t1; t1|]) |> transMeth, None)) + | StaticMethod "op_Equality" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (=) not supported for type %s" t1.Name + + | NotEquals(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Bool | SByte | Char + | Double | Single + | Int16 | Int32 | Int64 + | Byte + | UInt16 | UInt32 | UInt64 -> + ilg.Emit(I_ceq) + emitExpr ExpectedStackState.Value <@@ false @@> + ilg.Emit(I_ceq) + | String -> + ilg.Emit(I_call(Normalcall, (convTypeToTgt typeof).GetMethod("Equals", [|t1; t1|]) |> transMeth, None)) + emitExpr ExpectedStackState.Value <@@ false @@> + ilg.Emit(I_ceq) + | StaticMethod "op_Inequality" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (<>) not supported for type %s" t1.Name + + | Multiply(None, [t1; t2; _], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | SByte | Byte + | Int16 | Int32 | Int64 + | UInt16 | UInt32 | UInt64 + | Double | Single -> + ilg.Emit(I_mul) + | StaticMethod "op_Multiply" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (*) not supported for type %s" t1.Name + emitConvIfNecessary t1 + + | Addition(None, [t1; t2; _], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | SByte | Byte + | Int16 | Int32 | Int64 + | UInt16 | UInt32 | UInt64 + | Double | Single + | Char -> + ilg.Emit(I_add) + | String -> + ilg.Emit(I_call(Normalcall, (convTypeToTgt typeof).GetMethod("Concat", [|t1; t1|]) |> transMeth, None)) + | StaticMethod "op_Addition" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (+) not supported for type %s" t1.Name + emitConvIfNecessary t1 + + | Subtraction(None, [t1; t2; _], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | SByte | Byte + | Int16 | Int32 | Int64 + | UInt16 | UInt32 | UInt64 + | Double | Single -> + ilg.Emit(I_sub) + | StaticMethod "op_Subtraction" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (-) not supported for type %s" t1.Name + emitConvIfNecessary t1 + + | UnaryNegation(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | SByte + | Int16 | Int32 | Int64 + | Double | Single -> + ilg.Emit(I_neg) + | StaticMethod "op_UnaryNegation" [|t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (~-) not supported for type %s" t1.Name + + | Division(None, [t1; t2; _], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Byte | UInt16 | UInt32 | UInt64 -> + ilg.Emit(I_div_un) + | SByte | Int16 | Int32 | Int64 + | Double | Single -> + ilg.Emit(I_div) + | StaticMethod "op_Division" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (/) not supported for type %s" t1.Name + emitConvIfNecessary t1 + + | UnaryPlus(None, [t1], [a1]) -> + match t1.GetMethod("op_UnaryPlus", [|t1|]) with + | null -> + emitExpr expectedState a1 + | m -> + emitExpr ExpectedStackState.Value a1 + ilg.Emit(I_call(Normalcall, transMeth m, None)) + + | Modulus(None, [t1; t2; _], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Byte | UInt16 | UInt32 | UInt64 -> + ilg.Emit(I_rem_un) + | SByte | Int16 | Int32 | Int64 + | Double | Single -> + ilg.Emit(I_rem) + | StaticMethod "op_Modulus" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (%%) not supported for type %s" t1.Name + emitConvIfNecessary t1 + + | LeftShift(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + let maskShift (x : int) = + match a2 with + | Patterns.Value(:? int as v , _) -> + emitExpr ExpectedStackState.Value (Expr.Value (v &&& x)) + | _ -> + emitExpr ExpectedStackState.Value a2 + emitExpr ExpectedStackState.Value (Expr.Value x) + ilg.Emit(I_and) + ilg.Emit(I_shl) + match t1 with + | Int32 | UInt32 -> maskShift 31 + | Int64 | UInt64 -> maskShift 63 + | Int16 | UInt16 -> maskShift 15 + | SByte | Byte -> maskShift 7 + | StaticMethod "op_LeftShift" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (<<<) not supported for type %s" t1.Name + emitConvIfNecessary t1 + + | RightShift(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + let maskShift (x : int) = + match a2 with + | Patterns.Value(:? int as v , _) -> + emitExpr ExpectedStackState.Value (Expr.Value (v &&& x)) + | _ -> + emitExpr ExpectedStackState.Value a2 + emitExpr ExpectedStackState.Value (Expr.Value x) + ilg.Emit(I_and) + ilg.Emit(I_shr) + match t1 with + | Int32 | UInt32 -> maskShift 31 + | Int64 | UInt64 -> maskShift 63 + | Int16 | UInt16 -> maskShift 15 + | SByte | Byte -> maskShift 7 + | StaticMethod "op_RightShift" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (>>>) not supported for type %s" t1.Name + emitConvIfNecessary t1 + + | And(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Int32 | UInt32 + | Int64 | UInt64 + | Int16 | UInt16 + | SByte | Byte -> ilg.Emit(I_and) + | StaticMethod "op_And" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (&&&) not supported for type %s" t1.Name + + | Or(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Int32 | UInt32 + | Int64 | UInt64 + | Int16 | UInt16 + | SByte | Byte -> ilg.Emit(I_or) + | StaticMethod "op_Or" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (|||) not supported for type %s" t1.Name + + | Xor(None, [t1], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Int32 | UInt32 + | Int64 | UInt64 + | Int16 | UInt16 + | SByte | Byte -> ilg.Emit(I_xor) + | StaticMethod "op_Xor" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (^^^) not supported for type %s" t1.Name + + | Not(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Int32 | UInt32 + | Int64 | UInt64 + | Int16 | UInt16 + | SByte | Byte -> ilg.Emit(I_not) + | StaticMethod "op_Not" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator (~~~) not supported for type %s" t1.Name + + | Max(None, [t1], [a1; a2]) -> + match t1 with + | Double -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + let m = mathTypeTgt.GetMethod("Max", [|t1; t1|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | Single -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + ilg.Emit(I_conv DT_R8) + let t = convTypeToTgt typeof + let m = mathTypeTgt.GetMethod("Max", [|t;t|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv DT_R4) + | _ -> + match a1, a2 with + | (Var _ | Value _), (Var _ | Value _) -> + Expr.IfThenElseUnchecked(lessThan a1 a2, a2, a1) + |> emitExpr ExpectedStackState.Value + | (Var _ | Value _), _ -> + let e2 = Var("e2", a2.Type) + Expr.Let(e2, a2, + Expr.IfThenElseUnchecked(lessThan a1 (Expr.Var e2), Expr.Var e2, a1)) + |> emitExpr ExpectedStackState.Value + | _, (Var _ | Value _) -> + let e1 = Var("e1", a1.Type) + Expr.Let(e1, a1, + Expr.IfThenElseUnchecked((lessThan (Expr.Var e1) a2, a2, (Expr.Var e1)))) + |> emitExpr ExpectedStackState.Value + | _ -> + let e1 = Var("e1", a1.Type) + let e2 = Var("e2", a2.Type) + Expr.Let(e1, a1, + Expr.Let(e2, a2, + Expr.IfThenElseUnchecked(lessThan (Expr.Var e1) (Expr.Var e2), Expr.Var e2, Expr.Var e1))) + |> emitExpr ExpectedStackState.Value + + | Min(None, [t1], [a1; a2]) -> + match t1 with + | Double -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + let m = mathTypeTgt.GetMethod("Min", [|t1; t1|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | Single -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + ilg.Emit(I_conv DT_R8) + let t = convTypeToTgt typeof + let m = mathTypeTgt.GetMethod("Min", [|t;t|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv DT_R4) + | _ -> + match a1, a2 with + | (Var _ | Value _), (Var _ | Value _) -> + Expr.IfThenElseUnchecked(lessThan a1 a2, a1, a2) + |> emitExpr ExpectedStackState.Value + | (Var _ | Value _), _ -> + let e2 = Var("e2", a2.Type) + Expr.Let(e2, a2, + Expr.IfThenElseUnchecked(lessThan a1 (Expr.Var e2), a1, Expr.Var e2)) + |> emitExpr ExpectedStackState.Value + | _, (Var _ | Value _) -> + let e1 = Var("e1", a1.Type) + Expr.Let(e1, a1, + Expr.IfThenElseUnchecked((lessThan (Expr.Var e1) a2, Expr.Var e1, a2))) + |> emitExpr ExpectedStackState.Value + | _ -> + let e1 = Var("e1", a1.Type) + let e2 = Var("e2", a2.Type) + Expr.Let(e1, a1, + Expr.Let(e2, a2, + Expr.IfThenElseUnchecked(lessThan (Expr.Var e1) (Expr.Var e2), Expr.Var e1, Expr.Var e2))) + |> emitExpr ExpectedStackState.Value + + | CallByte(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Char + | Double | Single + | Int32 | UInt32 + | Int64 | UInt64 + | Int16 | UInt16 + | SByte | Byte -> ilg.Emit(I_conv DT_U1) + | String -> + let m = languagePrimitivesType().GetMethod("ParseUInt32") + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv_ovf DT_U1) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'byte' not supported for type %s" t1.Name + + | CallSByte(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Char + | Double | Single + | Int32 | UInt32 + | Int64 | UInt64 + | Int16 | UInt16 + | SByte | Byte -> ilg.Emit(I_conv DT_I1) + | String -> + let m = languagePrimitivesType().GetMethod("ParseInt32") + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv_ovf DT_I1) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'sbyte' not supported for type %s" t1.Name + + | CallUInt16(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Char + | Double | Single + | Int32 | UInt32 + | Int64 | UInt64 + | Int16 | UInt16 + | SByte | Byte -> ilg.Emit(I_conv DT_U2) + | String -> + let m = languagePrimitivesType().GetMethod("ParseUInt32") + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv_ovf DT_U2) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'uint16' not supported for type %s" t1.Name + + | CallInt16(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Char + | Double | Single + | Int32 | UInt32 + | Int64 | UInt64 + | Int16 | UInt16 + | SByte | Byte -> ilg.Emit(I_conv DT_I2) + | String -> + let m = languagePrimitivesType().GetMethod("ParseInt32") + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv_ovf DT_I2) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'int16' not supported for type %s" t1.Name + + | CallUInt32(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Char + | Double | Single + | UInt16 | UInt32 + | Int64 | UInt64 + | Byte -> ilg.Emit(I_conv DT_U4) + | Int32 | Int16 | SByte -> () + | String -> + let m = languagePrimitivesType().GetMethod("ParseUInt32") + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'uint32' not supported for type %s" t1.Name + + | CallInt(None, [t1], [a1]) + | CallInt32(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Char + | Double | Single + | UInt16 + | Int64 | UInt64 + | Byte -> ilg.Emit(I_conv DT_I4) + | UInt32 | Int32 | Int16 | SByte -> () + | String -> + let m = languagePrimitivesType().GetMethod("ParseInt32") + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'int32' not supported for type %s" t1.Name + + | CallUInt64(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Char + | Double | Single + | UInt16 | UInt32 + | Byte -> ilg.Emit(I_conv DT_U8) + | SByte | Int32 | Int16 -> ilg.Emit(I_conv DT_I8) + | Int64 | UInt64 -> () + | String -> + let m = languagePrimitivesType().GetMethod("ParseUInt64") + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'uint64' not supported for type %s" t1.Name + + | CallInt64(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Double | Single + | Int64 | Int32 | Int16 + | SByte -> ilg.Emit(I_conv DT_I8) + | Char | Byte | UInt16 | UInt32 -> + ilg.Emit(I_conv DT_U8) + | UInt64 -> () + | String -> + let m = languagePrimitivesType().GetMethod("ParseInt64") + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'int64' not supported for type %s" t1.Name + + | CallSingle(None, [t1], [a1]) + | CallFloat32(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Double | Single + | Int64 | Int32 | Int16 + | SByte -> ilg.Emit(I_conv DT_R4) + | Char | Byte | UInt16 | UInt32 | UInt64 -> + ilg.Emit(I_conv DT_R) + ilg.Emit(I_conv DT_R4) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> + match expr.Type with + | StaticMethodWithReturnType "Parse" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'float32' not supported for type %s" t1.Name + + | CallDouble(None, [t1], [a1]) + | CallFloat(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Double | Single + | Int64 | Int32 | Int16 + | SByte -> ilg.Emit(I_conv DT_R8) + | Char | Byte | UInt16 | UInt32 | UInt64 -> + ilg.Emit(I_conv DT_R) + ilg.Emit(I_conv DT_R8) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> + match expr.Type with + | StaticMethodWithReturnType "Parse" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'float' not supported for type %s" t1.Name + + | CallDecimal(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + let rtTgt = decimalTypeTgt + if t1 = stringTypeTgt then + let m = rtTgt.GetMethod("Parse", [|stringTypeTgt|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + else + match convertTypeTgt.GetMethod("ToDecimal", [|t1|]) with + | null -> + let m = + t1.GetMethods(BindingFlags.Static ||| BindingFlags.Public) + |> Array.tryFind + (fun x -> + x.Name = "op_Explicit" + && x.ReturnType = rtTgt + && (x.GetParameters() |> Array.map (fun i -> i.ParameterType)) = [|t1|]) + match m with + | None -> + failwithf "decimal operator on %s not supported" (t1.Name) + | Some m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | toDecimal -> ilg.Emit(I_call(Normalcall, transMeth toDecimal, None)) + + | CallChar(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Double | Single + | Int64 | Int32 | Int16 + | Char | Byte | UInt16 | UInt32 | UInt64 + | SByte -> ilg.Emit(I_conv DT_U2) + | StaticMethodWithReturnType "op_Explicit" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> + match expr.Type with + | StaticMethodWithReturnType "Parse" [|t1|] expr.Type m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Operator 'char' not supported for type %s" t1.Name + + | Ignore(None, [t1], [a1]) -> emitExpr expectedState a1 + + | GetArray(None, [ty], [arr; index]) -> + // observable side-effect - IndexOutOfRangeException + emitExpr ExpectedStackState.Value arr + emitExpr ExpectedStackState.Value index + if isAddress expectedState then + ilg.Emit(I_ldelema (ILReadonly.ReadonlyAddress, ILArrayShape.SingleDimensional, transType ty)) + else + ilg.Emit(I_ldelem_any (ILArrayShape.SingleDimensional, transType ty)) + + popIfEmptyExpected expectedState + + | GetArray2D(None, _ty, arr::indices) + | GetArray3D(None, _ty, arr::indices) + | GetArray4D(None, _ty, arr::indices) -> + + let meth = + let name = if isAddress expectedState then "Address" else "Get" + arr.Type.GetMethod(name) + + // observable side-effect - IndexOutOfRangeException + emitExpr ExpectedStackState.Value arr + for index in indices do + emitExpr ExpectedStackState.Value index + + //if isAddress expectedState then + // ilg.Emit(I_readonly) + + ilg.Emit(mkNormalCall (transMeth meth)) + + popIfEmptyExpected expectedState + + | Abs(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Int32 | Double | Single | Int64 | Int16 | SByte | Decimal -> + let m = mathTypeTgt.GetMethod("Abs", [|t1|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | StaticMethod "Abs" [|t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Abs not supported for type %s" t1.Name + + | Acos(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Acos" + + | Asin(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Asin" + + | Atan(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Atan" + + | Atan2(None, [t1;t2], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Double -> + let m = mathTypeTgt.GetMethod("Atan2", [|t1; t1|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | Single -> + ilg.Emit(I_conv DT_R8) + let t = convTypeToTgt typeof + let m = mathTypeTgt.GetMethod("Atan2", [|t;t|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv DT_R4) + | StaticMethod "Atan2" [|t1; t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Atan2 not supported for type %s" t1.Name + + | Ceil(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Ceiling" + + | Exp(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Exp" + + | Floor(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Floor" + + | Truncate(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Truncate" + + | Round(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Round" + + | Sign(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + match t1 with + | Int32 | Double | Single | Int64 | Int16 | SByte | Decimal -> + let m = mathTypeTgt.GetMethod("Sign", [|t1|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | Single -> + ilg.Emit(I_conv DT_R8) + let m = mathTypeTgt.GetMethod("Sign", [|convTypeToTgt typeof|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv DT_R4) + | StaticMethod "Sign" [|t1|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Sign not supported for type %s" t1.Name + + | Log(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Log" + + | Log10(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Log10" + + | Sqrt(None, [t1; t2], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Sqrt" + + | Cos(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Cos" + + | Cosh(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Cosh" + + | Sin(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Sin" + + | Sinh(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Sinh" + + | Tan(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Tan" + + | Tanh(None, [t1], [a1]) -> + emitExpr ExpectedStackState.Value a1 + mathOp t1 "Tanh" + + | Pow(None, [t1; t2], [a1; a2]) -> + emitExpr ExpectedStackState.Value a1 + emitExpr ExpectedStackState.Value a2 + match t1 with + | Double -> + let m = mathTypeTgt.GetMethod("Pow", [|t1; t1|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | Single -> + ilg.Emit(I_conv DT_R8) + let t = convTypeToTgt typeof + let m = mathTypeTgt.GetMethod("Pow", [|t;t|]) + ilg.Emit(I_call(Normalcall, transMeth m, None)) + ilg.Emit(I_conv DT_R4) + | StaticMethod "Pow" [|t1; t2|] m -> + ilg.Emit(I_call(Normalcall, transMeth m, None)) + | _ -> failwithf "Pow not supported for type %s" t1.Name + + | FieldGet (None, field) when field.DeclaringType.IsEnum -> + if expectedState <> ExpectedStackState.Empty then + emitExpr expectedState (Expr.Value(field.GetRawConstantValue(), field.FieldType.GetEnumUnderlyingType())) + + | FieldGet (objOpt, field) -> + objOpt |> Option.iter (fun e -> + let s = if e.Type.IsValueType then ExpectedStackState.Address else ExpectedStackState.Value + emitExpr s e) + if field.IsStatic then + ilg.Emit(I_ldsfld (ILVolatility.Nonvolatile, transFieldSpec field)) + else + ilg.Emit(I_ldfld (ILAlignment.Aligned, ILVolatility.Nonvolatile, transFieldSpec field)) + + | FieldSet (objOpt, field, v) -> + objOpt |> Option.iter (fun e -> + let s = if e.Type.IsValueType then ExpectedStackState.Address else ExpectedStackState.Value + emitExpr s e) + emitExpr ExpectedStackState.Value v + if field.IsStatic then + ilg.Emit(I_stsfld (ILVolatility.Nonvolatile, transFieldSpec field)) + else + ilg.Emit(I_stfld (ILAlignment.Aligned, ILVolatility.Nonvolatile, transFieldSpec field)) + + | Call (objOpt, meth, args) -> + objOpt |> Option.iter (fun e -> + let s = if e.Type.IsValueType then ExpectedStackState.Address else ExpectedStackState.Value + emitExpr s e) + + for pe in args do + emitExpr ExpectedStackState.Value pe + + // Handle the case where this is a generic method instantiated at a type being compiled + let mappedMeth = transMeth meth + + match objOpt with + | Some obj when meth.IsAbstract || meth.IsVirtual -> + if obj.Type.IsValueType then + ilg.Emit(I_callconstraint (Normalcall, transType obj.Type, mappedMeth, None)) + else + ilg.Emit(I_callvirt (Normalcall, mappedMeth, None)) + | _ -> + ilg.Emit(mkNormalCall mappedMeth) + + let returnTypeIsVoid = (mappedMeth.FormalReturnType = ILType.Void) + match returnTypeIsVoid, (isEmpty expectedState) with + | false, true -> + // method produced something, but we don't need it + pop() + | true, false when expr.Type = typeof -> + // if we need result and method produce void and result should be unit - push null as unit value on stack + ilg.Emit(I_ldnull) + | _ -> () + + | NewObject (ctor, args) -> + for pe in args do + emitExpr ExpectedStackState.Value pe + ilg.Emit(I_newobj (transCtorSpec ctor, None)) + + popIfEmptyExpected expectedState + + | DefaultValue (t) -> + let ilt = transType t + let lb = ilg.DeclareLocal ilt + ilg.Emit(I_ldloca lb.LocalIndex) + ilg.Emit(I_initobj ilt) + ilg.Emit(I_ldloc lb.LocalIndex) + + | Value (obj, _ty) -> + let rec emitC (v:obj) = + match v with + | :? string as x -> ilg.Emit(I_ldstr x) + | :? int8 as x -> ilg.Emit(mk_ldc (int32 x)) + | :? uint8 as x -> ilg.Emit(mk_ldc (int32 x)) + | :? int16 as x -> ilg.Emit(mk_ldc (int32 x)) + | :? uint16 as x -> ilg.Emit(mk_ldc (int32 x)) + | :? int32 as x -> ilg.Emit(mk_ldc x) + | :? uint32 as x -> ilg.Emit(mk_ldc (int32 x)) + | :? int64 as x -> ilg.Emit(mk_ldc_i8 x) + | :? uint64 as x -> ilg.Emit(mk_ldc_i8 (int64 x)) + | :? char as x -> ilg.Emit(mk_ldc (int32 x)) + | :? bool as x -> ilg.Emit(mk_ldc (if x then 1 else 0)) + | :? float32 as x -> ilg.Emit(I_ldc (DT_R4, ILConst.R4 x)) + | :? float as x -> ilg.Emit(I_ldc(DT_R8, ILConst.R8 x)) + #if !FX_NO_GET_ENUM_UNDERLYING_TYPE + | :? Enum as x when x.GetType().GetEnumUnderlyingType() = typeof -> ilg.Emit(mk_ldc (unbox v)) + #endif + | :? Type as ty -> + ilg.Emit(I_ldtoken (ILToken.ILType (transType ty))) + ilg.Emit(mkNormalCall (transMeth (getTypeFromHandleMethod()))) + | :? decimal as x -> + let bits = Decimal.GetBits x + ilg.Emit(mk_ldc bits.[0]) + ilg.Emit(mk_ldc bits.[1]) + ilg.Emit(mk_ldc bits.[2]) + do + let sign = (bits.[3] &&& 0x80000000) <> 0 + ilg.Emit(if sign then mk_ldc 1 else mk_ldc 0) + do + let scale = (bits.[3] >>> 16) &&& 0x7F + ilg.Emit(mk_ldc scale) + ilg.Emit(I_newobj (transCtorSpec (decimalConstructor()), None)) + | :? DateTime as x -> + ilg.Emit(mk_ldc_i8 x.Ticks) + ilg.Emit(mk_ldc (int x.Kind)) + ilg.Emit(I_newobj (transCtorSpec (dateTimeConstructor()), None)) + | :? DateTimeOffset as x -> + ilg.Emit(mk_ldc_i8 x.Ticks) + ilg.Emit(mk_ldc_i8 x.Offset.Ticks) + ilg.Emit(I_newobj (transCtorSpec (timeSpanConstructor()), None)) + ilg.Emit(I_newobj (transCtorSpec (dateTimeOffsetConstructor()), None)) + | null -> ilg.Emit(I_ldnull) + | _ -> failwithf "unknown constant '%A' of type '%O' in generated method. You may need to avoid variable capture in a quotation specifying a type provider." v (v.GetType()) + if isEmpty expectedState then () + else emitC obj + + | Let(v, e, b) -> + let ty = transType v.Type + let lb = ilg.DeclareLocal ty + //printfn "declared local %d of original type %O and target type %O for variable %O" lb.LocalIndex v.Type ty v + localsMap.Add (v, lb) + emitExpr ExpectedStackState.Value e + ilg.Emit(I_stloc lb.LocalIndex) + emitExpr expectedState b + + | TypeTest(e, tgtTy) -> + let tgtTyT = transType tgtTy + emitExpr ExpectedStackState.Value e + ilg.Emit(I_isinst tgtTyT) + + | Sequential(e1, e2) -> + emitExpr ExpectedStackState.Empty e1 + emitExpr expectedState e2 + + | IfThenElse(cond, ifTrue, ifFalse) -> + let ifFalseLabel = ilg.DefineLabel() + let endLabel = ilg.DefineLabel() + + emitExpr ExpectedStackState.Value cond + + ilg.Emit(I_brcmp (I_brfalse, ifFalseLabel)) + + emitExpr expectedState ifTrue + ilg.Emit(I_br endLabel) + + ilg.MarkLabel(ifFalseLabel) + emitExpr expectedState ifFalse + + ilg.Emit(I_nop) + ilg.MarkLabel(endLabel) + + | TryWith(body, _filterVar, _filterBody, catchVar, catchBody) -> + + let stres, ldres = + if isEmpty expectedState then ignore, ignore + else + let local = ilg.DeclareLocal (transType body.Type) + let stres = fun () -> ilg.Emit(I_stloc local.LocalIndex) + let ldres = fun () -> ilg.Emit(I_ldloc local.LocalIndex) + stres, ldres + + let exceptionVar = ilg.DeclareLocal(transType catchVar.Type) + localsMap.Add(catchVar, exceptionVar) + + ilg.BeginExceptionBlock() + + emitExpr expectedState body + stres() + ilg.EndGuardedBlock() + + ilg.BeginCatchBlock(transType catchVar.Type) + ilg.Emit(I_stloc exceptionVar.LocalIndex) + emitExpr expectedState catchBody + stres() + ilg.EndExceptionBlock() + + ldres() + + | TryFinally(body, finallyBody) -> + + let stres, ldres = + if isEmpty expectedState then ignore, ignore + else + let local = ilg.DeclareLocal (transType body.Type) + let stres = fun () -> ilg.Emit(I_stloc local.LocalIndex) + let ldres = fun () -> ilg.Emit(I_ldloc local.LocalIndex) + stres, ldres + + ilg.BeginExceptionBlock() |> ignore + + emitExpr expectedState body + stres() + ilg.EndGuardedBlock() + + ilg.BeginFinallyBlock() |> ignore + + emitExpr expectedState finallyBody + + ilg.EndExceptionBlock() + + ldres() + + | VarSet(v, e) -> + emitExpr ExpectedStackState.Value e + match localsMap.TryGetValue v with + | true, localBuilder -> + ilg.Emit(I_stloc localBuilder.LocalIndex) + | false, _ -> + failwith "unknown parameter/field in assignment. Only assignments to locals are currently supported by TypeProviderEmit" + | Lambda(v, body) -> + let lambdaLocals = Dictionary() + emitLambda(ilg, v, body, expr.GetFreeVars(), lambdaLocals, parameterVars) + popIfEmptyExpected expectedState + + | n -> + failwithf "unknown expression '%A' in generated method" n + + member __.EmitExpr (expectedState, expr) = emitExpr expectedState expr + + //------------------------------------------------------------------------------------------------- + // AssemblyCompiler: the assembly compiler for generative type providers. + + /// Implements System.Reflection.Assembly backed by ILModuleReader over generated bytes + type AssemblyCompiler(targetAssembly: ProvidedAssembly, context: ProvidedTypesContext) = + + + let typeMap = Dictionary(HashIdentity.Reference) + let typeMapExtra = Dictionary(HashIdentity.Structural) + let ctorMap = Dictionary(HashIdentity.Reference) + let methMap = Dictionary(HashIdentity.Reference) + let fieldMap = Dictionary(HashIdentity.Reference) + let genUniqueTypeName() = + // lambda name should be unique across all types that all type provider might contribute in result assembly + sprintf "Lambda%O" (Guid.NewGuid()) + + let convTypeToTgt ty = context.ConvertSourceTypeToTarget ty + let rec defineNestedTypes (tb:ILTypeBuilder) (td: ProvidedTypeDefinition) = + Debug.Assert(td.BelongsToTargetModel, "expected a target ProvidedTypeDefinition in nested type") + for ntd in td.GetNestedTypes(bindAll) do + defineNestedType tb ntd + + and defineNestedType (tb:ILTypeBuilder) (ntd: Type) = + match ntd with + | :? ProvidedTypeDefinition as pntd -> + if pntd.IsErased then failwith ("The nested provided type "+pntd.Name+" is marked as erased and cannot be converted to a generated type. Set 'IsErased=false' on the ProvidedTypeDefinition") + Debug.Assert(pntd.BelongsToTargetModel, "expected a target ProvidedTypeDefinition in nested type") + // Adjust the attributes - we're codegen'ing this type as nested + let attributes = adjustTypeAttributes true ntd.Attributes + let ntb = tb.DefineNestedType(pntd.Name, attributes) + typeMap.[pntd] <- ntb + defineNestedTypes ntb pntd + | _ -> () + + let rec transType (ty:Type) = + if (match ty with :? ProvidedTypeDefinition as ty -> not ty.BelongsToTargetModel | _ -> false) then failwithf "expected '%O' to belong to the target model" ty + if ty.IsGenericParameter then ILType.Var ty.GenericParameterPosition + elif ty.HasElementType then + let ety = transType (ty.GetElementType()) + if ty.IsArray then + let rank = ty.GetArrayRank() + if rank = 1 then ILType.Array(ILArrayShape.SingleDimensional, ety) + else ILType.Array(ILArrayShape.FromRank rank, ety) + elif ty.IsPointer then ILType.Ptr ety + elif ty.IsByRef then ILType.Byref ety + else failwith "unexpected type with element type" + elif ty.Namespace = "System" && ty.Name = "Void" then ILType.Void + elif ty.IsValueType then ILType.Value (transTypeSpec ty) + else ILType.Boxed (transTypeSpec ty) + + and transTypeSpec (ty: Type) = + if ty.IsGenericType then + ILTypeSpec(transTypeRef (ty.GetGenericTypeDefinition()), Array.map transType (ty.GetGenericArguments())) + else + ILTypeSpec(transTypeRef ty, [| |]) + + and transTypeRef (ty: Type) = + let ty = if ty.IsGenericType then ty.GetGenericTypeDefinition() else ty + ILTypeRef(transTypeRefScope ty, StructOption.ofObj (if ty.IsNested then null else ty.Namespace), ty.Name) + + and transTypeRefScope (ty: Type): ILTypeRefScope = + match ty.DeclaringType with + | null -> + if ty.Assembly = null then failwithf "null assembly for type %s" ty.FullName + ILTypeRefScope.Top (transScopeRef ty.Assembly) + | dt -> ILTypeRefScope.Nested (transTypeRef dt) + + and transScopeRef (assem: Assembly): ILScopeRef = + // Note: this simple equality check on assembly objects doesn't work on Mono, there must be some small difference in the + // implementation of equality on System.Assembly objects + // if assem = (targetAssembly :> Assembly) then ILScopeRef.Local + if assem.GetName().Name = targetAssembly.GetName().Name then ILScopeRef.Local + else ILScopeRef.Assembly (ILAssemblyRef.FromAssemblyName (assem.GetName())) + + let transCtorRef (m:ConstructorInfo) = + // Remove the generic instantiations to get the uninstantiated identity of the method + let m2 = m.GetDefinition() + let cc = (if m2.IsStatic then ILCallingConv.Static else ILCallingConv.Instance) + let ptys = [| for p in m2.GetParameters() -> transType p.ParameterType |] + ILMethodRef (transTypeRef m2.DeclaringType, cc, 0, m2.Name, ptys, ILType.Void) + + let transCtorSpec (f:ConstructorInfo) = + if (match f with :? ProvidedConstructor as f -> not f.BelongsToTargetModel | _ -> false) then failwithf "expected '%O' to belong to the target model" f + match f with + | :? ProvidedConstructor as pc when ctorMap.ContainsKey pc -> ctorMap.[pc].FormalMethodSpec + | m -> ILMethodSpec(transCtorRef f, transType m.DeclaringType, [| |]) + + let transFieldSpec (f:FieldInfo) = + if (match f with :? ProvidedField as f -> not f.BelongsToTargetModel | _ -> false) then failwithf "expected '%O' to belong to the target model" f + match f with + | :? ProvidedField as pf when fieldMap.ContainsKey pf -> fieldMap.[pf].FormalFieldSpec + | f -> + let f2 = f.GetDefinition() + ILFieldSpec(ILFieldRef (transTypeRef f2.DeclaringType, f2.Name, transType f2.FieldType), transType f.DeclaringType) + + let transMethRef (m:MethodInfo) = + if (match m with :? ProvidedMethod as m -> not m.BelongsToTargetModel | _ -> false) then failwithf "expected '%O' to belong to the target model" m + // Remove the generic instantiations to get the uninstantiated identity of the method + let m2 = m.GetDefinition() + let ptys = [| for p in m2.GetParameters() -> transType p.ParameterType |] + let genarity = (if m2.IsGenericMethod then m2.GetGenericArguments().Length else 0) + let cc = (if m2.IsStatic then ILCallingConv.Static else ILCallingConv.Instance) + ILMethodRef (transTypeRef m2.DeclaringType, cc, genarity, m2.Name, ptys, transType m2.ReturnType) + + let transMeth (m:MethodInfo): ILMethodSpec = + match m with + | :? ProvidedMethod as pm when methMap.ContainsKey pm -> methMap.[pm].FormalMethodSpec + | m -> + //Debug.Assert (m.Name <> "get_Item1" || m.DeclaringType.Name <> "Tuple`2") + let mref = transMethRef m + let minst = (if m.IsGenericMethod then Array.map transType (m.GetGenericArguments()) else [| |]) + ILMethodSpec(mref, transType m.DeclaringType, minst) + + let iterateTypes f providedTypeDefinitions = + let rec typeMembers (ptd: ProvidedTypeDefinition) = + let tb = typeMap.[ptd] + f tb (Some ptd) + for ntd in ptd.GetNestedTypes(bindAll) do + nestedType ntd + + and nestedType (ntd: Type) = + match ntd with + | :? ProvidedTypeDefinition as pntd -> typeMembers pntd + | _ -> () + + for (pt, enclosingGeneratedTypeNames) in providedTypeDefinitions do + match enclosingGeneratedTypeNames with + | None -> + typeMembers pt + | Some ns -> + let _fullName = + ("", ns) ||> List.fold (fun fullName n -> + let fullName = if fullName = "" then n else fullName + "." + n + f typeMapExtra.[fullName] None + fullName) + nestedType pt + + let defineCustomAttrs f (cattrs: IList) = + for attr in cattrs do + let constructorArgs = [ for x in attr.ConstructorArguments -> x.Value ] + let transValue (o:obj) = + match o with + | :? Type as t -> box (transType t) + | v -> v + let namedProps = [ for x in attr.NamedArguments do match x.MemberInfo with :? PropertyInfo as pi -> yield ILCustomAttrNamedArg(pi.Name, transType x.TypedValue.ArgumentType, x.TypedValue.Value) | _ -> () ] + let namedFields = [ for x in attr.NamedArguments do match x.MemberInfo with :? FieldInfo as pi -> yield ILCustomAttrNamedArg(pi.Name, transType x.TypedValue.ArgumentType, x.TypedValue.Value) | _ -> () ] + let ca = mkILCustomAttribMethRef (transCtorSpec attr.Constructor, constructorArgs, namedProps, namedFields) + f ca + + member __.Compile(isHostedExecution) = + let providedTypeDefinitionsT = targetAssembly.GetTheTypes() |> Array.collect (fun (tds, nsps) -> Array.map (fun td -> (td, nsps)) tds) + let ilg = context.ILGlobals + let assemblyName = targetAssembly.GetName() + let assemblyFileName = targetAssembly.Location + let assemblyBuilder = + let attrs = targetAssembly.GetCustomAttributesData() + let cattrs = ResizeArray() + defineCustomAttrs cattrs.Add attrs + ILAssemblyBuilder(assemblyName, assemblyFileName, ilg, cattrs) + let assemblyMainModule = assemblyBuilder.MainModule + + // Set the Assembly on the type definitions + for (ptdT, _) in providedTypeDefinitionsT do + if not ptdT.BelongsToTargetModel then failwithf "expected '%O' to belong to the target model" ptdT + ptdT.SetAssemblyInternal (K (targetAssembly :> Assembly)) + + // phase 1 - define types + for (pt, enclosingGeneratedTypeNames) in providedTypeDefinitionsT do + match enclosingGeneratedTypeNames with + | None -> + // Filter out the additional TypeProviderTypeAttributes flags + let attributes = pt.Attributes &&& ~~~(enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) + &&& ~~~(enum (int32 TypeProviderTypeAttributes.IsErased)) + // Adjust the attributes - we're codegen'ing as non-nested + let attributes = adjustTypeAttributes false attributes + let tb = assemblyMainModule.DefineType(StructOption.ofObj pt.Namespace, pt.Name, attributes) + typeMap.[pt] <- tb + defineNestedTypes tb pt + + | Some ns -> + let otb, _ = + ((None, ""), ns) ||> List.fold (fun (otb:ILTypeBuilder option, fullName) n -> + let fullName = if fullName = "" then n else fullName + "." + n + let priorType = if typeMapExtra.ContainsKey(fullName) then Some typeMapExtra.[fullName] else None + let tb = + match priorType with + | Some tbb -> tbb + | None -> + // OK, the implied nested type is not defined, define it now + let attributes = TypeAttributes.Public ||| TypeAttributes.Class ||| TypeAttributes.Sealed + let attributes = adjustTypeAttributes otb.IsSome attributes + let tb = + match otb with + | None -> + let nsp, n = splitILTypeName n + assemblyMainModule.DefineType(nsp, n, attributes) + | Some (otb:ILTypeBuilder) -> + otb.DefineNestedType(n, attributes) + typeMapExtra.[fullName] <- tb + tb + (Some tb, fullName)) + defineNestedType otb.Value pt + + + // phase 1b - emit base types + providedTypeDefinitionsT |> iterateTypes (fun tb ptdT -> + match ptdT with + | None -> () + | Some ptdT -> + match ptdT.BaseType with + | null -> () + | bt -> tb.SetParent(transType bt)) + + // phase 2 - emit member definitions + providedTypeDefinitionsT |> iterateTypes (fun tb ptdT -> + match ptdT with + | None -> () + | Some ptdT -> + for cinfo in ptdT.GetConstructors(bindAll) do + match cinfo with + | :? ProvidedConstructor as pcinfo when not (ctorMap.ContainsKey pcinfo) -> + let cb = + if pcinfo.IsTypeInitializer then + if (cinfo.GetParameters()).Length <> 0 then failwith "Type initializer should not have parameters" + tb.DefineTypeInitializer() + else + let cb = tb.DefineConstructor(cinfo.Attributes, [| for p in cinfo.GetParameters() -> transType p.ParameterType |]) + for (i, p) in cinfo.GetParameters() |> Seq.mapi (fun i x -> (i, x)) do + cb.DefineParameter(i+1, ParameterAttributes.None, p.Name) |> ignore + cb + ctorMap.[pcinfo] <- cb + | _ -> () + + if ptdT.IsEnum then + tb.DefineField("value__", transType (ptdT.GetEnumUnderlyingType()), FieldAttributes.Public ||| FieldAttributes.SpecialName ||| FieldAttributes.RTSpecialName) + |> ignore + + for finfo in ptdT.GetFields(bindAll) do + match finfo with + | :? ProvidedField as pinfo -> + let fb = tb.DefineField(finfo.Name, transType finfo.FieldType, finfo.Attributes) + + if finfo.IsLiteral then + fb.SetConstant (pinfo.GetRawConstantValue()) + + defineCustomAttrs fb.SetCustomAttribute (pinfo.GetCustomAttributesData()) + + fieldMap.[finfo] <- fb + + | _ -> () + + for minfo in ptdT.GetMethods(bindAll) do + match minfo with + | :? ProvidedMethod as pminfo when not (methMap.ContainsKey pminfo) -> + let mb = tb.DefineMethod(minfo.Name, minfo.Attributes, transType minfo.ReturnType, [| for p in minfo.GetParameters() -> transType p.ParameterType |]) + + for (i, p) in minfo.GetParameters() |> Seq.mapi (fun i x -> (i, x :?> ProvidedParameter)) do + + let pb = mb.DefineParameter(i+1, p.Attributes, p.Name) + if p.HasDefaultParameterValue then + let ctorTy = typeof + let ctor = ctorTy.GetConstructor([|typeof|]) + let ctorTgt = context.ConvertSourceConstructorRefToTarget ctor + + let ca = mkILCustomAttribMethRef (transCtorSpec ctorTgt, [p.RawDefaultValue], [], []) + pb.SetCustomAttribute ca + + let ctorTy = typeof + let ctor = ctorTy.GetConstructor([||]) + let ctorTgt = context.ConvertSourceConstructorRefToTarget ctor + let ca = mkILCustomAttribMethRef (transCtorSpec ctorTgt, [], [], []) + pb.SetCustomAttribute ca + + pb.SetConstant p.RawDefaultValue + + methMap.[pminfo] <- mb + + | _ -> () + + for ityp in ptdT.GetInterfaces() do + tb.AddInterfaceImplementation (transType ityp)) + + // phase 3 - emit member code + providedTypeDefinitionsT |> iterateTypes (fun tb ptdT -> + match ptdT with + | None -> () + | Some ptdT -> + + defineCustomAttrs tb.SetCustomAttribute (ptdT.GetCustomAttributesData()) + + // Allow at most one constructor, and use its arguments as the fields of the type + let ctors = + ptdT.GetConstructors(bindAll) // exclude type initializer + |> Seq.choose (function :? ProvidedConstructor as pcinfo when not pcinfo.IsTypeInitializer -> Some pcinfo | _ -> None) + |> Seq.toList + + let implictCtorArgs = + match ctors |> List.filter (fun x -> x.IsImplicitConstructor) with + | [] -> [] + | [ pcinfo ] -> [ for p in pcinfo.GetParameters() -> p ] + | _ -> failwith "at most one implicit constructor allowed" + + let implicitCtorArgsAsFields = + [ for ctorArg in implictCtorArgs -> + tb.DefineField(ctorArg.Name, transType ctorArg.ParameterType, FieldAttributes.Private) ] + + + // Emit the constructor (if any) + for pcinfo in ctors do + assert ctorMap.ContainsKey pcinfo + if not pcinfo.BelongsToTargetModel then failwithf "expected '%O' to be a target ProvidedConstructor. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" pcinfo + let cb = ctorMap.[pcinfo] + + defineCustomAttrs cb.SetCustomAttribute (pcinfo.GetCustomAttributesData()) + + let ilg = cb.GetILGenerator() + let ctorLocals = Dictionary() + let parameterVars = + [| yield Var("this", pcinfo.DeclaringType) + for p in pcinfo.GetParameters() do + yield Var(p.Name, p.ParameterType) |] + + let codeGen = CodeGenerator(assemblyMainModule, genUniqueTypeName, implicitCtorArgsAsFields, convTypeToTgt, transType, transFieldSpec, transMeth, transMethRef, transCtorSpec, ilg, ctorLocals, parameterVars) + + let parameters = [ for v in parameterVars -> Expr.Var v ] + + match pcinfo.BaseCall with + | None -> + ilg.Emit(I_ldarg 0) + let cinfo = ptdT.BaseType.GetConstructor(bindAll, null, [| |], null) + ilg.Emit(mkNormalCall (transCtorSpec cinfo)) + | Some f -> + // argExprs should always include 'this' + let (cinfo, argExprs) = f parameters + for argExpr in argExprs do + codeGen.EmitExpr (ExpectedStackState.Value, argExpr) + ilg.Emit(mkNormalCall (transCtorSpec cinfo)) + + if pcinfo.IsImplicitConstructor then + for ctorArgsAsFieldIdx, ctorArgsAsField in List.mapi (fun i x -> (i, x)) implicitCtorArgsAsFields do + ilg.Emit(I_ldarg 0) + ilg.Emit(I_ldarg (ctorArgsAsFieldIdx+1)) + ilg.Emit(I_stfld (ILAlignment.Aligned, ILVolatility.Nonvolatile, ctorArgsAsField.FormalFieldSpec)) + else + let code = pcinfo.GetInvokeCode parameters + codeGen.EmitExpr (ExpectedStackState.Empty, code) + ilg.Emit(I_ret) + + match ptdT.GetConstructors(bindAll) |> Seq.tryPick (function :? ProvidedConstructor as pc when pc.IsTypeInitializer -> Some pc | _ -> None) with + | None -> () + | Some _ when ptdT.IsInterface -> + failwith "The provided type definition is an interface; therefore, it may not provide constructors." + | Some pc -> + let cb = ctorMap.[pc] + let ilg = cb.GetILGenerator() + + defineCustomAttrs cb.SetCustomAttribute (pc.GetCustomAttributesData()) + + let expr = pc.GetInvokeCode [ ] + let ctorLocals = new Dictionary<_, _>() + let codeGen = CodeGenerator(assemblyMainModule, genUniqueTypeName, implicitCtorArgsAsFields, convTypeToTgt, transType, transFieldSpec, transMeth, transMethRef, transCtorSpec, ilg, ctorLocals, [| |]) + codeGen.EmitExpr (ExpectedStackState.Empty, expr) + ilg.Emit I_ret + + // Emit the methods + for minfo in ptdT.GetMethods(bindAll) do + match minfo with + | :? ProvidedMethod as pminfo -> + if not pminfo.BelongsToTargetModel then failwithf "expected '%O' to be a target ProvidedMethod. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" pminfo + let mb = methMap.[pminfo] + defineCustomAttrs mb.SetCustomAttribute (pminfo.GetCustomAttributesData()) + + let parameterVars = + [| if not pminfo.IsStatic then + yield Var("this", pminfo.DeclaringType) + for p in pminfo.GetParameters() do + yield Var(p.Name, p.ParameterType) |] + let parameters = + [ for v in parameterVars -> Expr.Var v ] + + match pminfo.GetInvokeCode with + | Some _ when ptdT.IsInterface -> + failwith "The provided type definition is an interface; therefore, it should not define an implementation for its members." + | Some _ when pminfo.IsAbstract -> + failwith "The provided method is marked as an abstract method; therefore, it should not define an implementation." + | None when not (pminfo.IsAbstract || ptdT.IsAbstract ||ptdT.IsInterface) -> + failwith "The provided method is not marked as an abstract method; therefore, it should define an implementation." + | None when pminfo.IsAbstract || ptdT.IsInterface -> + // abstract and interface methods have no body at all + () + | None -> + let ilg = mb.GetILGenerator() + ilg.Emit I_ret + | Some invokeCode -> + let ilg = mb.GetILGenerator() + let expr = invokeCode parameters + + let methLocals = Dictionary() + + let expectedState = if (transType minfo.ReturnType = ILType.Void) then ExpectedStackState.Empty else ExpectedStackState.Value + let codeGen = CodeGenerator(assemblyMainModule, genUniqueTypeName, implicitCtorArgsAsFields, convTypeToTgt, transType, transFieldSpec, transMeth, transMethRef, transCtorSpec, ilg, methLocals, parameterVars) + codeGen.EmitExpr (expectedState, expr) + ilg.Emit I_ret + | _ -> () + + for (bodyMethInfo, declMethInfo) in ptdT.GetMethodOverrides() do + let bodyMethBuilder = methMap.[bodyMethInfo] + tb.DefineMethodOverride + { Overrides = OverridesSpec(transMethRef declMethInfo, transType declMethInfo.DeclaringType) + OverrideBy = bodyMethBuilder.FormalMethodSpec } + + for evt in ptdT.GetEvents(bindAll) |> Seq.choose (function :? ProvidedEvent as pe -> Some pe | _ -> None) do + if not evt.BelongsToTargetModel then failwithf "expected '%O' to be a target ProvidedEvent. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" evt + let eb = tb.DefineEvent(evt.Name, evt.Attributes) + defineCustomAttrs eb.SetCustomAttribute (evt.GetCustomAttributesData()) + eb.SetAddOnMethod(methMap.[evt.GetAddMethod(true) :?> _]) + eb.SetRemoveOnMethod(methMap.[evt.GetRemoveMethod(true) :?> _]) + + for pinfo in ptdT.GetProperties(bindAll) |> Seq.choose (function :? ProvidedProperty as pe -> Some pe | _ -> None) do + + let pb = tb.DefineProperty(pinfo.Name, pinfo.Attributes, transType pinfo.PropertyType, [| for p in pinfo.GetIndexParameters() -> transType p.ParameterType |]) + + defineCustomAttrs pb.SetCustomAttribute (pinfo.GetCustomAttributesData()) + + if pinfo.CanRead then + let minfo = pinfo.GetGetMethod(true) + pb.SetGetMethod (methMap.[minfo :?> ProvidedMethod ]) + + if pinfo.CanWrite then + let minfo = pinfo.GetSetMethod(true) + pb.SetSetMethod (methMap.[minfo :?> ProvidedMethod ])) + + //printfn "saving generated binary to '%s'" assemblyFileName + assemblyBuilder.Save () + //printfn "re-reading generated binary from '%s'" assemblyFileName + let reader = ILModuleReaderAfterReadingAllBytes(assemblyFileName, ilg) + let bytes = File.ReadAllBytes(assemblyFileName) +#if DEBUG + printfn "generated binary is at '%s'" assemblyFileName #else - static member RegisterGenerated (fileName:string) = - //printfn "registered assembly in '%s'" fileName - let assemblyBytes = System.IO.File.ReadAllBytes fileName - let assembly = Assembly.Load(assemblyBytes,null,System.Security.SecurityContextSource.CurrentAppDomain) - GlobalProvidedAssemblyElementsTable.theTable.Add(assembly, Lazy<_>.CreateFromValue assemblyBytes) - assembly + File.Delete assemblyFileName #endif + // Use a real Reflection Load when running in F# Interactive + if isHostedExecution then + let realTargetAssembly = Assembly.Load(bytes) + for (ptdT, _) in providedTypeDefinitionsT do + ptdT.SetAssemblyInternal (K realTargetAssembly) -module Local = + bytes - let makeProvidedNamespace (namespaceName:string) (types:ProvidedTypeDefinition list) = - let types = [| for ty in types -> ty :> Type |] - {new IProvidedNamespace with - member _.GetNestedNamespaces() = [| |] - member _.NamespaceName = namespaceName - member _.GetTypes() = types |> Array.copy - member _.ResolveTypeName typeName : System.Type = - match types |> Array.tryFind (fun ty -> ty.Name = typeName) with - | Some ty -> ty - | None -> null - } +#endif // NO_GENERATIVE + +//------------------------------------------------------------------------------------------------- +// TypeProviderForNamespaces + +namespace ProviderImplementation.ProvidedTypes + + #nowarn "1182" + open System + open System.Diagnostics + open System.IO + open System.Collections.Concurrent + open System.Collections.Generic + open System.Reflection + + open Microsoft.FSharp.Quotations + open Microsoft.FSharp.Quotations.DerivedPatterns + open Microsoft.FSharp.Quotations.Patterns + open Microsoft.FSharp.Quotations.ExprShape + open Microsoft.FSharp.Core.CompilerServices + open Microsoft.FSharp.Reflection + + open ProviderImplementation.ProvidedTypes + open ProviderImplementation.ProvidedTypes.AssemblyReader + open ProviderImplementation.ProvidedTypes.UncheckedQuotations + + type TypeProviderForNamespaces(config: TypeProviderConfig, namespacesAndTypes: list<(string * list)>, assemblyReplacementMap: (string*string) list, sourceAssemblies: Assembly list, addDefaultProbingLocation: bool) as this = + + let ctxt = ProvidedTypesContext.Create (config, assemblyReplacementMap, sourceAssemblies) + +#if !NO_GENERATIVE + let theTable = ConcurrentDictionary() + + // When using hosted execution (i.e. in F# Interactive), ensure the generated assembly for a generated type is + // actually fully compiled and loaded as a reflection-load assembly before handing the type back to the API. + let ensureCompiled (t: Type) = + match t with + | :? ProvidedTypeDefinition as pt when pt.IsErased || pt.GetStaticParametersInternal().Length > 0 || not config.IsHostedExecution -> t + | _ -> + let origAssembly = t.Assembly + + // We expect the results reported by t.Assembly to actually change after this call, because the act of compilation + // when isHostedExecution=true replaces the Assembly object reported. + (this :> ITypeProvider).GetGeneratedAssemblyContents(origAssembly) |> ignore + + //printfn "t.Assembly = %O" t.Assembly + //printfn "t.Assembly.Location = %O" t.Assembly.Location + //printfn "t.FullName = %O" t.FullName + //printfn "t.Assembly.GetTypes() = %A" (t.Assembly.GetTypes()) + let tyName = t.FullName.Replace(",", "\\,") + let newAssembly = t.Assembly + let newAssemblyName = newAssembly.GetName().Name + let origAssemblyName = origAssembly.GetName().Name + // check the assembly was generated with the correct name + if newAssemblyName <> origAssemblyName then + failwithf "expected identical assembly name keys '%s' and '%s'" origAssemblyName newAssemblyName + + // check the type really exists + if t.Assembly.GetType(tyName) = null then + failwithf "couldn't find type '%s' in assembly '%O'" tyName t.Assembly + + t -#if FX_NO_LOCAL_FILESYSTEM -type TypeProviderForNamespaces(namespacesAndTypes : list<(string * list)>) = #else -type TypeProviderForNamespaces(namespacesAndTypes : list<(string * list)>) as this = + let ensureCompiled (t: Type) = t #endif - let otherNamespaces = ResizeArray>() - let providedNamespaces = - lazy [| for (namespaceName,types) in namespacesAndTypes do - yield Local.makeProvidedNamespace namespaceName types - for (namespaceName,types) in otherNamespaces do - yield Local.makeProvidedNamespace namespaceName types |] + let makeProvidedNamespace (namespaceName:string) (typesSrc:ProvidedTypeDefinition list) = + let typesSrc = [| for ty in typesSrc -> ty :> Type |] + let nsSrc = + { new IProvidedNamespace with + member __.GetNestedNamespaces() = [| |] + member __.NamespaceName = namespaceName + member __.GetTypes() = typesSrc |> Array.map ensureCompiled + member __.ResolveTypeName typeName = typesSrc |> Array.tryFind (fun ty -> ty.Name = typeName) |> Option.map ensureCompiled |> Option.toObj } + let nsT = ctxt.ConvertSourceNamespaceToTarget nsSrc + nsT - let invalidateE = new Event() + let namespacesT = ResizeArray() - let disposing = Event() + do for (namespaceName, types) in namespacesAndTypes do + namespacesT.Add (makeProvidedNamespace namespaceName types) -#if FX_NO_LOCAL_FILESYSTEM -#else - let probingFolders = ResizeArray() - let handler = ResolveEventHandler(fun _ args -> this.ResolveAssembly(args)) - do AppDomain.CurrentDomain.add_AssemblyResolve handler + let invalidateE = new Event() + + let disposing = Event() + + +#if !FX_NO_LOCAL_FILESYSTEM + let probingFolders = ResizeArray() + let handler = ResolveEventHandler(fun _ args -> this.ResolveAssembly(args)) + do AppDomain.CurrentDomain.add_AssemblyResolve handler #endif - new (namespaceName:string,types:list) = new TypeProviderForNamespaces([(namespaceName,types)]) - new () = new TypeProviderForNamespaces([]) + // By default add the location of the TPDTC assembly (which is assumed to contain this file) + // as a probing location. + do if addDefaultProbingLocation then + let thisAssembly = Assembly.GetExecutingAssembly() + let folder = thisAssembly.Location |> Path.GetDirectoryName + probingFolders.Add folder + + new (config, namespaceName, types, ?sourceAssemblies, ?assemblyReplacementMap, ?addDefaultProbingLocation) = + let sourceAssemblies = defaultArg sourceAssemblies [ Assembly.GetCallingAssembly() ] + let assemblyReplacementMap = defaultArg assemblyReplacementMap [] + let addDefaultProbingLocation = defaultArg addDefaultProbingLocation false + new TypeProviderForNamespaces(config, [(namespaceName, types)], assemblyReplacementMap=assemblyReplacementMap, sourceAssemblies=sourceAssemblies, addDefaultProbingLocation=addDefaultProbingLocation) - [] - member _.Disposing = disposing.Publish + new (config, ?sourceAssemblies, ?assemblyReplacementMap, ?addDefaultProbingLocation) = + let sourceAssemblies = defaultArg sourceAssemblies [ Assembly.GetCallingAssembly() ] + let assemblyReplacementMap = defaultArg assemblyReplacementMap [] + let addDefaultProbingLocation = defaultArg addDefaultProbingLocation false + new TypeProviderForNamespaces(config, [], assemblyReplacementMap=assemblyReplacementMap, sourceAssemblies=sourceAssemblies, addDefaultProbingLocation=addDefaultProbingLocation) + + member __.TargetContext = ctxt + + [] + member __.Disposing = disposing.Publish #if FX_NO_LOCAL_FILESYSTEM - interface System.IDisposable with - member x.Dispose() = - disposing.Trigger(x, EventArgs.Empty) + + interface IDisposable with + member x.Dispose() = + disposing.Trigger(x, EventArgs.Empty) + #else - abstract member ResolveAssembly : args : System.ResolveEventArgs -> Assembly - - default _.ResolveAssembly(args) = - let expectedName = (AssemblyName(args.Name)).Name + ".dll" - let expectedLocationOpt = - probingFolders - |> Seq.map (fun f -> IO.Path.Combine(f, expectedName)) - |> Seq.tryFind IO.File.Exists - match expectedLocationOpt with - | Some f -> Assembly.LoadFrom f - | None -> null - - member _.RegisterProbingFolder (folder) = - // use GetFullPath to ensure that folder is valid - ignore(IO.Path.GetFullPath folder) - probingFolders.Add folder - - member _.RegisterRuntimeAssemblyLocationAsProbingFolder (config : TypeProviderConfig) = - config.RuntimeAssembly - |> IO.Path.GetDirectoryName - |> this.RegisterProbingFolder - - interface System.IDisposable with - member x.Dispose() = - disposing.Trigger(x, EventArgs.Empty) - AppDomain.CurrentDomain.remove_AssemblyResolve handler -#endif - member _.AddNamespace (namespaceName,types:list<_>) = otherNamespaces.Add (namespaceName,types) + abstract member ResolveAssembly: args: ResolveEventArgs -> Assembly + + default __.ResolveAssembly(args) = + let expectedName = (AssemblyName(args.Name)).Name + ".dll" + let expectedLocationOpt = + probingFolders + |> Seq.map (fun f -> Path.Combine(f, expectedName)) + |> Seq.tryFind File.Exists + match expectedLocationOpt with + | Some f -> Assembly.LoadFrom f + | None -> null + + member __.RegisterProbingFolder (folder) = + // use GetFullPath to ensure that folder is valid + ignore(Path.GetFullPath folder) + probingFolders.Add folder + + member __.RegisterRuntimeAssemblyLocationAsProbingFolder (config: TypeProviderConfig) = + config.RuntimeAssembly + |> Path.GetDirectoryName + |> this.RegisterProbingFolder + + interface IDisposable with + member x.Dispose() = + disposing.Trigger(x, EventArgs.Empty) + AppDomain.CurrentDomain.remove_AssemblyResolve handler +#endif - // FSharp.Data addition: this method is used by Debug.fs - member _.Namespaces = Seq.readonly otherNamespaces + member __.AddNamespace (namespaceName, types) = + namespacesT.Add (makeProvidedNamespace namespaceName types) - member this.Invalidate() = invalidateE.Trigger(this,EventArgs()) + member __.Namespaces = + namespacesT.ToArray() - member _.GetStaticParametersForMethod(mb: MethodBase) = - printfn "In GetStaticParametersForMethod" - match mb with - | :? ProvidedMethod as t -> t.GetStaticParameters() - | _ -> [| |] + member this.Invalidate() = + invalidateE.Trigger(this, EventArgs()) - member _.ApplyStaticArgumentsForMethod(mb: MethodBase, mangledName, objs) = - printfn "In ApplyStaticArgumentsForMethod" - match mb with - | :? ProvidedMethod as t -> t.ApplyStaticArguments(mangledName, objs) :> MethodBase - | _ -> failwith (sprintf "ApplyStaticArguments: static parameters for method %s are unexpected" mb.Name) + member __.GetStaticParametersForMethod(mb: MethodBase) = + match mb with + | :? ProvidedMethod as t -> t.GetStaticParametersInternal() + | _ -> [| |] - interface ITypeProvider with + member __.ApplyStaticArgumentsForMethod(mb: MethodBase, mangledName, objs) = + match mb with + | :? ProvidedMethod as t -> t.ApplyStaticArguments(mangledName, objs) :> MethodBase + | _ -> failwithf "ApplyStaticArguments: static parameters for method %s are unexpected. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" mb.Name + + interface ITypeProvider with + + [] + member __.Invalidate = invalidateE.Publish + + member __.GetNamespaces() = namespacesT.ToArray() + + member __.GetInvokerExpression(methodBaseT, parametersT) = + + /// This checks that the GetInvokeCodeInternal doesn't return things containing calls to other provided methods or constructors. + let rec check expr = + match expr with + | NewObject((:? ProvidedConstructor), _) + | Call(_, :? ProvidedMethod, _) -> failwithf "The invokeCode for a ProvidedConstructor or ProvidedMethod included a use or another ProvidedConstructor or ProvidedMethod '%A'. This is not allowed. Instead, the invokeCode should be the compiled representation without invoking other provided objects" expr + | ShapeCombinationUnchecked(shape, args) -> RebuildShapeCombinationUnchecked(shape, List.map check args) + | ShapeVarUnchecked v -> Expr.Var v + | ShapeLambdaUnchecked(v, body) -> Expr.Lambda(v, check body) + + match methodBaseT with + | :? ProvidedMethod as mT when (match methodBaseT.DeclaringType with :? ProvidedTypeDefinition as pt -> pt.IsErased | _ -> true) -> + match mT.GetInvokeCode with + | Some _ when methodBaseT.DeclaringType.IsInterface -> + failwith "The provided type definition is an interface; therefore, it should not define an implementation for its members." + (* NOTE: These checks appear to fail for generative abstract and virtual methods. + | Some _ when mT.IsAbstract -> + failwith "The provided method is defined as abstract; therefore, it should not define an implementation." + | None when not mT.IsAbstract -> + failwith "The provided method is not defined as abstract; therefore it should define an implementation." + *) + | Some invokeCode -> + let exprT = invokeCode(Array.toList parametersT) + check exprT + | None -> <@@ () @@> + + | :? ProvidedConstructor as mT when (match methodBaseT.DeclaringType with :? ProvidedTypeDefinition as pt -> pt.IsErased | _ -> true) -> + if methodBaseT.DeclaringType.IsInterface then + failwith "The provided type definition is an interface; therefore, it should not define any constructors." + else + let exprT = mT.GetInvokeCode(Array.toList parametersT) + check exprT - [] - override _.Invalidate = invalidateE.Publish - - override _.GetNamespaces() = Array.copy providedNamespaces.Value - - member _.GetInvokerExpression(methodBase, parameters) = - let rec getInvokerExpression (methodBase : MethodBase) parameters = - match methodBase with - | :? ProvidedMethod as m when (match methodBase.DeclaringType with :? ProvidedTypeDefinition as pt -> pt.IsErased | _ -> true) -> - m.GetInvokeCodeInternal false parameters - |> expand - | :? ProvidedConstructor as m when (match methodBase.DeclaringType with :? ProvidedTypeDefinition as pt -> pt.IsErased | _ -> true) -> - m.GetInvokeCodeInternal false parameters - |> expand // Otherwise, assume this is a generative assembly and just emit a call to the constructor or method - | :? ConstructorInfo as cinfo -> - Quotations.Expr.NewObject(cinfo, Array.toList parameters) - | :? System.Reflection.MethodInfo as minfo -> - if minfo.IsStatic then - Quotations.Expr.Call(minfo, Array.toList parameters) + | :? ConstructorInfo as cinfoT -> + Expr.NewObjectUnchecked(cinfoT, Array.toList parametersT) + + | :? MethodInfo as minfoT -> + if minfoT.IsStatic then + Expr.CallUnchecked(minfoT, Array.toList parametersT) else - Quotations.Expr.Call(parameters.[0], minfo, Array.toList parameters.[1..]) - | _ -> failwith ("TypeProviderForNamespaces.GetInvokerExpression: not a ProvidedMethod/ProvidedConstructor/ConstructorInfo/MethodInfo, name=" + methodBase.Name + " class=" + methodBase.GetType().FullName) - and expand expr = - match expr with - | Quotations.Patterns.NewObject(ctor, args) -> getInvokerExpression ctor [| for arg in args -> expand arg|] - | Quotations.Patterns.Call(inst, mi, args) -> - let args = - [| - match inst with - | Some inst -> yield expand inst - | _ -> () - yield! List.map expand args - |] - getInvokerExpression mi args - | Quotations.ExprShape.ShapeVar v -> Quotations.Expr.Var v - | Quotations.ExprShape.ShapeLambda(v, body) -> Quotations.Expr.Lambda(v, expand body) - | Quotations.ExprShape.ShapeCombination(shape, args) -> Quotations.ExprShape.RebuildShapeCombination(shape, List.map expand args) - getInvokerExpression methodBase parameters -#if FX_NO_CUSTOMATTRIBUTEDATA - - member _.GetMemberCustomAttributesData(methodBase) = - match methodBase with - | :? ProvidedTypeDefinition as m -> m.GetCustomAttributesDataImpl() - | :? ProvidedMethod as m -> m.GetCustomAttributesDataImpl() - | :? ProvidedProperty as m -> m.GetCustomAttributesDataImpl() - | :? ProvidedConstructor as m -> m.GetCustomAttributesDataImpl() - | :? ProvidedEvent as m -> m.GetCustomAttributesDataImpl() - | :? ProvidedLiteralField as m -> m.GetCustomAttributesDataImpl() - | :? ProvidedField as m -> m.GetCustomAttributesDataImpl() - | _ -> [| |] :> IList<_> - - member _.GetParameterCustomAttributesData(methodBase) = - match methodBase with - | :? ProvidedParameter as m -> m.GetCustomAttributesDataImpl() - | _ -> [| |] :> IList<_> + Expr.CallUnchecked(parametersT.[0], minfoT, Array.toList parametersT.[1..]) + | _ -> failwith ("TypeProviderForNamespaces.GetInvokerExpression: not a ProvidedMethod/ProvidedConstructor/ConstructorInfo/MethodInfo, name=" + methodBaseT.Name + " class=" + methodBaseT.GetType().FullName) -#endif - override _.GetStaticParameters(ty) = - match ty with - | :? ProvidedTypeDefinition as t -> - if ty.Name = t.Name (* REVIEW: use equality? *) then - t.GetStaticParameters() - else - [| |] - | _ -> [| |] + member __.GetStaticParameters(ty) = + match ty with + | :? ProvidedTypeDefinition as t -> + if ty.Name = t.Name then + t.GetStaticParametersInternal() + else + [| |] + | _ -> [| |] - override _.ApplyStaticArguments(ty,typePathAfterArguments:string[],objs) = - let typePathAfterArguments = typePathAfterArguments.[typePathAfterArguments.Length-1] - match ty with - | :? ProvidedTypeDefinition as t -> (t.MakeParametricType(typePathAfterArguments,objs) :> Type) - | _ -> failwith (sprintf "ApplyStaticArguments: static params for type %s are unexpected" ty.FullName) + member __.ApplyStaticArguments(ty, typePathAfterArguments:string[], objs) = + let typePathAfterArguments = typePathAfterArguments.[typePathAfterArguments.Length-1] + match ty with + | :? ProvidedTypeDefinition as t -> + let ty = (t.ApplyStaticArguments(typePathAfterArguments, objs) :> Type) + ensureCompiled ty -#if FX_NO_LOCAL_FILESYSTEM - override _.GetGeneratedAssemblyContents(_assembly) = - // TODO: this is very fake, we rely on the fact it is never needed - match System.Windows.Application.GetResourceStream(System.Uri("FSharp.Core.dll",System.UriKind.Relative)) with - | null -> failwith "FSharp.Core.dll not found as Manifest Resource, we're just trying to read some random .NET assembly, ok?" - | resStream -> - use stream = resStream.Stream - let len = stream.Length - let buf = Array.zeroCreate (int len) - let rec loop where rem = - let n = stream.Read(buf, 0, int rem) - if n < rem then loop (where + n) (rem - n) - loop 0 (int len) - buf - - //failwith "no file system" + | _ -> failwithf "ApplyStaticArguments: static params for type %s are unexpected, it is not a provided type definition. Please report this bug to https://github.com/fsprojects/FSharp.TypeProviders.SDK/issues" ty.FullName + + member __.GetGeneratedAssemblyContents(assembly:Assembly) = +#if NO_GENERATIVE + ignore assembly; failwith "no generative assemblies" #else - override _.GetGeneratedAssemblyContents(assembly:Assembly) = - //printfn "looking up assembly '%s'" assembly.FullName - match GlobalProvidedAssemblyElementsTable.theTable.TryGetValue assembly with - | true,bytes -> bytes.Force() - | _ -> - let bytes = System.IO.File.ReadAllBytes assembly.ManifestModule.FullyQualifiedName - GlobalProvidedAssemblyElementsTable.theTable.[assembly] <- Lazy<_>.CreateFromValue bytes - bytes + //printfn "looking up assembly '%s'" assembly.FullName + let key = assembly.GetName().Name + match theTable.TryGetValue key with + | true, bytes -> bytes + | _ -> + let bytes = + match assembly with + | :? ProvidedAssembly as targetAssembly -> AssemblyCompiler(targetAssembly, ctxt).Compile(config.IsHostedExecution) + | _ -> File.ReadAllBytes assembly.ManifestModule.FullyQualifiedName + theTable.[key] <- bytes + bytes + +#if !NO_GENERATIVE + member __.RegisterGeneratedTargetAssembly (fileName:string) = + let assemblyBytes = File.ReadAllBytes fileName + //printfn "registering assembly in '%s'" fileName + let assembly = + if config.IsHostedExecution then + Assembly.Load(assemblyBytes) // we need a real on-disk assembly + else + ctxt.ReadRelatedAssembly(fileName) + ctxt.AddTargetAssembly(assembly.GetName(), assembly) + let key = assembly.GetName().Name + theTable.[key] <- assemblyBytes + assembly + +#endif #endif diff --git a/tests/service/data/TestTP/ProvidedTypes.fsi b/tests/service/data/TestTP/ProvidedTypes.fsi index 3988d1f1f00..668111e501a 100644 --- a/tests/service/data/TestTP/ProvidedTypes.fsi +++ b/tests/service/data/TestTP/ProvidedTypes.fsi @@ -1,260 +1,225 @@ // Copyright (c) Microsoft Corporation 2005-2014 and other contributors. -// This sample code is provided "as is" without warranty of any kind. -// We disclaim all warranties, either express or implied, including the -// warranties of merchantability and fitness for a particular purpose. +// This sample code is provided "as is" without warranty of any kind. +// We disclaim all warranties, either express or implied, including the +// warranties of merchantability and fitness for a particular purpose. // -// This file contains a set of helper types and methods for providing types in an implementation +// This file contains a set of helper types and methods for providing types in an implementation // of ITypeProvider. // // This code has been modified and is appropriate for use in conjunction with the F# 3.0-4.0 releases - namespace ProviderImplementation.ProvidedTypes open System open System.Reflection -open System.Linq.Expressions +open Microsoft.FSharp.Quotations open Microsoft.FSharp.Core.CompilerServices /// Represents an erased provided parameter +[] type ProvidedParameter = inherit ParameterInfo - new : parameterName: string * parameterType: Type * ?isOut:bool * ?optionalValue:obj -> ProvidedParameter - member IsParamArray : bool with get,set + + /// Create a new provided parameter. + new : parameterName: string * parameterType: Type * ?isOut: bool * ?optionalValue: obj -> ProvidedParameter + + /// Indicates if the parameter is marked as ParamArray + member IsParamArray: bool with set + + /// Indicates if the parameter is marked as ReflectedDefinition + member IsReflectedDefinition: bool with set + + /// Indicates if the parameter has a default value + member HasDefaultParameterValue: bool + + /// Add a custom attribute to the provided parameter. + member AddCustomAttribute: CustomAttributeData -> unit /// Represents a provided static parameter. +[] type ProvidedStaticParameter = inherit ParameterInfo - new : parameterName: string * parameterType:Type * ?parameterDefaultValue:obj -> ProvidedStaticParameter + + /// Create a new provided static parameter, for use with DefineStaticParamaeters on a provided type definition. + new: parameterName: string * parameterType: Type * ?parameterDefaultValue: obj -> ProvidedStaticParameter /// Add XML documentation information to this provided constructor - member AddXmlDoc : xmlDoc: string -> unit + member AddXmlDoc: xmlDoc: string -> unit /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary - member AddXmlDocDelayed : xmlDocFunction: (unit -> string) -> unit + member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit /// Represents an erased provided constructor. -type ProvidedConstructor = +[] +type ProvidedConstructor = inherit ConstructorInfo - /// Create a new provided constructor. It is not initially associated with any specific provided type definition. - new : parameters: ProvidedParameter list -> ProvidedConstructor + /// When making a cross-targeting type provider, use this method instead of the ProvidedConstructor constructor from ProvidedTypes + new: parameters: ProvidedParameter list * invokeCode: (Expr list -> Expr) -> ProvidedConstructor + + /// Add a 'Obsolete' attribute to this provided constructor + member AddObsoleteAttribute: message: string * ?isError: bool -> unit - /// Add a 'System.Obsolete' attribute to this provided constructor - member AddObsoleteAttribute : message: string * ?isError: bool -> unit - /// Add XML documentation information to this provided constructor - member AddXmlDoc : xmlDoc: string -> unit - + member AddXmlDoc: xmlDoc: string -> unit + /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary - member AddXmlDocDelayed : xmlDocFunction: (unit -> string) -> unit - - /// Add XML documentation information to this provided constructor, where the documentation is re-computed every time it is required. - member AddXmlDocComputed : xmlDocFunction: (unit -> string) -> unit - - /// Set the quotation used to compute the implementation of invocations of this constructor. - member InvokeCode : (Quotations.Expr list -> Quotations.Expr) with set + member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit - /// FSharp.Data addition: this method is used by Debug.fs - member internal GetInvokeCodeInternal : bool -> (Quotations.Expr [] -> Quotations.Expr) + /// Add XML documentation information to this provided constructor, where the documentation is re-computed every time it is required. + member AddXmlDocComputed: xmlDocFunction: (unit -> string) -> unit /// Set the target and arguments of the base constructor call. Only used for generated types. - member BaseConstructorCall : (Quotations.Expr list -> ConstructorInfo * Quotations.Expr list) with set + member BaseConstructorCall: (Expr list -> ConstructorInfo * Expr list) with set /// Set a flag indicating that the constructor acts like an F# implicit constructor, so the /// parameters of the constructor become fields and can be accessed using Expr.GlobalVar with the /// same name. - member IsImplicitCtor : bool with get,set + member IsImplicitConstructor: bool with get,set /// Add definition location information to the provided constructor. - member AddDefinitionLocation : line:int * column:int * filePath:string -> unit - - member IsTypeInitializer : bool with get,set + member AddDefinitionLocation: line:int * column:int * filePath:string -> unit + + member IsTypeInitializer: bool with get,set + + /// This method is for internal use only in the type provider SDK + member internal GetInvokeCode: Expr list -> Expr -type ProvidedMethod = +[] +type ProvidedMethod = inherit MethodInfo - /// Create a new provided method. It is not initially associated with any specific provided type definition. - new : methodName:string * parameters: ProvidedParameter list * returnType: Type -> ProvidedMethod + /// When making a cross-targeting type provider, use this method instead of the ProvidedMethod constructor from ProvidedTypes + new: methodName: string * parameters: ProvidedParameter list * returnType: Type * ?invokeCode: (Expr list -> Expr) * ?isStatic: bool -> ProvidedMethod /// Add XML documentation information to this provided method - member AddObsoleteAttribute : message: string * ?isError: bool -> unit + member AddObsoleteAttribute: message: string * ?isError: bool -> unit /// Add XML documentation information to this provided constructor - member AddXmlDoc : xmlDoc: string -> unit + member AddXmlDoc: xmlDoc: string -> unit /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary - member AddXmlDocDelayed : xmlDocFunction: (unit -> string) -> unit - + member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit + /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary /// The documentation is re-computed every time it is required. - member AddXmlDocComputed : xmlDocFunction: (unit -> string) -> unit - - member AddMethodAttrs : attributes:MethodAttributes -> unit + member AddXmlDocComputed: xmlDocFunction: (unit -> string) -> unit - /// Set the method attributes of the method. By default these are simple 'MethodAttributes.Public' - member SetMethodAttrs : attributes:MethodAttributes -> unit - - /// Get or set a flag indicating if the property is static. - member IsStaticMethod : bool with get, set + member AddMethodAttrs: attributes:MethodAttributes -> unit - /// Set the quotation used to compute the implementation of invocations of this method. - member InvokeCode : (Quotations.Expr list -> Quotations.Expr) with set - - /// FSharp.Data addition: this method is used by Debug.fs - member internal GetInvokeCodeInternal : bool -> (Quotations.Expr [] -> Quotations.Expr) + /// Set the method attributes of the method. By default these are simple 'MethodAttributes.Public' + member SetMethodAttrs: attributes:MethodAttributes -> unit /// Add definition location information to the provided type definition. - member AddDefinitionLocation : line:int * column:int * filePath:string -> unit + member AddDefinitionLocation: line:int * column:int * filePath:string -> unit /// Add a custom attribute to the provided method definition. - member AddCustomAttribute : CustomAttributeData -> unit + member AddCustomAttribute: CustomAttributeData -> unit /// Define the static parameters available on a statically parameterized method - member DefineStaticParameters : parameters: ProvidedStaticParameter list * instantiationFunction: (string -> obj[] -> ProvidedMethod) -> unit + member DefineStaticParameters: parameters: ProvidedStaticParameter list * instantiationFunction: (string -> obj[] -> ProvidedMethod) -> unit + + /// This method is for internal use only in the type provider SDK + member internal GetInvokeCode: (Expr list -> Expr) option /// Represents an erased provided property. +[] type ProvidedProperty = inherit PropertyInfo - /// Create a new provided type. It is not initially associated with any specific provided type definition. - new : propertyName: string * propertyType: Type * ?parameters:ProvidedParameter list -> ProvidedProperty + /// Create a new provided property. It is not initially associated with any specific provided type definition. + new: propertyName: string * propertyType: Type * ?getterCode: (Expr list -> Expr) * ?setterCode: (Expr list -> Expr) * ?isStatic: bool * ?indexParameters: ProvidedParameter list -> ProvidedProperty - /// Add a 'System.Obsolete' attribute to this provided property - member AddObsoleteAttribute : message: string * ?isError: bool -> unit + /// Add a 'Obsolete' attribute to this provided property + member AddObsoleteAttribute: message: string * ?isError: bool -> unit /// Add XML documentation information to this provided constructor - member AddXmlDoc : xmlDoc: string -> unit + member AddXmlDoc: xmlDoc: string -> unit /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary - member AddXmlDocDelayed : xmlDocFunction: (unit -> string) -> unit - + member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit + /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary /// The documentation is re-computed every time it is required. - member AddXmlDocComputed : xmlDocFunction: (unit -> string) -> unit - - /// Get or set a flag indicating if the property is static. - /// FSharp.Data addition: the getter is used by Debug.fs - member IsStatic : bool with get,set - - /// Set the quotation used to compute the implementation of gets of this property. - member GetterCode : (Quotations.Expr list -> Quotations.Expr) with set + member AddXmlDocComputed: xmlDocFunction: (unit -> string) -> unit - /// Set the function used to compute the implementation of sets of this property. - member SetterCode : (Quotations.Expr list -> Quotations.Expr) with set + /// Get or set a flag indicating if the property is static. + member IsStatic: bool /// Add definition location information to the provided type definition. - member AddDefinitionLocation : line:int * column:int * filePath:string -> unit + member AddDefinitionLocation: line:int * column:int * filePath:string -> unit /// Add a custom attribute to the provided property definition. - member AddCustomAttribute : CustomAttributeData -> unit + member AddCustomAttribute: CustomAttributeData -> unit /// Represents an erased provided property. +[] type ProvidedEvent = inherit EventInfo - /// Create a new provided type. It is not initially associated with any specific provided type definition. - new : propertyName: string * eventHandlerType: Type -> ProvidedEvent + /// Create a new provided event. It is not initially associated with any specific provided type definition. + new: eventName: string * eventHandlerType: Type * adderCode: (Expr list -> Expr) * removerCode: (Expr list -> Expr) * ?isStatic: bool -> ProvidedEvent /// Add XML documentation information to this provided constructor - member AddXmlDoc : xmlDoc: string -> unit + member AddXmlDoc: xmlDoc: string -> unit /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary - member AddXmlDocDelayed : xmlDocFunction: (unit -> string) -> unit - + member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit + /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary /// The documentation is re-computed every time it is required. - member AddXmlDocComputed : xmlDocFunction: (unit -> string) -> unit - - /// Get or set a flag indicating if the property is static. - member IsStatic : bool with set - - /// Set the quotation used to compute the implementation of gets of this property. - member AdderCode : (Quotations.Expr list -> Quotations.Expr) with set + member AddXmlDocComputed: xmlDocFunction: (unit -> string) -> unit - /// Set the function used to compute the implementation of sets of this property. - member RemoverCode : (Quotations.Expr list -> Quotations.Expr) with set + /// Get a flag indicating if the property is static. + member IsStatic: bool with get /// Add definition location information to the provided type definition. - member AddDefinitionLocation : line:int * column:int * filePath:string -> unit + member AddDefinitionLocation: line:int * column:int * filePath:string -> unit /// Represents an erased provided field. -type ProvidedLiteralField = +[] +type ProvidedField = inherit FieldInfo /// Create a new provided field. It is not initially associated with any specific provided type definition. - new : fieldName: string * fieldType: Type * literalValue: obj -> ProvidedLiteralField + new: fieldName: string * fieldType: Type -> ProvidedField - /// Add a 'System.Obsolete' attribute to this provided field - member AddObsoleteAttribute : message: string * ?isError: bool -> unit + /// Add a 'Obsolete' attribute to this provided field + member AddObsoleteAttribute: message: string * ?isError: bool -> unit /// Add XML documentation information to this provided field - member AddXmlDoc : xmlDoc: string -> unit + member AddXmlDoc: xmlDoc: string -> unit /// Add XML documentation information to this provided field, where the computation of the documentation is delayed until necessary - member AddXmlDocDelayed : xmlDocFunction: (unit -> string) -> unit - + member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit + /// Add XML documentation information to this provided field, where the computation of the documentation is delayed until necessary /// The documentation is re-computed every time it is required. - member AddXmlDocComputed : xmlDocFunction: (unit -> string) -> unit - - /// Add definition location information to the provided field. - member AddDefinitionLocation : line:int * column:int * filePath:string -> unit - -/// Represents an erased provided field. -type ProvidedField = - inherit FieldInfo - - /// Create a new provided field. It is not initially associated with any specific provided type definition. - new : fieldName: string * fieldType: Type -> ProvidedField + member AddXmlDocComputed: xmlDocFunction: (unit -> string) -> unit - /// Add a 'System.Obsolete' attribute to this provided field - member AddObsoleteAttribute : message: string * ?isError: bool -> unit + /// Add definition location information to the provided field definition. + member AddDefinitionLocation: line:int * column:int * filePath:string -> unit - /// Add XML documentation information to this provided field - member AddXmlDoc : xmlDoc: string -> unit + member SetFieldAttributes: attributes: FieldAttributes -> unit - /// Add XML documentation information to this provided field, where the computation of the documentation is delayed until necessary - member AddXmlDocDelayed : xmlDocFunction: (unit -> string) -> unit - - /// Add XML documentation information to this provided field, where the computation of the documentation is delayed until necessary - /// The documentation is re-computed every time it is required. - member AddXmlDocComputed : xmlDocFunction: (unit -> string) -> unit + /// Add a custom attribute to the provided property definition. + member AddCustomAttribute: CustomAttributeData -> unit - /// Add definition location information to the provided field definition. - member AddDefinitionLocation : line:int * column:int * filePath:string -> unit - - member SetFieldAttributes : attributes : FieldAttributes -> unit - -/// Represents the type constructor in a provided symbol type. -[] -type SymbolKind = - /// Indicates that the type constructor is for a single-dimensional array - | SDArray - /// Indicates that the type constructor is for a multi-dimensional array - | Array of int - /// Indicates that the type constructor is for pointer types - | Pointer - /// Indicates that the type constructor is for byref types - | ByRef - /// Indicates that the type constructor is for named generic types - | Generic of Type - /// Indicates that the type constructor is for abbreviated types - | FSharpTypeAbbreviation of (Assembly * string * string[]) + /// Create a new provided literal field. It is not initially associated with any specific provided type definition. + static member Literal : fieldName: string * fieldType: Type * literalValue:obj -> ProvidedField /// Represents an array or other symbolic type involving a provided type as the argument. /// See the type provider spec for the methods that must be implemented. /// Note that the type provider specification does not require us to implement pointer-equality for provided types. [] -type ProvidedSymbolType = - inherit Type - - /// Returns the kind of this symbolic type - member Kind : SymbolKind +type ProvidedTypeSymbol = + inherit TypeDelegator - /// Return the provided types used as arguments of this symbolic type - member Args : list + /// For example, kg + member IsFSharpTypeAbbreviation: bool + /// For example, int or int + member IsFSharpUnitAnnotated: bool /// Helpers to build symbolic provided types [] @@ -266,203 +231,330 @@ type ProvidedTypeBuilder = /// Like methodInfo.MakeGenericMethod, but will also work with unit-annotated types and provided types static member MakeGenericMethod: genericMethodDefinition: MethodInfo * genericArguments: Type list -> MethodInfo + /// Like FsharpType.MakeTupleType, but will also work with unit-annotated types and provided types + static member MakeTupleType: types: Type list*isStruct: bool -> Type + + /// Like FsharpType.MakeTupleType, but will also work with unit-annotated types and provided types + static member MakeTupleType: types: Type list -> Type + /// Helps create erased provided unit-of-measure annotations. [] type ProvidedMeasureBuilder = - - /// The ProvidedMeasureBuilder for building measures. - static member Default : ProvidedMeasureBuilder - /// Gets the measure indicating the "1" unit of measure, that is the unitless measure. - member One : Type + /// Gets the measure indicating the "1" unit of measure, that is the unitless measure. + static member One: Type /// Returns the measure indicating the product of two units of measure, e.g. kg * m - member Product : measure1: Type * measure1: Type -> Type + static member Product: measure1: Type * measure2: Type -> Type /// Returns the measure indicating the inverse of two units of measure, e.g. 1 / s - member Inverse : denominator: Type -> Type + static member Inverse: denominator: Type -> Type /// Returns the measure indicating the ratio of two units of measure, e.g. kg / m - member Ratio : numerator: Type * denominator: Type -> Type - + static member Ratio: numerator: Type * denominator: Type -> Type + /// Returns the measure indicating the square of a unit of measure, e.g. m * m - member Square : ``measure``: Type -> Type - + static member Square: ``measure``: Type -> Type + /// Returns the measure for an SI unit from the F# core library, where the string is in capitals and US spelling, e.g. Meter - member SI : unitName:string -> Type - + static member SI: unitName:string -> Type + /// Returns a type where the type has been annotated with the given types and/or units-of-measure. /// e.g. float, Vector - member AnnotateType : basic: Type * argument: Type list -> Type - + static member AnnotateType: basic: Type * argument: Type list -> Type /// Represents a provided type definition. +[] type ProvidedTypeDefinition = - inherit Type + inherit TypeDelegator - /// Create a new provided type definition in a namespace. - new : assembly: Assembly * namespaceName: string * className: string * baseType: Type option -> ProvidedTypeDefinition + /// When making a cross-targeting type provider, use this method instead of the corresponding ProvidedTypeDefinition constructor from ProvidedTypes + new: className: string * baseType: Type option * ?hideObjectMethods: bool * ?nonNullable: bool * ?isErased: bool * ?isSealed: bool * ?isInterface: bool * ?isAbstract: bool -> ProvidedTypeDefinition - /// Create a new provided type definition, to be located as a nested type in some type definition. - new : className : string * baseType: Type option -> ProvidedTypeDefinition + /// When making a cross-targeting type provider, use this method instead of the corresponding ProvidedTypeDefinition constructor from ProvidedTypes + new: assembly: Assembly * namespaceName: string * className: string * baseType: Type option * ?hideObjectMethods: bool * ?nonNullable: bool * ?isErased: bool * ?isSealed: bool * ?isInterface: bool * ?isAbstract: bool -> ProvidedTypeDefinition /// Add the given type as an implemented interface. - member AddInterfaceImplementation : interfaceType: Type -> unit + member AddInterfaceImplementation: interfaceType: Type -> unit /// Add the given function as a set of on-demand computed interfaces. - member AddInterfaceImplementationsDelayed : interfacesFunction:(unit -> Type list)-> unit + member AddInterfaceImplementationsDelayed: interfacesFunction:(unit -> Type list)-> unit /// Specifies that the given method body implements the given method declaration. - member DefineMethodOverride : methodInfoBody: ProvidedMethod * methodInfoDeclaration: MethodInfo -> unit + member DefineMethodOverride: methodInfoBody: ProvidedMethod * methodInfoDeclaration: MethodInfo -> unit + + /// Specifies that the given method bodies implement the given method declarations + member DefineMethodOverridesDelayed: (unit -> (ProvidedMethod * MethodInfo) list) -> unit - /// Add a 'System.Obsolete' attribute to this provided type definition - member AddObsoleteAttribute : message: string * ?isError: bool -> unit + /// Add a 'Obsolete' attribute to this provided type definition + member AddObsoleteAttribute: message: string * ?isError: bool -> unit /// Add XML documentation information to this provided constructor - member AddXmlDoc : xmlDoc: string -> unit + member AddXmlDoc: xmlDoc: string -> unit /// Set the base type - member SetBaseType : Type -> unit + member SetBaseType: Type -> unit /// Set the base type to a lazily evaluated value. Use this to delay realization of the base type as late as possible. - member SetBaseTypeDelayed : baseTypeFunction:(unit -> Type) -> unit + member SetBaseTypeDelayed: baseTypeFunction:(unit -> Type) -> unit /// Set underlying type for generated enums - member SetEnumUnderlyingType : Type -> unit + member SetEnumUnderlyingType: Type -> unit /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary. /// The documentation is only computed once. - member AddXmlDocDelayed : xmlDocFunction: (unit -> string) -> unit - + member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit + /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary /// The documentation is re-computed every time it is required. - member AddXmlDocComputed : xmlDocFunction: (unit -> string) -> unit - + member AddXmlDocComputed: xmlDocFunction: (unit -> string) -> unit + /// Set the attributes on the provided type. This fully replaces the default TypeAttributes. - member SetAttributes : TypeAttributes -> unit - - /// Reset the enclosing type (for generated nested types) - member ResetEnclosingType: enclosingType:Type -> unit - + member SetAttributes: TypeAttributes -> unit + /// Add a method, property, nested type or other member to a ProvidedTypeDefinition - member AddMember : memberInfo:MemberInfo -> unit + member AddMember: memberInfo:MemberInfo -> unit /// Add a set of members to a ProvidedTypeDefinition - member AddMembers : memberInfos:list<#MemberInfo> -> unit + member AddMembers: memberInfos:list<#MemberInfo> -> unit /// Add a member to a ProvidedTypeDefinition, delaying computation of the members until required by the compilation context. - member AddMemberDelayed : memberFunction:(unit -> #MemberInfo) -> unit + member AddMemberDelayed: memberFunction:(unit -> #MemberInfo) -> unit /// Add a set of members to a ProvidedTypeDefinition, delaying computation of the members until required by the compilation context. - member AddMembersDelayed : membersFunction:(unit -> list<#MemberInfo>) -> unit - + member AddMembersDelayed: membersFunction:(unit -> list<#MemberInfo>) -> unit + /// Add the types of the generated assembly as generative types, where types in namespaces get hierarchically positioned as nested types. - member AddAssemblyTypesAsNestedTypesDelayed : assemblyFunction:(unit -> Assembly) -> unit + member AddAssemblyTypesAsNestedTypesDelayed: assemblyFunction:(unit -> Assembly) -> unit /// Define the static parameters available on a statically parameterized type - member DefineStaticParameters : parameters: ProvidedStaticParameter list * instantiationFunction: (string -> obj[] -> ProvidedTypeDefinition) -> unit + member DefineStaticParameters: parameters: ProvidedStaticParameter list * instantiationFunction: (string -> obj[] -> ProvidedTypeDefinition) -> unit /// Add definition location information to the provided type definition. - member AddDefinitionLocation : line:int * column:int * filePath:string -> unit + member AddDefinitionLocation: line:int * column:int * filePath:string -> unit - /// Suppress System.Object entries in intellisense menus in instances of this provided type - member HideObjectMethods : bool with set + /// Suppress Object entries in intellisense menus in instances of this provided type + member HideObjectMethods: bool - /// Disallows the use of the null literal. - member NonNullable : bool with set + /// Disallows the use of the null literal. + member NonNullable: bool - /// Get or set a flag indicating if the ProvidedTypeDefinition is erased - member IsErased : bool with get,set + /// Get a flag indicating if the ProvidedTypeDefinition is erased + member IsErased: bool /// Get or set a flag indicating if the ProvidedTypeDefinition has type-relocation suppressed [] - member SuppressRelocation : bool with get,set + member SuppressRelocation: bool with get,set - /// FSharp.Data addition: this method is used by Debug.fs - member MakeParametricType : name:string * args:obj[] -> ProvidedTypeDefinition + // This method is used by Debug.fs + member ApplyStaticArguments: name:string * args:obj[] -> ProvidedTypeDefinition /// Add a custom attribute to the provided type definition. - member AddCustomAttribute : CustomAttributeData -> unit + member AddCustomAttribute: CustomAttributeData -> unit - /// Emulate the F# type provider type erasure mechanism to get the + /// Emulate the F# type provider type erasure mechanism to get the /// actual (erased) type. We erase ProvidedTypes to their base type /// and we erase array of provided type to array of base type. In the /// case of generics all the generic type arguments are also recursively /// replaced with the erased-to types - static member EraseType : typ:Type -> Type + static member EraseType: typ:Type -> Type /// Get or set a utility function to log the creation of root Provided Type. Used to debug caching/invalidation. - static member Logger : (string -> unit) option ref + static member Logger: (string -> unit) option ref + +#if !NO_GENERATIVE /// A provided generated assembly type ProvidedAssembly = + + inherit Assembly + /// Create a provided generated assembly - new : assemblyFileName:string -> ProvidedAssembly + new: assemblyName: AssemblyName * assemblyFileName:string -> ProvidedAssembly + + /// Create a provided generated assembly using a temporary file as the interim assembly storage + new: unit -> ProvidedAssembly - /// Emit the given provided type definitions as part of the assembly + /// Emit the given provided type definitions as part of the assembly /// and adjust the 'Assembly' property of all provided type definitions to return that /// assembly. /// /// The assembly is only emitted when the Assembly property on the root type is accessed for the first time. /// The host F# compiler does this when processing a generative type declaration for the type. - member AddTypes : types : ProvidedTypeDefinition list -> unit + member AddTypes: types: ProvidedTypeDefinition list -> unit /// /// Emit the given nested provided type definitions as part of the assembly. /// and adjust the 'Assembly' property of all provided type definitions to return that /// assembly. /// - /// A list of nested ProvidedTypeDefinitions to add to the ProvidedAssembly. + /// Provided type definitions. /// A path of type names to wrap the generated types. The generated types are then generated as nested types. - member AddNestedTypes : types : ProvidedTypeDefinition list * enclosingGeneratedTypeNames: string list -> unit + member AddNestedTypes: types: ProvidedTypeDefinition list * enclosingGeneratedTypeNames: string list -> unit -#if FX_NO_LOCAL_FILESYSTEM -#else - /// Register that a given file is a provided generated assembly - static member RegisterGenerated : fileName:string -> Assembly #endif +[] +/// Represents the context for which code is to be generated. Normally you should not need to use this directly. +type ProvidedTypesContext = + + /// Try to find the given target assembly in the context + member TryBindAssemblyNameToTarget: aref: AssemblyName -> Choice -/// A base type providing default implementations of type provider functionality when all provided -/// types are of type ProvidedTypeDefinition. -type TypeProviderForNamespaces = + /// Try to find the given target assembly in the context + member TryBindSimpleAssemblyNameToTarget: assemblyName: string -> Choice + + /// Get the list of referenced assemblies determined by the type provider configuration + member ReferencedAssemblyPaths: string list + + /// Get the resolved referenced assemblies determined by the type provider configuration + member GetTargetAssemblies : unit -> Assembly[] + + /// Get the set of design-time assemblies available to use as a basis for authoring provided types. + member GetSourceAssemblies : unit -> Assembly[] + + /// Add an assembly to the set of design-time assemblies available to use as a basis for authoring provided types + member AddSourceAssembly : Assembly -> unit + + /// Try to get the version of FSharp.Core referenced. May raise an exception if FSharp.Core has not been correctly resolved + member FSharpCoreAssemblyVersion: Version - /// Initializes a type provider to provide the types in the given namespace. - new : namespaceName:string * types: ProvidedTypeDefinition list -> TypeProviderForNamespaces + /// Returns a type from the referenced assemblies that corresponds to the given design-time type. Normally + /// this method should not be used directly when authoring a type provider. + member ConvertSourceTypeToTarget: Type -> Type - /// Initializes a type provider - new : unit -> TypeProviderForNamespaces + /// Returns the design-time type that corresponds to the given type from the target referenced assemblies. Normally + /// this method should not be used directly when authoring a type provider. + member ConvertTargetTypeToSource: Type -> Type + + /// Returns a quotation rebuilt with resepct to the types from the target referenced assemblies. Normally + /// this method should not be used directly when authoring a type provider. + member ConvertSourceExprToTarget: Expr -> Expr + + /// Read the assembly related to this context + member ReadRelatedAssembly: fileName: string -> Assembly + + /// Read the assembly related to this context + member ReadRelatedAssembly: bytes: byte[] -> Assembly + +/// A base type providing default implementations of type provider functionality. +type TypeProviderForNamespaces = + + /// Initializes a type provider to provide the types in the given namespace. + /// Type provider config. + /// Name of namespace. + /// Provided type definitions. + /// + /// + /// Optionally specify the design-time assemblies available to use as a basis for authoring provided types. + /// The transitive dependencies of these assemblies are also included. By default + /// Assembly.GetCallingAssembly() and its transitive dependencies are used. + /// + /// + /// + /// Optionally specify a map of assembly names from source model to referenced assemblies. + /// + /// + /// + /// Optionally specify that the location of the type provider design-time component should be used to resolve failing assembly resolutions. + /// This flag or an equivalent call to RegisterProbingFolder is generally needed for any type provider design-time components loaded into .NET Core tooling. + /// + new: config: TypeProviderConfig * namespaceName:string * types: ProvidedTypeDefinition list * ?sourceAssemblies: Assembly list * ?assemblyReplacementMap: (string * string) list * ?addDefaultProbingLocation: bool -> TypeProviderForNamespaces + + /// Initializes a type provider. + /// Type provider config. + /// + /// Optionally specify the design-time assemblies available to use as a basis for authoring provided types. + /// The transitive dependencies of these assemblies are also included. By default + /// Assembly.GetCallingAssembly() and its transitive dependencies are used. + /// + /// + /// + /// Optionally specify a map of assembly names from source model to referenced assemblies. + /// + /// + /// + /// Optionally specify that the location of the type provider design-time component should be used to resolve failing assembly resolutions. + /// This flag or an equivalent call to RegisterProbingFolder is generally needed for any type provider design-time components loaded into .NET Core tooling. + /// + new: config: TypeProviderConfig * ?sourceAssemblies: Assembly list * ?assemblyReplacementMap: (string * string) list * ?addDefaultProbingLocation: bool -> TypeProviderForNamespaces /// Invoked by the type provider to add a namespace of provided types in the specification of the type provider. - member AddNamespace : namespaceName:string * types: ProvidedTypeDefinition list -> unit + member AddNamespace: namespaceName:string * types: ProvidedTypeDefinition list -> unit /// Invoked by the type provider to get all provided namespaces with their provided types. - member Namespaces : seq + member Namespaces: IProvidedNamespace[] /// Invoked by the type provider to invalidate the information provided by the provider - member Invalidate : unit -> unit + member Invalidate: unit -> unit /// Invoked by the host of the type provider to get the static parameters for a method. - member GetStaticParametersForMethod : MethodBase -> ParameterInfo[] - + member GetStaticParametersForMethod: MethodBase -> ParameterInfo[] + /// Invoked by the host of the type provider to apply the static argumetns for a method. - member ApplyStaticArgumentsForMethod : MethodBase * string * obj[] -> MethodBase + member ApplyStaticArgumentsForMethod: MethodBase * string * obj[] -> MethodBase -#if FX_NO_LOCAL_FILESYSTEM -#else - /// AssemblyResolve handler. Default implementation searches .dll file in registered folders - abstract ResolveAssembly : System.ResolveEventArgs -> Assembly - default ResolveAssembly : System.ResolveEventArgs -> Assembly +#if !FX_NO_LOCAL_FILESYSTEM + /// AssemblyResolve handler. Default implementation searches .dll file in registered folders + abstract ResolveAssembly: ResolveEventArgs -> Assembly + default ResolveAssembly: ResolveEventArgs -> Assembly /// Registers custom probing path that can be used for probing assemblies - member RegisterProbingFolder : folder: string -> unit + member RegisterProbingFolder: folder: string -> unit /// Registers location of RuntimeAssembly (from TypeProviderConfig) as probing folder - member RegisterRuntimeAssemblyLocationAsProbingFolder : config: TypeProviderConfig -> unit + member RegisterRuntimeAssemblyLocationAsProbingFolder: config: TypeProviderConfig -> unit + +#endif +#if !NO_GENERATIVE + /// Register that a given file is a provided generated target assembly, e.g. an assembly produced by an external + /// code generation tool. This assembly should be a target assembly, i.e. use the same asssembly references + /// as given by TargetContext.ReferencedAssemblyPaths + member RegisterGeneratedTargetAssembly: fileName: string -> Assembly #endif [] - member Disposing : IEvent + member Disposing: IEvent + + /// The context for which code is eventually to be generated. You should not normally + /// need to use this property directly, as translation from the compiler-hosted context to + /// the design-time context will normally be performed automatically. + member TargetContext: ProvidedTypesContext interface ITypeProvider + +module internal UncheckedQuotations = + + type Expr with + static member NewDelegateUnchecked: ty:Type * vs:Var list * body:Expr -> Expr + static member NewObjectUnchecked: cinfo:ConstructorInfo * args:Expr list -> Expr + static member NewArrayUnchecked: elementType:Type * elements:Expr list -> Expr + static member CallUnchecked: minfo:MethodInfo * args:Expr list -> Expr + static member CallUnchecked: obj:Expr * minfo:MethodInfo * args:Expr list -> Expr + static member ApplicationUnchecked: f:Expr * x:Expr -> Expr + static member PropertyGetUnchecked: pinfo:PropertyInfo * args:Expr list -> Expr + static member PropertyGetUnchecked: obj:Expr * pinfo:PropertyInfo * ?args:Expr list -> Expr + static member PropertySetUnchecked: pinfo:PropertyInfo * value:Expr * ?args:Expr list -> Expr + static member PropertySetUnchecked: obj:Expr * pinfo:PropertyInfo * value:Expr * ?args:Expr list -> Expr + static member FieldGetUnchecked: pinfo:FieldInfo -> Expr + static member FieldGetUnchecked: obj:Expr * pinfo:FieldInfo -> Expr + static member FieldSetUnchecked: pinfo:FieldInfo * value:Expr -> Expr + static member FieldSetUnchecked: obj:Expr * pinfo:FieldInfo * value:Expr -> Expr + static member TupleGetUnchecked: e:Expr * n:int -> Expr + static member LetUnchecked: v:Var * e:Expr * body:Expr -> Expr + static member NewRecordUnchecked : ty:Type * args:Expr list -> Expr + + type Shape + val ( |ShapeCombinationUnchecked|ShapeVarUnchecked|ShapeLambdaUnchecked| ): e:Expr -> Choice<(Shape * Expr list),Var, (Var * Expr)> + val RebuildShapeCombinationUnchecked: Shape * args:Expr list -> Expr + +module internal AssemblyReader = + + module Reader = + + type ILModuleReader = class end + + val GetWeakReaderCache : unit -> System.Collections.Concurrent.ConcurrentDictionary<(string * string), DateTime * WeakReference> + val GetStrongReaderCache : unit -> System.Collections.Concurrent.ConcurrentDictionary<(string * string), DateTime * int * ILModuleReader> + \ No newline at end of file diff --git a/tests/service/data/TestTP/TestTP.dll b/tests/service/data/TestTP/TestTP.dll deleted file mode 100644 index 0b3e3fd7a16..00000000000 Binary files a/tests/service/data/TestTP/TestTP.dll and /dev/null differ diff --git a/tests/service/data/TestTP/Library.fs b/tests/service/data/TestTP/TestTP.fs similarity index 71% rename from tests/service/data/TestTP/Library.fs rename to tests/service/data/TestTP/TestTP.fs index b97eb774e06..21c067a113e 100644 --- a/tests/service/data/TestTP/Library.fs +++ b/tests/service/data/TestTP/TestTP.fs @@ -3,6 +3,7 @@ open ProviderImplementation.ProvidedTypes open Microsoft.FSharp.Core.CompilerServices open System.Reflection +open FSharp.Quotations module Helper = let doNothing() = () @@ -68,7 +69,7 @@ open FSharp.Compiler.Service.Tests [] type BasicProvider (config : TypeProviderConfig) as this = - inherit TypeProviderForNamespaces () + inherit TypeProviderForNamespaces (config) // resolve CSharp_Analysis from referenced assemblies do System.AppDomain.CurrentDomain.add_AssemblyResolve(fun _ args -> @@ -88,110 +89,110 @@ type BasicProvider (config : TypeProviderConfig) as this = let createTypes () = let myType = ProvidedTypeDefinition(asm, ns, "MyType", Some typeof) - let ctor = ProvidedConstructor([], InvokeCode = fun args -> <@@ "My internal state" :> obj @@>) + let ctor = ProvidedConstructor([], invokeCode = fun args -> <@@ "My internal state" :> obj @@>) myType.AddMember(ctor) let ctor2 = ProvidedConstructor( [ProvidedParameter("InnerState", typeof)], - InvokeCode = fun args -> <@@ (%%(args.[0]):string) :> obj @@>) + invokeCode = fun args -> <@@ (%%(args.[0]):string) :> obj @@>) myType.AddMember(ctor2) let innerState = ProvidedProperty("InnerState", typeof, - GetterCode = fun args -> <@@ (%%(args.[0]) :> obj) :?> string @@>) + getterCode = fun args -> <@@ (%%(args.[0]) :> obj) :?> string @@>) myType.AddMember(innerState) let someMethod = ProvidedMethod("DoNothing", [], typeof, - InvokeCode = fun args -> <@@ Helper.doNothing() @@>) + invokeCode = fun args -> <@@ Helper.doNothing() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("DoNothingOneArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.doNothingOneArg(3) @@>) + invokeCode = fun args -> <@@ Helper.doNothingOneArg(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("DoNothingTwoArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.doNothingTwoArg(3, 4) @@>) + invokeCode = fun args -> <@@ Helper.doNothingTwoArg(3, 4) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("DoNothingTwoArgCurried", [], typeof, - InvokeCode = fun args -> <@@ Helper.doNothingTwoArgCurried 3 4 @@>) + invokeCode = fun args -> <@@ Helper.doNothingTwoArgCurried 3 4 @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("DoNothingWithCompiledName", [], typeof, - InvokeCode = fun args -> <@@ Helper.doNothingWithCompiledName() @@>) + invokeCode = fun args -> <@@ Helper.doNothingWithCompiledName() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("DoNothingGeneric", [], typeof, - InvokeCode = fun args -> <@@ Helper.doNothingGeneric(3) @@>) + invokeCode = fun args -> <@@ Helper.doNothingGeneric(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("DoNothingGenericWithConstraint", [], typeof, - InvokeCode = fun args -> <@@ Helper.doNothingGenericWithConstraint(3) @@>) + invokeCode = fun args -> <@@ Helper.doNothingGenericWithConstraint(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("DoNothingGenericWithTypeConstraint", [], typeof, - InvokeCode = fun args -> <@@ Helper.doNothingGenericWithTypeConstraint([3]) @@>) + invokeCode = fun args -> <@@ Helper.doNothingGenericWithTypeConstraint([3]) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassDoNothing", [], typeof, - InvokeCode = fun args -> <@@ Helper.C.DoNothing() @@>) + invokeCode = fun args -> <@@ Helper.C.DoNothing() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassDoNothingGeneric", [], typeof, - InvokeCode = fun args -> <@@ Helper.C.DoNothingGeneric(3) @@>) + invokeCode = fun args -> <@@ Helper.C.DoNothingGeneric(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassDoNothingOneArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.C.DoNothingOneArg(3) @@>) + invokeCode = fun args -> <@@ Helper.C.DoNothingOneArg(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassDoNothingTwoArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.C.DoNothingTwoArg(Helper.C(), 3) @@>) + invokeCode = fun args -> <@@ Helper.C.DoNothingTwoArg(Helper.C(), 3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassDoNothingTwoArgCurried", [], typeof, - InvokeCode = fun args -> <@@ Helper.C.DoNothingTwoArgCurried (Helper.C()) 3 @@>) + invokeCode = fun args -> <@@ Helper.C.DoNothingTwoArgCurried (Helper.C()) 3 @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassDoNothingWithCompiledName", [], typeof, - InvokeCode = fun args -> <@@ Helper.C.DoNothingWithCompiledName() @@>) + invokeCode = fun args -> <@@ Helper.C.DoNothingWithCompiledName() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassInstanceDoNothing", [], typeof, - InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothing() @@>) + invokeCode = fun args -> <@@ Helper.C().InstanceDoNothing() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassInstanceDoNothingGeneric", [], typeof, - InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingGeneric(3) @@>) + invokeCode = fun args -> <@@ Helper.C().InstanceDoNothingGeneric(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassInstanceDoNothingOneArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingOneArg(3) @@>) + invokeCode = fun args -> <@@ Helper.C().InstanceDoNothingOneArg(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassInstanceDoNothingTwoArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingTwoArg(Helper.C(), 3) @@>) + invokeCode = fun args -> <@@ Helper.C().InstanceDoNothingTwoArg(Helper.C(), 3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassInstanceDoNothingTwoArgCurried", [], typeof, - InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingTwoArgCurried (Helper.C()) 3 @@>) + invokeCode = fun args -> <@@ Helper.C().InstanceDoNothingTwoArgCurried (Helper.C()) 3 @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassInstanceDoNothingWithCompiledName", [], typeof, - InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingWithCompiledName() @@>) + invokeCode = fun args -> <@@ Helper.C().InstanceDoNothingWithCompiledName() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("InterfaceDoNothing", [], typeof, - InvokeCode = fun args -> <@@ (Helper.C() :> Helper.I).DoNothing() @@>) + invokeCode = fun args -> <@@ (Helper.C() :> Helper.I).DoNothing() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("OverrideDoNothing", [], typeof, - InvokeCode = fun args -> <@@ Helper.C().VirtualDoNothing() @@>) + invokeCode = fun args -> <@@ Helper.C().VirtualDoNothing() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("GenericClassDoNothing", [], typeof, - InvokeCode = fun args -> <@@ Helper.G.DoNothing() @@>) + invokeCode = fun args -> <@@ Helper.G.DoNothing() @@>) myType.AddMember(someMethod) // These do not seem to compile correctly when used in provided expressions: @@ -201,85 +202,85 @@ type BasicProvider (config : TypeProviderConfig) as this = //Helper.G().InstanceDoNothingGeneric(3) let someMethod = ProvidedMethod("GenericClassDoNothingOneArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.G.DoNothingOneArg(3) @@>) + invokeCode = fun args -> <@@ Helper.G.DoNothingOneArg(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("GenericClassDoNothingTwoArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.G.DoNothingTwoArg(Helper.C(), 3) @@>) + invokeCode = fun args -> <@@ Helper.G.DoNothingTwoArg(Helper.C(), 3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("GenericClassInstanceDoNothing", [], typeof, - InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothing() @@>) + invokeCode = fun args -> <@@ Helper.G().InstanceDoNothing() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("GenericClassInstanceDoNothingOneArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothingOneArg(3) @@>) + invokeCode = fun args -> <@@ Helper.G().InstanceDoNothingOneArg(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("GenericClassInstanceDoNothingTwoArg", [], typeof, - InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothingTwoArg(Helper.C(), 3) @@>) + invokeCode = fun args -> <@@ Helper.G().InstanceDoNothingTwoArg(Helper.C(), 3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("OptionConstructionAndMatch", [], typeof, - InvokeCode = fun args -> <@@ match Some 1 with None -> 0 | Some x -> x @@>) + invokeCode = fun args -> <@@ match Some 1 with None -> 0 | Some x -> x @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ChoiceConstructionAndMatch", [], typeof, - InvokeCode = fun args -> <@@ match Choice1Of2 1 with Choice2Of2 _ -> 0 | Choice1Of2 _ -> 1 @@>) + invokeCode = fun args -> <@@ match Choice1Of2 1 with Choice2Of2 _ -> 0 | Choice1Of2 _ -> 1 @@>) // TODO: fix type checker to recognize union generated subclasses coming from TPs -// InvokeCode = fun args -> <@@ match Choice1Of2 1 with Choice2Of2 _ -> 0 | Choice1Of2 x -> x @@>) +// invokeCode = fun args -> <@@ match Choice1Of2 1 with Choice2Of2 _ -> 0 | Choice1Of2 x -> x @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("RecordConstructionAndFieldGetSet", [], typeof, - InvokeCode = fun args -> <@@ let r : Helper.R = { A = 1; B = 0 } in r.B <- 1; r.A @@>) + invokeCode = fun args -> <@@ let r : Helper.R = { A = 1; B = 0 } in r.B <- 1; r.A @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("TupleConstructionAndGet", [], typeof, - InvokeCode = fun args -> <@@ let t = (1, 2, 3) in (let (_, i, _) = t in i) @@>) + invokeCode = fun args -> <@@ let t = (1, 2, 3) in (let (_, i, _) = t in i) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("CSharpMethod", [], typeof, - InvokeCode = fun args -> <@@ CSharpClass(0).Method("x") @@>) + invokeCode = fun args -> <@@ CSharpClass(0).Method("x") @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("CSharpMethodOptionalParam", [], typeof, - InvokeCode = fun args -> <@@ CSharpClass(0).Method2("x") + CSharpClass(0).Method2() @@>) + invokeCode = fun args -> <@@ CSharpClass(0).Method2("x") + CSharpClass(0).Method2() @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("CSharpMethodParamArray", [], typeof, - InvokeCode = fun args -> <@@ CSharpClass(0).Method3("x", "y") @@>) + invokeCode = fun args -> <@@ CSharpClass(0).Method3("x", "y") @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("CSharpMethodGeneric", [], typeof, - InvokeCode = fun args -> <@@ CSharpClass(0).GenericMethod(2) @@>) + invokeCode = fun args -> <@@ CSharpClass(0).GenericMethod(2) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("CSharpMethodGenericWithConstraint", [], typeof, - InvokeCode = fun args -> <@@ CSharpClass(0).GenericMethod2(obj()) @@>) + invokeCode = fun args -> <@@ CSharpClass(0).GenericMethod2(obj()) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("CSharpMethodGenericWithTypeConstraint", [], typeof, - InvokeCode = fun args -> <@@ CSharpClass(0).GenericMethod3(3) @@>) + invokeCode = fun args -> <@@ CSharpClass(0).GenericMethod3(3) @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("CSharpExplicitImplementationMethod", [], typeof, - InvokeCode = fun args -> <@@ (CSharpClass(0) :> ICSharpExplicitInterface).ExplicitMethod("x") @@>) + invokeCode = fun args -> <@@ (CSharpClass(0) :> ICSharpExplicitInterface).ExplicitMethod("x") @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ModuleValue", [], typeof, - InvokeCode = fun args -> <@@ Helper.moduleValue <- 1; Helper.moduleValue @@>) + invokeCode = fun args -> <@@ Helper.moduleValue <- 1; Helper.moduleValue @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassProperty", [], typeof, - InvokeCode = fun args -> <@@ let x = Helper.C() in x.Property <- 1; x.Property @@>) + invokeCode = fun args -> <@@ let x = Helper.C() in x.Property <- 1; x.Property @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassAutoProperty", [], typeof, - InvokeCode = fun args -> <@@ let x = Helper.C() in x.AutoProperty <- 1; x.AutoProperty @@>) + invokeCode = fun args -> <@@ let x = Helper.C() in x.AutoProperty <- 1; x.AutoProperty @@>) myType.AddMember(someMethod) let someMethod = ProvidedMethod("ClassStaticAutoProperty", [], typeof, - InvokeCode = fun args -> <@@ Helper.C.StaticAutoProperty <- 1; Helper.C.StaticAutoProperty @@>) + invokeCode = fun args -> <@@ Helper.C.StaticAutoProperty <- 1; Helper.C.StaticAutoProperty @@>) myType.AddMember(someMethod) [myType] @@ -287,5 +288,39 @@ type BasicProvider (config : TypeProviderConfig) as this = do this.AddNamespace(ns, createTypes()) +[] +type BasicGenerativeProvider (config : TypeProviderConfig) as this = + inherit TypeProviderForNamespaces (config) + + let ns = "GeneratedWithConstructor.Provided" + let asm = Assembly.GetExecutingAssembly() + + let createType typeName (count:int) = + let asm = ProvidedAssembly() + let myType = ProvidedTypeDefinition(asm, ns, typeName, Some typeof, isErased=false) + + let ctor = ProvidedConstructor([], invokeCode = fun args -> <@@ "My internal state" :> obj @@>) + myType.AddMember(ctor) + + let ctor2 = ProvidedConstructor([ProvidedParameter("InnerState", typeof)], invokeCode = fun args -> <@@ (%%(args.[1]):string) :> obj @@>) + myType.AddMember(ctor2) + + for i in 1 .. count do + let prop = ProvidedProperty("Property" + string i, typeof, getterCode = fun args -> <@@ i @@>) + myType.AddMember(prop) + + let meth = ProvidedMethod("StaticMethod", [], typeof, isStatic=true, invokeCode = (fun args -> Expr.Value(null, typeof))) + myType.AddMember(meth) + asm.AddTypes [ myType ] + + myType + + let myParamType = + let t = ProvidedTypeDefinition(asm, ns, "GenerativeProvider", Some typeof, isErased=false) + t.DefineStaticParameters( [ProvidedStaticParameter("Count", typeof)], fun typeName args -> createType typeName (unbox args.[0])) + t + do + this.AddNamespace(ns, [myParamType]) + [] do () \ No newline at end of file diff --git a/tests/service/data/TestTP/TestTP.fsproj b/tests/service/data/TestTP/TestTP.fsproj index 442fc909f7a..75b18586019 100644 --- a/tests/service/data/TestTP/TestTP.fsproj +++ b/tests/service/data/TestTP/TestTP.fsproj @@ -2,16 +2,15 @@ - net472 + netstandard2.0 true - nunit $(OtherFlags) --nowarn:3390 --nowarn:3218 - + diff --git a/tests/service/data/TypeProviderConsole/Program.fs b/tests/service/data/TypeProviderConsole/Program.fs deleted file mode 100644 index 450b736fd6d..00000000000 --- a/tests/service/data/TypeProviderConsole/Program.fs +++ /dev/null @@ -1,6 +0,0 @@ -module Program - -[] -let main argv = - printfn "%A" argv - 0 // return an integer exit code diff --git a/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj b/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj deleted file mode 100644 index 144efa90d7d..00000000000 --- a/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj +++ /dev/null @@ -1,71 +0,0 @@ - - - - - Debug - AnyCPU - 2.0 - 39100933-24e2-4c64-9465-4996d3de52b2 - Exe - TypeProviderConsole - TypeProviderConsole - v4.5 - true - TypeProviderConsole - - - true - full - false - false - bin\Debug\ - DEBUG;TRACE - 3 - AnyCPU - bin\Debug\TypeProviderConsole.xml - true - - - pdbonly - true - true - bin\Release\ - TRACE - 3 - AnyCPU - bin\Release\TypeProviderConsole.xml - true - - - - - ..\..\..\..\packages\Microsoft.Portable.FSharp.Core.10.1.0\lib\profiles\net40\FSharp.Core.dll - false - - - - - - - - - - - TypeProviderLibrary - {1da23607-c5ef-42b7-b9a7-692572ad1b7b} - True - - - - - - - - ..\..\..\..\packages\NUnit\lib\nunit.framework.dll - True - True - - - - - \ No newline at end of file diff --git a/tests/service/data/TypeProviderLibrary/Library1.fs b/tests/service/data/TypeProviderLibrary/Library1.fs deleted file mode 100644 index ae9e9a1d784..00000000000 --- a/tests/service/data/TypeProviderLibrary/Library1.fs +++ /dev/null @@ -1,25 +0,0 @@ -namespace TypeProviderLibrary - -open Microsoft.FSharp.Core.CompilerServices -open System - -[] -type FakeTypeProvider() = - interface ITypeProvider with - member this.GetStaticParameters _ = [||] - member this.ApplyStaticArguments(_,_,_) = raise <| System.InvalidOperationException() - member this.GetNamespaces() = [| |] - member this.GetInvokerExpression(_,_) = failwith "GetInvokerExpression" - [] - member this.Invalidate = (new Event<_,_>()).Publish - member this.GetGeneratedAssemblyContents(assembly) = failwith "GetGeneratedAssemblyContents" - - interface ITypeProvider2 with - member this.GetStaticParametersForMethod _ = [||] - member this.ApplyStaticArgumentsForMethod(_,_,_) = raise <| System.InvalidOperationException() - - interface IDisposable with - member __.Dispose() = () - -[] -do() diff --git a/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.dll b/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.dll deleted file mode 100644 index 7dd893d01f4..00000000000 Binary files a/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.dll and /dev/null differ diff --git a/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj b/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj deleted file mode 100644 index f7125ac2d2b..00000000000 --- a/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj +++ /dev/null @@ -1,48 +0,0 @@ - - - - - Debug - AnyCPU - 2.0 - 1da23607-c5ef-42b7-b9a7-692572ad1b7b - Library - TypeProviderLibrary - TypeProviderLibrary - v4.5 - TypeProviderLibrary - - - true - full - false - false - .\ - DEBUG;TRACE - 3 - bin\Debug\TypeProviderLibrary.xml - - - pdbonly - true - true - .\ - TRACE - 3 - bin\Release\TypeProviderLibrary.xml - - - - - - - - ..\..\..\..\packages\Microsoft.Portable.FSharp.Core.10.1.0\lib\profiles\net40\FSharp.Core.dll - false - - - - - - - \ No newline at end of file diff --git a/tests/service/data/TypeProvidersBug/TestConsole/App.config b/tests/service/data/TypeProvidersBug/TestConsole/App.config deleted file mode 100644 index 8324aa6ff15..00000000000 --- a/tests/service/data/TypeProvidersBug/TestConsole/App.config +++ /dev/null @@ -1,6 +0,0 @@ - - - - - - \ No newline at end of file diff --git a/tests/service/data/TypeProvidersBug/TestConsole/Program.fs b/tests/service/data/TypeProvidersBug/TestConsole/Program.fs deleted file mode 100644 index 9b1e9f0ce97..00000000000 --- a/tests/service/data/TypeProvidersBug/TestConsole/Program.fs +++ /dev/null @@ -1,5 +0,0 @@ - -[] -let main _ = - let foo: string = TypeProvidersBug.Test.config.Foo - 0 \ No newline at end of file diff --git a/tests/service/data/TypeProvidersBug/TestConsole/TestConsole.fsproj b/tests/service/data/TypeProvidersBug/TestConsole/TestConsole.fsproj deleted file mode 100644 index 572852c0243..00000000000 --- a/tests/service/data/TypeProvidersBug/TestConsole/TestConsole.fsproj +++ /dev/null @@ -1,64 +0,0 @@ - - - - - Debug - AnyCPU - 2.0 - 247653e8-fba7-419b-8b7a-8b17ebfe2969 - Exe - TestConsole - TestConsole - v4.6 - true - TestConsole - - - true - full - false - false - bin\Debug\ - DEBUG;TRACE - 3 - AnyCPU - bin\Debug\TestConsole.XML - true - - - pdbonly - true - true - bin\Release\ - TRACE - 3 - AnyCPU - bin\Release\TestConsole.XML - true - - - - - - - - - - - - - ..\..\..\..\..\packages\Microsoft.Portable.FSharp.Core.10.1.0\lib\profiles\net40\FSharp.Core.dll - false - - - TypeProvidersBug - {7b36cdd5-14f3-42f0-8118-c279d2315a22} - True - - - ..\..\..\..\..\packages\FSharp.Configuration.1.3.0\lib\net45\FSharp.Configuration.dll - True - - - - \ No newline at end of file diff --git a/tests/service/data/TypeProvidersBug/TypeProvidersBug/AssemblyInfo.fs b/tests/service/data/TypeProvidersBug/TypeProvidersBug/AssemblyInfo.fs deleted file mode 100644 index 5552b38496a..00000000000 --- a/tests/service/data/TypeProvidersBug/TypeProvidersBug/AssemblyInfo.fs +++ /dev/null @@ -1,41 +0,0 @@ -namespace TypeProvidersBug.AssemblyInfo - -open System.Reflection -open System.Runtime.CompilerServices -open System.Runtime.InteropServices - -// General Information about an assembly is controlled through the following -// set of attributes. Change these attribute values to modify the information -// associated with an assembly. -[] -[] -[] -[] -[] -[] -[] -[] - -// Setting ComVisible to false makes the types in this assembly not visible -// to COM components. If you need to access a type in this assembly from -// COM, set the ComVisible attribute to true on that type. -[] - -// The following GUID is for the ID of the typelib if this project is exposed to COM -[] - -// Version information for an assembly consists of the following four values: -// -// Major Version -// Minor Version -// Build Number -// Revision -// -// You can specify all the values or you can default the Build and Revision Numbers -// by using the '*' as shown below: -// [] -[] -[] - -do - () \ No newline at end of file diff --git a/tests/service/data/TypeProvidersBug/TypeProvidersBug/Library1.fs b/tests/service/data/TypeProvidersBug/TypeProvidersBug/Library1.fs deleted file mode 100644 index 531e89d8460..00000000000 --- a/tests/service/data/TypeProvidersBug/TypeProvidersBug/Library1.fs +++ /dev/null @@ -1,7 +0,0 @@ -module TypeProvidersBug.Test - -open FSharp.Configuration - -type Configuration = YamlConfig - -let config = Configuration() diff --git a/tests/service/data/TypeProvidersBug/TypeProvidersBug/TypeProvidersBug.fsproj b/tests/service/data/TypeProvidersBug/TypeProvidersBug/TypeProvidersBug.fsproj deleted file mode 100644 index 1ee42f8d19c..00000000000 --- a/tests/service/data/TypeProvidersBug/TypeProvidersBug/TypeProvidersBug.fsproj +++ /dev/null @@ -1,54 +0,0 @@ - - - - - Debug - AnyCPU - 2.0 - 7b36cdd5-14f3-42f0-8118-c279d2315a22 - Library - TypeProvidersBug - TypeProvidersBug - v4.6 - true - TypeProvidersBug - - - true - full - false - false - bin\Debug\ - DEBUG;TRACE - 3 - bin\Debug\TypeProvidersBug.XML - - - pdbonly - true - true - bin\Release\ - TRACE - 3 - bin\Release\TypeProvidersBug.XML - - - - - - - - - - - - ..\..\..\..\..\packages\Microsoft.Portable.FSharp.Core.10.1.0\lib\profiles\net40\FSharp.Core.dll - false - - - ..\..\..\..\..\packages\FSharp.Configuration.1.3.0\lib\net45\FSharp.Configuration.dll - True - - - - \ No newline at end of file diff --git a/tests/service/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll b/tests/service/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll deleted file mode 100644 index 1ef8b4ae875..00000000000 Binary files a/tests/service/data/TypeProvidersBug/TypeProvidersBug/bin/Debug/TypeProvidersBug.dll and /dev/null differ diff --git a/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx b/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx index 6dcce384f1f..b5dcc2d6f0b 100644 --- a/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx +++ b/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx @@ -626,65 +626,6 @@ let LocalValueShadowsArgument2 x = null // breakpoint 2 () -module InlinedCode = - // MANUAL TEST: check you can place breakpoints in this method and hit them - // in both Debug and Release code - let inline bodyRunner z body = - let x = 1 + z - printfn "running" - body x - body x - - let test() = - let bodyWrapper = - let x = 1 + System.Random().Next() - bodyRunner 3 (fun n -> - // MANUAL TEST: check you can place breakpoint here and hit it in both Debug and Release code - printfn "line1, x = %d" x - // MANUAL TEST: check you can place breakpoint here and hit it in both Debug and Release code - printfn "line2, n = %d" n) - - let bodyWrapper2 = - // TEST: check you can place breakpoint here and hit it in both Debug and Release code - let x = 1 + System.Random().Next() - bodyRunner 3 <| (fun n -> - // MANUAL TEST: check you can place breakpoint here and hit it in both Debug and Release code - printfn "line1, x = %d" x - // MANUAL TEST: check you can place breakpoint here and hit it in both Debug and Release code - printfn "line2, n = %d" n) - () - -module Pipelined = - let testListPipeline() = - let data = [ 1 .. 5 ] - - // MANUAL TEST: check stepping through this looks ok - let newData = - data - |> List.filter (fun x -> - // MANUAL TEST: check you can place breakpoint here and hit it in both Debug and Release code - x > 3) - |> List.map (fun x -> - // MANUAL TEST: check you can place breakpoint here and hit it in both Debug and Release code - x * x) - - printfn "%A" newData - - let testArrayPipeline() = - let data = [| 1 .. 5 |] - - let newData = - data - |> Array.filter (fun x -> - // MANUAL TEST: check you can place breakpoint here and hit it in both Debug and Release code - x > 3) - |> Array.map (fun x -> - // MANUAL TEST: check you can place breakpoint here and hit it in both Debug code - // TODO: surprisingly no breakpoint hit here in release code - x * x) - - printfn "%A" newData - TailcallRecursionTest1 3 TailcallRecursionTest2 (U2(3,4)) SteppingMatch01 (Choice1Of2 3) @@ -764,6 +705,3 @@ InnerFunctionDefinitionHadTwoBreakpoints "aaaa" |> ignore InnerRecursiveFunctionDefinitionHadTwoBreakpoints "aaaa" |> ignore LocalValueShadowsArgument1 "123" LocalValueShadowsArgument2 "123" -InlinedCode.test() -Pipelined.testListPipeline() -Pipelined.testArrayPipeline() diff --git a/vsintegration/src/FSharp.Editor/Common/Extensions.fs b/vsintegration/src/FSharp.Editor/Common/Extensions.fs index f6f07117b52..6315654f56a 100644 --- a/vsintegration/src/FSharp.Editor/Common/Extensions.fs +++ b/vsintegration/src/FSharp.Editor/Common/Extensions.fs @@ -6,6 +6,8 @@ module internal Microsoft.VisualStudio.FSharp.Editor.Extensions open System open System.IO open System.Collections.Immutable +open System.Threading +open System.Threading.Tasks open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.Text @@ -290,3 +292,19 @@ module Exception = | _ -> root |> flattenInner |> String.concat " ---> " + +type Async with + static member RunImmediateExceptOnUI (computation: Async<'T>, ?cancellationToken ) = + match SynchronizationContext.Current with + | null -> + let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + 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.Result + | _ -> Async.RunSynchronously(computation, ?cancellationToken=cancellationToken) diff --git a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs index b327eab0ca3..e4a693efd5d 100644 --- a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs +++ b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs @@ -228,3 +228,4 @@ module internal OpenDeclarationHelper = module internal TaggedText = let toString (tts: TaggedText[]) = tts |> Array.map (fun tt -> tt.Text) |> String.concat "" + diff --git a/vsintegration/src/FSharp.Editor/Formatting/IndentationService.fs b/vsintegration/src/FSharp.Editor/Formatting/IndentationService.fs index b540e06caf4..1a87ac9d89d 100644 --- a/vsintegration/src/FSharp.Editor/Formatting/IndentationService.fs +++ b/vsintegration/src/FSharp.Editor/Formatting/IndentationService.fs @@ -107,4 +107,4 @@ type internal FSharpIndentationService match indent with | None -> Nullable() | Some(indentation) -> Nullable(FSharpIndentationResult(sourceText.Lines.[lineNumber].Start, indentation)) - } |> (fun c -> Async.RunSynchronously(c,cancellationToken=cancellationToken)) + } |> (fun c -> Async.RunImmediateExceptOnUI(c,cancellationToken=cancellationToken)) diff --git a/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs b/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs index 11a265d3b04..f012f65ed44 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/WorkspaceExtensions.fs @@ -203,7 +203,7 @@ type Document with let workspaceService = this.Project.Solution.GetFSharpWorkspaceService() let parsingOptions, _, _ = workspaceService.FSharpProjectOptionsManager.TryGetOptionsForDocumentOrProject(this, CancellationToken.None, nameof(this.SetFSharpProjectOptionsForTesting)) - |> Async.RunSynchronously + |> Async.RunImmediateExceptOnUI |> Option.get ProjectCache.Projects.Add(this.Project, (workspaceService.Checker, workspaceService.FSharpProjectOptionsManager, parsingOptions, projectOptions)) diff --git a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs index 90474acfd3c..2b4ab7b6af2 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinition.fs @@ -473,7 +473,7 @@ type internal GoToDefinition(metadataAsSource: FSharpMetadataAsSourceService) = } let span = - match Async.RunSynchronously(goToAsync, cancellationToken = cancellationToken) with + match Async.RunImmediateExceptOnUI(goToAsync, cancellationToken = cancellationToken) with | Some span -> span | _ -> TextSpan() diff --git a/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs b/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs index 5c2aa632f3c..a96b20ed8ed 100644 --- a/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs +++ b/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs @@ -98,7 +98,7 @@ type internal FSharpLanguageServiceBackgroundRequests_DEPRECATED lazy // This portion is executed on the language service thread let timestamp = if source=null then System.DateTime(2000,1,1) else source.OpenedTime // source is null in unit tests let checker = getInteractiveChecker() - let checkOptions, _diagnostics = checker.GetProjectOptionsFromScript(fileName, FSharp.Compiler.Text.SourceText.ofString sourceText, SessionsProperties.fsiPreview, timestamp, [| |]) |> Async.RunSynchronously + let checkOptions, _diagnostics = checker.GetProjectOptionsFromScript(fileName, FSharp.Compiler.Text.SourceText.ofString sourceText, SessionsProperties.fsiPreview, timestamp, [| |]) |> Async.RunImmediate let referencedProjectFileNames = [| |] let projectSite = ProjectSitesAndFiles.CreateProjectSiteForScript(fileName, referencedProjectFileNames, checkOptions) { ProjectSite = projectSite @@ -141,7 +141,7 @@ type internal FSharpLanguageServiceBackgroundRequests_DEPRECATED // Do brace matching if required if req.ResultSink.BraceMatching then // Record brace-matching - let braceMatches = interactiveChecker.MatchBraces(req.FileName,req.Text,checkOptions) |> Async.RunSynchronously + let braceMatches = interactiveChecker.MatchBraces(req.FileName,req.Text,checkOptions) |> Async.RunImmediate let mutable pri = 0 for (b1,b2) in braceMatches do @@ -153,14 +153,14 @@ type internal FSharpLanguageServiceBackgroundRequests_DEPRECATED | BackgroundRequestReason.ParseFile -> // invoke ParseFile directly - relying on cache inside the interactiveChecker - let parseResults = interactiveChecker.ParseFileInProject(req.FileName, req.Text, checkOptions) |> Async.RunSynchronously + let parseResults = interactiveChecker.ParseFileInProject(req.FileName, req.Text, checkOptions) |> Async.RunImmediate parseFileResults <- Some parseResults | _ -> let syncParseInfoOpt = if FSharpIntellisenseInfo_DEPRECATED.IsReasonRequiringSyncParse(req.Reason) then - let parseResults = interactiveChecker.ParseFileInProject(req.FileName,req.Text,checkOptions) |> Async.RunSynchronously + let parseResults = interactiveChecker.ParseFileInProject(req.FileName,req.Text,checkOptions) |> Async.RunImmediate Some parseResults else None @@ -188,14 +188,14 @@ type internal FSharpLanguageServiceBackgroundRequests_DEPRECATED let parseResults = match syncParseInfoOpt with | Some x -> x - | None -> interactiveChecker.ParseFileInProject(req.FileName,req.Text,checkOptions) |> Async.RunSynchronously + | None -> interactiveChecker.ParseFileInProject(req.FileName,req.Text,checkOptions) |> Async.RunImmediate // Should never matter but don't let anything in FSharp.Compiler extend the lifetime of 'source' let sr = ref (Some source) // Type-checking let typedResults,aborted = - match interactiveChecker.CheckFileInProject(parseResults,req.FileName,req.Timestamp,FSharp.Compiler.Text.SourceText.ofString(req.Text),checkOptions) |> Async.RunSynchronously with + match interactiveChecker.CheckFileInProject(parseResults,req.FileName,req.Timestamp,FSharp.Compiler.Text.SourceText.ofString(req.Text),checkOptions) |> Async.RunImmediate with | FSharpCheckFileAnswer.Aborted -> // isResultObsolete returned true during the type check. None,true @@ -219,7 +219,7 @@ type internal FSharpLanguageServiceBackgroundRequests_DEPRECATED if outOfDateProjectFileNames.Contains(projectFileName) then interactiveChecker.InvalidateConfiguration(checkOptions) interactiveChecker.ParseAndCheckProject(checkOptions) - |> Async.RunSynchronously + |> Async.RunImmediate |> ignore outOfDateProjectFileNames.Remove(projectFileName) |> ignore @@ -236,7 +236,7 @@ type internal FSharpLanguageServiceBackgroundRequests_DEPRECATED // On 'FullTypeCheck', send a message to the reactor to start the background compile for this project, just in case if req.Reason = BackgroundRequestReason.FullTypeCheck then interactiveChecker.ParseAndCheckProject(checkOptions) - |> Async.RunSynchronously + |> Async.RunImmediate |> ignore | Some typedResults -> @@ -265,7 +265,7 @@ type internal FSharpLanguageServiceBackgroundRequests_DEPRECATED // On 'FullTypeCheck', send a message to the reactor to start the background compile for this project, just in case if req.Reason = BackgroundRequestReason.FullTypeCheck then interactiveChecker.ParseAndCheckProject(checkOptions) - |> Async.RunSynchronously + |> Async.RunImmediate |> ignore // On 'QuickInfo', get the text for the quick info while we're off the UI thread, instead of doing it later diff --git a/vsintegration/src/FSharp.LanguageService/FSharpSource.fs b/vsintegration/src/FSharp.LanguageService/FSharpSource.fs index b311983e6b4..ac33dca38c6 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharpSource.fs +++ b/vsintegration/src/FSharp.LanguageService/FSharpSource.fs @@ -373,7 +373,7 @@ type internal FSharpSource_DEPRECATED(service:LanguageService_DEPRECATED, textLi Stamp = None } |> ic.GetParsingOptionsFromProjectOptions - ic.ParseFile(fileName, FSharp.Compiler.Text.SourceText.ofString (source.GetText()), co) |> Async.RunSynchronously + ic.ParseFile(fileName, FSharp.Compiler.Text.SourceText.ofString (source.GetText()), co) |> Async.RunImmediate override source.GetCommentFormat() = let mutable info = new CommentInfo() diff --git a/vsintegration/src/FSharp.LanguageService/LanguageServiceConstants.fs b/vsintegration/src/FSharp.LanguageService/LanguageServiceConstants.fs index 46bd6dd2f04..7a9cd796132 100644 --- a/vsintegration/src/FSharp.LanguageService/LanguageServiceConstants.fs +++ b/vsintegration/src/FSharp.LanguageService/LanguageServiceConstants.fs @@ -2,6 +2,8 @@ namespace Microsoft.VisualStudio.FSharp.LanguageService +open System.Threading.Tasks + [] module internal LanguageServiceConstants = @@ -11,4 +13,21 @@ module internal LanguageServiceConstants = [] /// "F# Language Service" - let FSharpLanguageServiceCallbackName = "F# Language Service" \ No newline at end of file + let FSharpLanguageServiceCallbackName = "F# Language Service" + + +[] +module AsyncExtensions = + type Async with + static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = + let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + 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.Result + diff --git a/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs b/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs index cddffc15c0a..9620371d6e3 100644 --- a/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs +++ b/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs @@ -129,7 +129,7 @@ type internal FSharpLanguageServiceTestable() as this = member this.OnProjectCleaned(projectSite:IProjectSite) = let enableInMemoryCrossProjectReferences = true let _, checkOptions = ProjectSitesAndFiles.GetProjectOptionsForProjectSite(enableInMemoryCrossProjectReferences, (fun _ -> None), projectSite, serviceProvider.Value, "" , false) - this.FSharpChecker.NotifyProjectCleaned(checkOptions) |> Async.RunSynchronously + this.FSharpChecker.NotifyProjectCleaned(checkOptions) |> Async.RunImmediate member this.OnActiveViewChanged(textView) = bgRequests.OnActiveViewChanged(textView) diff --git a/vsintegration/tests/Salsa/salsa.fs b/vsintegration/tests/Salsa/salsa.fs index c0dfd0e18e2..523123e01b6 100644 --- a/vsintegration/tests/Salsa/salsa.fs +++ b/vsintegration/tests/Salsa/salsa.fs @@ -1102,7 +1102,7 @@ module internal Salsa = member file.GetFileName() = filename member file.GetProjectOptionsOfScript() = project.Solution.Vs.LanguageService.FSharpChecker.GetProjectOptionsFromScript(filename, FSharp.Compiler.Text.SourceText.ofString file.CombinedLines, false, System.DateTime(2000,1,1), [| |]) - |> Async.RunSynchronously + |> Async.RunImmediate |> fst // drop diagnostics member file.RecolorizeWholeFile() = () @@ -1316,7 +1316,7 @@ module internal Salsa = let declarations = let snapshot = VsActual.createTextBuffer(file.CombinedLines).CurrentSnapshot - currentAuthoringScope.GetDeclarations(snapshot, cursor.line-1, cursor.col-1, reason) |> Async.RunSynchronously + currentAuthoringScope.GetDeclarations(snapshot, cursor.line-1, cursor.col-1, reason) |> Async.RunImmediate match declarations with | null -> [||] | declarations -> @@ -1335,7 +1335,7 @@ module internal Salsa = let currentAuthoringScope = file.DoIntellisenseRequest(BackgroundRequestReason.MemberSelect) let declarations = let snapshot = VsActual.createTextBuffer(file.CombinedLines).CurrentSnapshot - currentAuthoringScope.GetDeclarations(snapshot, cursor.line-1,cursor.col-1, BackgroundRequestReason.MemberSelect) |> Async.RunSynchronously + currentAuthoringScope.GetDeclarations(snapshot, cursor.line-1,cursor.col-1, BackgroundRequestReason.MemberSelect) |> Async.RunImmediate match declarations with | null -> None | declarations -> diff --git a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs index 1e05ea76bd8..c4a1d61cde8 100644 --- a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs +++ b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs @@ -37,7 +37,7 @@ type BraceMatchingServiceTests() = Assert.IsTrue(position >= 0, "Cannot find marker '{0}' in file contents", marker) let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions - match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, parsingOptions, position, "UnitTest") |> Async.RunSynchronously with + match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, parsingOptions, position, "UnitTest") |> Async.RunImmediate with | None -> () | Some(left, right) -> Assert.Fail("Found match for brace '{0}'", marker) @@ -50,7 +50,7 @@ type BraceMatchingServiceTests() = Assert.IsTrue(endMarkerPosition >= 0, "Cannot find end marker '{0}' in file contents", endMarkerPosition) let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions - match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, parsingOptions, startMarkerPosition, "UnitTest") |> Async.RunSynchronously with + match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, parsingOptions, startMarkerPosition, "UnitTest") |> Async.RunImmediate with | None -> Assert.Fail("Didn't find a match for start brace at position '{0}", startMarkerPosition) | Some(left, right) -> let endPositionInRange(range) =