diff --git a/FSharp.Compiler.Service.sln b/FSharp.Compiler.Service.sln index 03de2676e4..5ce4d6ae1d 100644 --- a/FSharp.Compiler.Service.sln +++ b/FSharp.Compiler.Service.sln @@ -1,6 +1,6 @@ Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.30501.0 +# Visual Studio 14 +VisualStudioVersion = 14.0.23107.0 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "project", "project", "{B6B68AE6-E7A4-4D43-9B34-FFA74BFE192B}" ProjectSection(SolutionItems) = preProject @@ -57,7 +57,7 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fsc", "samples\FscExe\Fsc.f EndProject Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "CSharp_Analysis", "tests\service\data\CSharp_Analysis\CSharp_Analysis.csproj", "{887630A3-4B1D-40EA-B8B3-2D842E9C40DB}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.ProjectCracker.Exe", "src\fsharp\FSharp.Compiler.Service.ProjectCracker.Exe\FSharp.Compiler.Service.ProjectCracker.Exe.fsproj", "{B1BDD96D-47E1-4E65-8107-FBAE23A06DB4}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.ProjectCracker.Tool", "src\fsharp\FSharp.Compiler.Service.ProjectCracker.Tool\FSharp.Compiler.Service.ProjectCracker.Tool.fsproj", "{B1BDD96D-47E1-4E65-8107-FBAE23A06DB4}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler.Service.ProjectCracker", "src\fsharp\FSharp.Compiler.Service.ProjectCracker\FSharp.Compiler.Service.ProjectCracker.fsproj", "{893C3CD9-5AF8-4027-A667-21E62FC2C703}" EndProject diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 00c7a9c7fc..cf32fc0097 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,3 +1,11 @@ +#### 2.0.0.0-beta +* Feature #470, #478, #479 - Move ProjectCracker to separate nuget package and DLL, used ProjectCracker.Tool.exe to run +* Feature #463 - Expose slot signatures of members in object expressions +* Feature #469, #475 - Add EvalExpressionNonThrowing, EvalInteractionNonThrowing, EvalScriptNonThrowing +* Fix #456 - FCS makes calls to kernel32.dll when running on OSX +* Fix #473 - stack overflow in resolution logic +* Fix #460 - Failure getting expression for a provided method call + #### 1.4.2.1 - * #450 - Correct generation of ReferencedProjects diff --git a/nuget/paket.template b/nuget/paket.template index 1616b6340d..32cc35a6d9 100644 --- a/nuget/paket.template +++ b/nuget/paket.template @@ -16,10 +16,10 @@ tags F#, fsharp, interactive, compiler, editor files ../bin/v4.0/FSharp.Compiler.Service.dll ==> lib/net40 - ../bin/v4.0/FSharp.Compiler.Service.XML ==> lib/net40 + ../bin/v4.0/FSharp.Compiler.Service.xml ==> lib/net40 ../bin/v4.0/FSharp.Compiler.Service.?db ==> lib/net40 ../bin/v4.0/FSharp.Compiler.Service.dll.?db ==> lib/net40 ../bin/v4.5/FSharp.Compiler.Service.dll ==> lib/net45 - ../bin/v4.5/FSharp.Compiler.Service.XML ==> lib/net45 + ../bin/v4.5/FSharp.Compiler.Service.xml ==> lib/net45 ../bin/v4.5/FSharp.Compiler.Service.?db ==> lib/net45 ../bin/v4.5/FSharp.Compiler.Service.dll.?db ==> lib/net45 \ No newline at end of file diff --git a/nuget/projectcracker.template b/nuget/projectcracker.template index 4a15816b51..fdf0ebcdcc 100644 --- a/nuget/projectcracker.template +++ b/nuget/projectcracker.template @@ -12,10 +12,10 @@ iconurl https://raw.github.com/fsharp/FSharp.Compiler.Service/master/misc/logo.p tags F#, fsharp, msbuild, editor files - ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.Exe.exe ==> lib/net45 - ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.Exe.?db ==> lib/net45 - ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.Exe.exe.?db ==> lib/net45 + ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.Tool.exe ==> lib/net45 + ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.Tool.?db ==> lib/net45 + ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.Tool.exe.?db ==> lib/net45 ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.dll ==> lib/net45 - ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.XML ==> lib/net45 + ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.xml ==> lib/net45 ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.?db ==> lib/net45 ../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.dll.?db ==> lib/net45 \ No newline at end of file diff --git a/samples/EditorService/EditorService.fsproj b/samples/EditorService/EditorService.fsproj index 88ccf04b86..8969499196 100644 --- a/samples/EditorService/EditorService.fsproj +++ b/samples/EditorService/EditorService.fsproj @@ -22,7 +22,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\EditorService.XML + bin\Debug\EditorService.xml true @@ -33,7 +33,7 @@ TRACE 3 AnyCPU - bin\Release\EditorService.XML + bin\Release\EditorService.xml true diff --git a/samples/FscExe/Fsc.fsproj b/samples/FscExe/Fsc.fsproj index ead811d5c5..e0ed92eb07 100644 --- a/samples/FscExe/Fsc.fsproj +++ b/samples/FscExe/Fsc.fsproj @@ -25,7 +25,7 @@ TRACE;DEBUG 3 AnyCPU - bin\Debug\FsiExe.XML + bin\Debug\FsiExe.xml true @@ -38,7 +38,7 @@ TRACE 3 AnyCPU - bin\Release\FsiExe.XML + bin\Release\FsiExe.xml true diff --git a/samples/FsiExe/FsiExe.fsproj b/samples/FsiExe/FsiExe.fsproj index 7d6e79e09b..51aff4788c 100644 --- a/samples/FsiExe/FsiExe.fsproj +++ b/samples/FsiExe/FsiExe.fsproj @@ -22,7 +22,7 @@ TRACE;DEBUG 3 AnyCPU - bin\Debug\FsiExe.XML + bin\Debug\FsiExe.xml true @@ -35,7 +35,7 @@ TRACE 3 AnyCPU - bin\Release\FsiExe.XML + bin\Release\FsiExe.xml true diff --git a/samples/InteractiveService/InteractiveService.fsproj b/samples/InteractiveService/InteractiveService.fsproj index bf18a6ebd6..68b26c1948 100644 --- a/samples/InteractiveService/InteractiveService.fsproj +++ b/samples/InteractiveService/InteractiveService.fsproj @@ -22,7 +22,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\InteractiveService.XML + bin\Debug\InteractiveService.xml true @@ -33,7 +33,7 @@ TRACE 3 AnyCPU - bin\Release\InteractiveService.XML + bin\Release\InteractiveService.xml true diff --git a/samples/Tokenizer/Tokenizer.fsproj b/samples/Tokenizer/Tokenizer.fsproj index 10bc3840eb..034d23b07e 100644 --- a/samples/Tokenizer/Tokenizer.fsproj +++ b/samples/Tokenizer/Tokenizer.fsproj @@ -22,7 +22,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Tokenizer.XML + bin\Debug\Tokenizer.xml true @@ -33,7 +33,7 @@ TRACE 3 AnyCPU - bin\Release\Tokenizer.XML + bin\Release\Tokenizer.xml true diff --git a/samples/UntypedTree/UntypedTree.fsproj b/samples/UntypedTree/UntypedTree.fsproj index 823c21a2b7..db293ceabc 100644 --- a/samples/UntypedTree/UntypedTree.fsproj +++ b/samples/UntypedTree/UntypedTree.fsproj @@ -22,7 +22,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\UntypedTree.XML + bin\Debug\UntypedTree.xml true @@ -33,7 +33,7 @@ TRACE 3 AnyCPU - bin\Release\UntypedTree.XML + bin\Release\UntypedTree.xml true diff --git a/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Exe/App.config b/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Tool/App.config similarity index 100% rename from src/fsharp/FSharp.Compiler.Service.ProjectCracker.Exe/App.config rename to src/fsharp/FSharp.Compiler.Service.ProjectCracker.Tool/App.config diff --git a/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Exe/FSharp.Compiler.Service.ProjectCracker.Exe.fsproj b/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Tool/FSharp.Compiler.Service.ProjectCracker.Tool.fsproj similarity index 93% rename from src/fsharp/FSharp.Compiler.Service.ProjectCracker.Exe/FSharp.Compiler.Service.ProjectCracker.Exe.fsproj rename to src/fsharp/FSharp.Compiler.Service.ProjectCracker.Tool/FSharp.Compiler.Service.ProjectCracker.Tool.fsproj index bfc08be931..fc1f92becd 100644 --- a/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Exe/FSharp.Compiler.Service.ProjectCracker.Exe.fsproj +++ b/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Tool/FSharp.Compiler.Service.ProjectCracker.Tool.fsproj @@ -7,18 +7,18 @@ 2.0 b1bdd96d-47e1-4e65-8107-fbae23a06db4 Exe - FSharp.Compiler.Service.ProjectCracker.Exe - FSharp.Compiler.Service.ProjectCracker.Exe + FSharp.Compiler.Service.ProjectCracker.Tool + FSharp.Compiler.Service.ProjectCracker.Tool v4.5 4.3.0.0 ..\..\..\ - FSharp.Compiler.Service.ProjectCracker.Exe + FSharp.Compiler.Service.ProjectCracker.Tool $(OtherFlags) --staticlink:FSharp.Core $(NoWarn);40 true - FSharp.Compiler.Service.ProjectCracker.Exe + FSharp.Compiler.Service.ProjectCracker.Tool ..\..\..\bin\$(TargetFrameworkVersion) - ..\..\..\bin\$(TargetFrameworkVersion)\FSharp.Compiler.Service.ProjectCracker.Exe.XML + ..\..\..\bin\$(TargetFrameworkVersion)\FSharp.Compiler.Service.ProjectCracker.Tool.xml true diff --git a/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Exe/Program.fs b/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Tool/Program.fs similarity index 98% rename from src/fsharp/FSharp.Compiler.Service.ProjectCracker.Exe/Program.fs rename to src/fsharp/FSharp.Compiler.Service.ProjectCracker.Tool/Program.fs index 5f1f847f2f..bf6f6df95b 100644 --- a/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Exe/Program.fs +++ b/src/fsharp/FSharp.Compiler.Service.ProjectCracker.Tool/Program.fs @@ -1,4 +1,4 @@ -namespace FSharp.Compiler.Service.ProjectCracker.Exe +namespace Microsoft.FSharp.Compiler.SourceCodeServices.ProjectCracker.Tool open Microsoft.Build.Framework open Microsoft.Build.Utilities @@ -37,7 +37,7 @@ module Program = member x.Log = sb.ToString() type internal HostCompile() = - member th.Compile(_, _, _) = 0 + member th.Compile(_:obj, _:obj, _:obj) = 0 interface ITaskHost //---------------------------------------------------------------------------- @@ -127,16 +127,18 @@ module Program = let host = new HostCompile() engine.HostServices.RegisterHostObject(fsprojFullPath, "CoreCompile", "Fsc", host) + let projectInstanceFromFullPath (fsprojFullPath: string) = use stream = new IO.StreamReader(fsprojFullPath) use xmlReader = System.Xml.XmlReader.Create(stream) let project = engine.LoadProject(xmlReader, FullPath=fsprojFullPath) - + project.SetGlobalProperty("BuildingInsideVisualStudio", "true") |> ignore project.SetGlobalProperty("VisualStudioVersion", "12.0") |> ignore + project.SetGlobalProperty("ShouldUnsetParentConfigurationAndPlatform", "false") |> ignore for (prop, value) in properties do - project.SetProperty(prop, value) |> ignore + project.SetGlobalProperty(prop, value) |> ignore project.CreateProjectInstance() diff --git a/src/fsharp/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj b/src/fsharp/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj index 2b1f1e14aa..67bffe41d7 100644 --- a/src/fsharp/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj +++ b/src/fsharp/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj @@ -14,7 +14,7 @@ 4.3.0.0 FSharp.Compiler.Service.ProjectCracker ..\..\..\bin\$(TargetFrameworkVersion) - ..\..\..\bin\$(TargetFrameworkVersion)\FSharp.Compiler.Service.ProjectCracker.XML + ..\..\..\bin\$(TargetFrameworkVersion)\FSharp.Compiler.Service.ProjectCracker.xml true @@ -48,8 +48,8 @@ - - FSharp.Compiler.Service.ProjectCracker.Exe + + FSharp.Compiler.Service.ProjectCracker.Tool {b1bdd96d-47e1-4e65-8107-fbae23a06db4} True diff --git a/src/fsharp/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs b/src/fsharp/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs index fdc314f793..a6f96c4bec 100644 --- a/src/fsharp/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs +++ b/src/fsharp/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs @@ -1,4 +1,4 @@ -namespace FSharp.Compiler.Service +namespace Microsoft.FSharp.Compiler.SourceCodeServices open System.Diagnostics open System.Text @@ -6,8 +6,6 @@ open System.IO open System open System.Runtime -open Microsoft.FSharp.Compiler.SourceCodeServices - type ProjectCracker = static member GetProjectOptionsFromProjectFileLogged(projectFileName : string, ?properties : (string * string) list, ?loadedTimeStamp, ?enableLogging) = @@ -16,7 +14,7 @@ type ProjectCracker = let enableLogging = defaultArg enableLogging true let logMap = ref Map.empty - let rec convert (opts: FSharp.Compiler.Service.ProjectCracker.Exe.ProjectOptions) : FSharpProjectOptions = + let rec convert (opts: Microsoft.FSharp.Compiler.SourceCodeServices.ProjectCracker.Tool.ProjectOptions) : FSharpProjectOptions = let referencedProjects = Array.map (fun (a, b) -> a, convert b) opts.ReferencedProjectOptions logMap := Map.add opts.ProjectFile opts.LogOutput !logMap { ProjectFileName = opts.ProjectFile @@ -33,10 +31,10 @@ type ProjectCracker = arguments.Append(' ').Append(enableLogging.ToString()) |> ignore for k, v in properties do arguments.Append(' ').Append(k).Append(' ').Append(v) |> ignore - + let codebase = Path.GetDirectoryName(Uri(typeof.Assembly.CodeBase).LocalPath) + let p = new System.Diagnostics.Process() - p.StartInfo.FileName <- Path.Combine(Path.GetDirectoryName(Reflection.Assembly.GetExecutingAssembly().Location), - "FSharp.Compiler.Service.ProjectCracker.Exe.exe") + p.StartInfo.FileName <- Path.Combine(codebase,"FSharp.Compiler.Service.ProjectCracker.Tool.exe") p.StartInfo.Arguments <- arguments.ToString() p.StartInfo.UseShellExecute <- false p.StartInfo.CreateNoWindow <- true @@ -44,7 +42,7 @@ type ProjectCracker = ignore <| p.Start() let fmt = new Serialization.Formatters.Binary.BinaryFormatter() - let opts = fmt.Deserialize(p.StandardOutput.BaseStream) :?> FSharp.Compiler.Service.ProjectCracker.Exe.ProjectOptions + let opts = fmt.Deserialize(p.StandardOutput.BaseStream) :?> Microsoft.FSharp.Compiler.SourceCodeServices.ProjectCracker.Tool.ProjectOptions p.WaitForExit() convert opts, !logMap diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 6b492fbcf1..036a26d801 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -58,11 +58,11 @@ DEBUG; $(DefineConstants) false $(OtherFlags) --no-jit-optimize --jit-tracking - ..\..\..\bin\$(TargetFrameworkVersion)\FSharp.Compiler.Service.XML + ..\..\..\bin\$(TargetFrameworkVersion)\FSharp.Compiler.Service.xml true - ..\..\..\bin\$(TargetFrameworkVersion)\FSharp.Compiler.Service.XML + ..\..\..\bin\$(TargetFrameworkVersion)\FSharp.Compiler.Service.xml diff --git a/src/fsharp/vs/Exprs.fs b/src/fsharp/vs/Exprs.fs index 212f564694..a6e0c8ede4 100644 --- a/src/fsharp/vs/Exprs.fs +++ b/src/fsharp/vs/Exprs.fs @@ -16,8 +16,80 @@ open Microsoft.FSharp.Compiler.TypeRelations open Internal.Utilities +[] +module ExprUtilsImpl = + + // ILCall nodes arise from calls to .NET methods, and provided calls to + // F# methods. This method attempts to take the information in a ILMethodRef + // and bind it to a symbol. This is not fool proof when the ILCall refers to + // an F# method, but is a good approximation. + let bindILMethodRefToSymbol (cenv:Impl.cenv) m (ilMethRef: ILMethodRef) = + let tcref = Import.ImportILTypeRef cenv.amap m ilMethRef.EnclosingTypeRef + let enclosingType = generalizedTyconRef tcref + // First try to resolve it to IL metadata + let try1 = + if tcref.IsILTycon then + try + let mdef = resolveILMethodRefWithRescope (rescopeILType (p13 tcref.ILTyconInfo)) tcref.ILTyconRawMetadata ilMethRef + let minfo = MethInfo.CreateILMeth(cenv.amap, m, enclosingType, mdef) + Some (FSharpMemberOrFunctionOrValue(cenv, minfo)) + with _ -> None + else None + + // Otherwise try to bind it to an F# symbol + match try1 with + | Some res -> res + | None -> + try + // Try to bind the call to an F# method call + let memberParentName = if tcref.IsModuleOrNamespace then None else Some tcref.LogicalName + // TODO: this logical name is not correct in the presence of CompiledName + let logicalName = ilMethRef.Name + let isMember = memberParentName.IsSome + if isMember then + let isCtor = (ilMethRef.Name = ".ctor") + let isStatic = isCtor || ilMethRef.CallingConv.IsStatic + let scoref = ilMethRef.EnclosingTypeRef.Scope + let typars1 = tcref.Typars(m) + let typars2 = [ 1 .. ilMethRef.GenericArity ] |> List.map (fun _ -> NewRigidTypar "T" m) + let tinst1 = typars1 |> generalizeTypars + let tinst2 = typars2 |> generalizeTypars + // TODO: this will not work for curried methods in F# classes. + // This is difficult to solve as the information in the ILMethodRef + // is not sufficient to resolve to a symbol unambiguously in these cases. + let argtys = [ ilMethRef.ArgTypes |> List.map (ImportTypeFromMetadata cenv.amap m scoref tinst1 tinst2) ] + let rty = + match ImportReturnTypeFromMetaData cenv.amap m ilMethRef.ReturnType scoref tinst1 tinst2 with + | None -> if isCtor then enclosingType else cenv.g.unit_ty + | Some ty -> ty + + let linkageType = + let ty = mkIteratedFunTy (List.map (mkTupledTy cenv.g) argtys) rty + let ty = if isStatic then ty else mkFunTy enclosingType ty + tryMkForallTy (typars1 @ typars2) ty + + let argCount = List.sum (List.map List.length argtys) + (if isStatic then 0 else 1) + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount },Some linkageType) + + let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu tcref.PublicPath.Value.EnclosingPath + let vref = mkNonLocalValRef enclosingNonLocalRef key + vref.Deref |> ignore // check we can dereference the value + let minfo = MethInfo.FSMeth(cenv.g, enclosingType, vref, None) + FSharpMemberOrFunctionOrValue(cenv, minfo) + else + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= 0 },None) + let vref = mkNonLocalValRef tcref.nlr key + vref.Deref |> ignore // check we can dereference the value + FSharpMemberOrFunctionOrValue(cenv, vref) + + with _ -> + failwith (sprintf "A call to '%s' could not be resolved" (ilMethRef.ToString())) + + + [] module ExprTranslationImpl = + type ExprTranslationEnv = { //Map from Val to binding index vs: ValMap; @@ -612,12 +684,7 @@ module FSharpExprConvert = | _ -> failwith "unexpected for-loop form" | TOp.ILCall(_,_,_,isNewObj,_valUseFlags,_isProp,_,ilMethRef,enclTypeArgs,methTypeArgs,_tys),[],callArgs -> - let tcref = Import.ImportILTypeRef cenv.amap m ilMethRef.EnclosingTypeRef - let mdef = - try resolveILMethodRefWithRescope (rescopeILType (p13 tcref.ILTyconInfo)) tcref.ILTyconRawMetadata ilMethRef - with _ -> failwith (sprintf "A call to '%s' could not be resolved" (ilMethRef.ToString())) - let minfo = MethInfo.CreateILMeth(cenv.amap, m, generalizedTyconRef tcref, mdef) - let v = FSharpMemberFunctionOrValue(cenv, minfo) + let v = bindILMethodRefToSymbol cenv m ilMethRef ConvObjectModelCallLinear cenv env (isNewObj, v, enclTypeArgs, methTypeArgs, callArgs) (fun e -> e) | TOp.TryFinally _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] -> diff --git a/tests/projects/Sample_VS2010_FSharp_ConsoleApp_net35/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj b/tests/projects/Sample_VS2010_FSharp_ConsoleApp_net35/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj index 46deef94ac..2d832f9337 100644 --- a/tests/projects/Sample_VS2010_FSharp_ConsoleApp_net35/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj +++ b/tests/projects/Sample_VS2010_FSharp_ConsoleApp_net35/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj @@ -22,7 +22,7 @@ DEBUG;TRACE 3 x86 - bin\Debug\SampleVisualStudio2010FSharpConsoleApp.XML + bin\Debug\SampleVisualStudio2010FSharpConsoleApp.xml pdbonly @@ -32,7 +32,7 @@ TRACE 3 x86 - bin\Release\SampleVisualStudio2010FSharpConsoleApp.XML + bin\Release\SampleVisualStudio2010FSharpConsoleApp.xml false diff --git a/tests/projects/Sample_VS2010_FSharp_ConsoleApp_net40/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj b/tests/projects/Sample_VS2010_FSharp_ConsoleApp_net40/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj index 294e387150..000cf8586c 100644 --- a/tests/projects/Sample_VS2010_FSharp_ConsoleApp_net40/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj +++ b/tests/projects/Sample_VS2010_FSharp_ConsoleApp_net40/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj @@ -26,7 +26,7 @@ DEBUG;TRACE 3 x86 - bin\Debug\SampleVisualStudio2010FSharpConsoleApp.XML + bin\Debug\SampleVisualStudio2010FSharpConsoleApp.xml pdbonly @@ -36,7 +36,7 @@ TRACE 3 x86 - bin\Release\SampleVisualStudio2010FSharpConsoleApp.XML + bin\Release\SampleVisualStudio2010FSharpConsoleApp.xml false diff --git a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net35/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net35/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj index f390d1aa0b..209b54359f 100644 --- a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net35/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net35/SampleVisualStudio2010FSharpConsoleApp/SampleVisualStudio2010FSharpConsoleApp.fsproj @@ -22,7 +22,7 @@ DEBUG;TRACE 3 x86 - bin\Debug\SampleVisualStudio2010FSharpConsoleApp.XML + bin\Debug\SampleVisualStudio2010FSharpConsoleApp.xml pdbonly @@ -32,7 +32,7 @@ TRACE 3 x86 - bin\Release\SampleVisualStudio2010FSharpConsoleApp.XML + bin\Release\SampleVisualStudio2010FSharpConsoleApp.xml false diff --git a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net40/Sample_VS2012_FSharp_ConsoleApp_net40/Sample_VS2012_FSharp_ConsoleApp_net40.fsproj b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net40/Sample_VS2012_FSharp_ConsoleApp_net40/Sample_VS2012_FSharp_ConsoleApp_net40.fsproj index 3f4aa6be86..62d6dcdc13 100644 --- a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net40/Sample_VS2012_FSharp_ConsoleApp_net40/Sample_VS2012_FSharp_ConsoleApp_net40.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net40/Sample_VS2012_FSharp_ConsoleApp_net40/Sample_VS2012_FSharp_ConsoleApp_net40.fsproj @@ -22,7 +22,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net40.XML + bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net40.xml true @@ -33,7 +33,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2012_FSharp_ConsoleApp_net40.XML + bin\Release\Sample_VS2012_FSharp_ConsoleApp_net40.xml true False diff --git a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013.fsproj b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013.fsproj index db7cfcd4fc..7c4c1da4b4 100644 --- a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013/Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013.fsproj @@ -22,7 +22,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013.XML + bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013.xml true @@ -33,7 +33,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013.XML + bin\Release\Sample_VS2012_FSharp_ConsoleApp_net40_upgraded_VS2013.xml true False diff --git a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj index f130e19e0e..97948e84f1 100644 --- a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net45.XML + bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net45.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2012_FSharp_ConsoleApp_net45.XML + bin\Release\Sample_VS2012_FSharp_ConsoleApp_net45.xml true False diff --git a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj index ff12c6c95d..26d0cb5134 100644 --- a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net45.XML + bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net45.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2012_FSharp_ConsoleApp_net45.XML + bin\Release\Sample_VS2012_FSharp_ConsoleApp_net45.xml true False diff --git a/tests/projects/Sample_VS2012_FSharp_Portable_Library/Sample_VS2012_FSharp_Portable_Library.fsproj b/tests/projects/Sample_VS2012_FSharp_Portable_Library/Sample_VS2012_FSharp_Portable_Library.fsproj index 9c499d5f0f..fc24ebae7d 100644 --- a/tests/projects/Sample_VS2012_FSharp_Portable_Library/Sample_VS2012_FSharp_Portable_Library.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_Portable_Library/Sample_VS2012_FSharp_Portable_Library.fsproj @@ -21,7 +21,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2012_FSharp_Portable_Library.XML + bin\Debug\Sample_VS2012_FSharp_Portable_Library.xml pdbonly @@ -30,7 +30,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2012_FSharp_Portable_Library.XML + bin\Release\Sample_VS2012_FSharp_Portable_Library.xml diff --git a/tests/projects/Sample_VS2012_FSharp_Portable_Library_upgraded_2013/Sample_VS2012_FSharp_Portable_Library_upgraded_2013.fsproj b/tests/projects/Sample_VS2012_FSharp_Portable_Library_upgraded_2013/Sample_VS2012_FSharp_Portable_Library_upgraded_2013.fsproj index a37549b2b2..5259bc2dfc 100644 --- a/tests/projects/Sample_VS2012_FSharp_Portable_Library_upgraded_2013/Sample_VS2012_FSharp_Portable_Library_upgraded_2013.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_Portable_Library_upgraded_2013/Sample_VS2012_FSharp_Portable_Library_upgraded_2013.fsproj @@ -22,7 +22,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2012_FSharp_Portable_Library_upgraded_2013.XML + bin\Debug\Sample_VS2012_FSharp_Portable_Library_upgraded_2013.xml pdbonly @@ -31,7 +31,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2012_FSharp_Portable_Library_upgraded_2013.XML + bin\Release\Sample_VS2012_FSharp_Portable_Library_upgraded_2013.xml diff --git a/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net40/Sample_VS2013_FSharp_ConsoleApp_net40.fsproj b/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net40/Sample_VS2013_FSharp_ConsoleApp_net40.fsproj index 1f886469b9..ef8cd6e6af 100644 --- a/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net40/Sample_VS2013_FSharp_ConsoleApp_net40.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net40/Sample_VS2013_FSharp_ConsoleApp_net40.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2013_FSharp_ConsoleApp_net40.XML + bin\Debug\Sample_VS2013_FSharp_ConsoleApp_net40.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2013_FSharp_ConsoleApp_net40.XML + bin\Release\Sample_VS2013_FSharp_ConsoleApp_net40.xml true diff --git a/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net45/Sample_VS2013_FSharp_ConsoleApp_net45.fsproj b/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net45/Sample_VS2013_FSharp_ConsoleApp_net45.fsproj index b60f313458..46799adb84 100644 --- a/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net45/Sample_VS2013_FSharp_ConsoleApp_net45.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net45/Sample_VS2013_FSharp_ConsoleApp_net45.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2013_FSharp_ConsoleApp_net45.XML + bin\Debug\Sample_VS2013_FSharp_ConsoleApp_net45.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2013_FSharp_ConsoleApp_net45.XML + bin\Release\Sample_VS2013_FSharp_ConsoleApp_net45.xml true diff --git a/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net451/Sample_VS2013_FSharp_ConsoleApp_net451.fsproj b/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net451/Sample_VS2013_FSharp_ConsoleApp_net451.fsproj index ddff3055df..9a7c157cf9 100644 --- a/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net451/Sample_VS2013_FSharp_ConsoleApp_net451.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_ConsoleApp_net451/Sample_VS2013_FSharp_ConsoleApp_net451.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2013_FSharp_ConsoleApp_net451.XML + bin\Debug\Sample_VS2013_FSharp_ConsoleApp_net451.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2013_FSharp_ConsoleApp_net451.XML + bin\Release\Sample_VS2013_FSharp_ConsoleApp_net451.xml true diff --git a/tests/projects/Sample_VS2013_FSharp_Library_net40/Sample_VS2013_FSharp_Library_net40.fsproj b/tests/projects/Sample_VS2013_FSharp_Library_net40/Sample_VS2013_FSharp_Library_net40.fsproj index 88b8fa069d..8bfe30e8b9 100644 --- a/tests/projects/Sample_VS2013_FSharp_Library_net40/Sample_VS2013_FSharp_Library_net40.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Library_net40/Sample_VS2013_FSharp_Library_net40.fsproj @@ -21,7 +21,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Library_net40.XML + bin\Debug\Sample_VS2013_FSharp_Library_net40.xml pdbonly @@ -30,7 +30,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Library_net40.XML + bin\Release\Sample_VS2013_FSharp_Library_net40.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Library_net45/Sample_VS2013_FSharp_Library_net45.fsproj b/tests/projects/Sample_VS2013_FSharp_Library_net45/Sample_VS2013_FSharp_Library_net45.fsproj index 8dfd6392a2..1b17259a8c 100644 --- a/tests/projects/Sample_VS2013_FSharp_Library_net45/Sample_VS2013_FSharp_Library_net45.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Library_net45/Sample_VS2013_FSharp_Library_net45.fsproj @@ -21,7 +21,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Library_net45.XML + bin\Debug\Sample_VS2013_FSharp_Library_net45.xml pdbonly @@ -30,7 +30,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Library_net45.XML + bin\Release\Sample_VS2013_FSharp_Library_net45.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Library_net451/Sample_VS2013_FSharp_Library_net451.fsproj b/tests/projects/Sample_VS2013_FSharp_Library_net451/Sample_VS2013_FSharp_Library_net451.fsproj index 696aa944da..cced2a0ab6 100644 --- a/tests/projects/Sample_VS2013_FSharp_Library_net451/Sample_VS2013_FSharp_Library_net451.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Library_net451/Sample_VS2013_FSharp_Library_net451.fsproj @@ -21,7 +21,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Library_net451.XML + bin\Debug\Sample_VS2013_FSharp_Library_net451.xml pdbonly @@ -30,7 +30,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Library_net451.XML + bin\Release\Sample_VS2013_FSharp_Library_net451.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net40/Sample_VS2013_FSharp_Portable_Library_Legacy_net40.fsproj b/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net40/Sample_VS2013_FSharp_Portable_Library_Legacy_net40.fsproj index c43f79290a..fc8aa611b9 100644 --- a/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net40/Sample_VS2013_FSharp_Portable_Library_Legacy_net40.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net40/Sample_VS2013_FSharp_Portable_Library_Legacy_net40.fsproj @@ -22,7 +22,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Portable_Library_Legacy_net40.XML + bin\Debug\Sample_VS2013_FSharp_Portable_Library_Legacy_net40.xml pdbonly @@ -31,7 +31,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Portable_Library_Legacy_net40.XML + bin\Release\Sample_VS2013_FSharp_Portable_Library_Legacy_net40.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net45/Sample_VS2013_FSharp_Portable_Library_Legacy_net45.fsproj b/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net45/Sample_VS2013_FSharp_Portable_Library_Legacy_net45.fsproj index 246622fc35..c2537c9cfd 100644 --- a/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net45/Sample_VS2013_FSharp_Portable_Library_Legacy_net45.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net45/Sample_VS2013_FSharp_Portable_Library_Legacy_net45.fsproj @@ -22,7 +22,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Portable_Library_Legacy_net45.XML + bin\Debug\Sample_VS2013_FSharp_Portable_Library_Legacy_net45.xml pdbonly @@ -31,7 +31,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Portable_Library_Legacy_net45.XML + bin\Release\Sample_VS2013_FSharp_Portable_Library_Legacy_net45.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net451/Sample_VS2013_FSharp_Portable_Library_Legacy_net451.fsproj b/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net451/Sample_VS2013_FSharp_Portable_Library_Legacy_net451.fsproj index e8d05156f0..4a52624238 100644 --- a/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net451/Sample_VS2013_FSharp_Portable_Library_Legacy_net451.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Portable_Library_Legacy_net451/Sample_VS2013_FSharp_Portable_Library_Legacy_net451.fsproj @@ -22,7 +22,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Portable_Library_Legacy_net451.XML + bin\Debug\Sample_VS2013_FSharp_Portable_Library_Legacy_net451.xml pdbonly @@ -31,7 +31,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Portable_Library_Legacy_net451.XML + bin\Release\Sample_VS2013_FSharp_Portable_Library_Legacy_net451.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Portable_Library_net45/Sample_VS2013_FSharp_Portable_Library_net45.fsproj b/tests/projects/Sample_VS2013_FSharp_Portable_Library_net45/Sample_VS2013_FSharp_Portable_Library_net45.fsproj index 33a30cec28..754447825c 100644 --- a/tests/projects/Sample_VS2013_FSharp_Portable_Library_net45/Sample_VS2013_FSharp_Portable_Library_net45.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Portable_Library_net45/Sample_VS2013_FSharp_Portable_Library_net45.fsproj @@ -23,7 +23,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Portable_Library_net45.XML + bin\Debug\Sample_VS2013_FSharp_Portable_Library_net45.xml pdbonly @@ -32,7 +32,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Portable_Library_net45.XML + bin\Release\Sample_VS2013_FSharp_Portable_Library_net45.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451/Sample_VS2013_FSharp_Portable_Library_net451.fsproj b/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451/Sample_VS2013_FSharp_Portable_Library_net451.fsproj index 7eaf6d3e26..3c7c70625c 100644 --- a/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451/Sample_VS2013_FSharp_Portable_Library_net451.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451/Sample_VS2013_FSharp_Portable_Library_net451.fsproj @@ -23,7 +23,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Portable_Library_net451.XML + bin\Debug\Sample_VS2013_FSharp_Portable_Library_net451.xml pdbonly @@ -32,7 +32,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Portable_Library_net451.XML + bin\Release\Sample_VS2013_FSharp_Portable_Library_net451.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451_adjusted_to_profile259/Sample_VS2013_FSharp_Portable_Library_net451.fsproj b/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451_adjusted_to_profile259/Sample_VS2013_FSharp_Portable_Library_net451.fsproj index 545b88c336..2c246f4a89 100644 --- a/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451_adjusted_to_profile259/Sample_VS2013_FSharp_Portable_Library_net451.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451_adjusted_to_profile259/Sample_VS2013_FSharp_Portable_Library_net451.fsproj @@ -23,7 +23,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Portable_Library_net451.XML + bin\Debug\Sample_VS2013_FSharp_Portable_Library_net451.xml pdbonly @@ -32,7 +32,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Portable_Library_net451.XML + bin\Release\Sample_VS2013_FSharp_Portable_Library_net451.xml diff --git a/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451_adjusted_to_profile78/Sample_VS2013_FSharp_Portable_Library_net451.fsproj b/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451_adjusted_to_profile78/Sample_VS2013_FSharp_Portable_Library_net451.fsproj index 6d630e8d70..9a2072e7d1 100644 --- a/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451_adjusted_to_profile78/Sample_VS2013_FSharp_Portable_Library_net451.fsproj +++ b/tests/projects/Sample_VS2013_FSharp_Portable_Library_net451_adjusted_to_profile78/Sample_VS2013_FSharp_Portable_Library_net451.fsproj @@ -23,7 +23,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2013_FSharp_Portable_Library_net451.XML + bin\Debug\Sample_VS2013_FSharp_Portable_Library_net451.xml pdbonly @@ -32,7 +32,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2013_FSharp_Portable_Library_net451.XML + bin\Release\Sample_VS2013_FSharp_Portable_Library_net451.xml diff --git a/tests/projects/Sample_VS2015_FSharp_Console_App_net40/Sample_VS2015_FSharp_Console_App_net40.fsproj b/tests/projects/Sample_VS2015_FSharp_Console_App_net40/Sample_VS2015_FSharp_Console_App_net40.fsproj index 61bb835bfa..dd8653972e 100644 --- a/tests/projects/Sample_VS2015_FSharp_Console_App_net40/Sample_VS2015_FSharp_Console_App_net40.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Console_App_net40/Sample_VS2015_FSharp_Console_App_net40.fsproj @@ -24,7 +24,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2015_FSharp_Console_App_net40.XML + bin\Debug\Sample_VS2015_FSharp_Console_App_net40.xml true @@ -35,7 +35,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2015_FSharp_Console_App_net40.XML + bin\Release\Sample_VS2015_FSharp_Console_App_net40.xml true diff --git a/tests/projects/Sample_VS2015_FSharp_Console_App_net45/Sample_VS2015_FSharp_Console_App_net45.fsproj b/tests/projects/Sample_VS2015_FSharp_Console_App_net45/Sample_VS2015_FSharp_Console_App_net45.fsproj index 8a00b55ab3..cc03548117 100644 --- a/tests/projects/Sample_VS2015_FSharp_Console_App_net45/Sample_VS2015_FSharp_Console_App_net45.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Console_App_net45/Sample_VS2015_FSharp_Console_App_net45.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2015_FSharp_Console_App_net45.XML + bin\Debug\Sample_VS2015_FSharp_Console_App_net45.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2015_FSharp_Console_App_net45.XML + bin\Release\Sample_VS2015_FSharp_Console_App_net45.xml true diff --git a/tests/projects/Sample_VS2015_FSharp_Console_App_net451/Sample_VS2015_FSharp_Console_App_net451.fsproj b/tests/projects/Sample_VS2015_FSharp_Console_App_net451/Sample_VS2015_FSharp_Console_App_net451.fsproj index f5267009de..edf290e3d6 100644 --- a/tests/projects/Sample_VS2015_FSharp_Console_App_net451/Sample_VS2015_FSharp_Console_App_net451.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Console_App_net451/Sample_VS2015_FSharp_Console_App_net451.fsproj @@ -24,7 +24,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2015_FSharp_Console_App_net451.XML + bin\Debug\Sample_VS2015_FSharp_Console_App_net451.xml true @@ -35,7 +35,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2015_FSharp_Console_App_net451.XML + bin\Release\Sample_VS2015_FSharp_Console_App_net451.xml true diff --git a/tests/projects/Sample_VS2015_FSharp_Console_App_net452/Sample_VS2015_FSharp_Console_App_net452.fsproj b/tests/projects/Sample_VS2015_FSharp_Console_App_net452/Sample_VS2015_FSharp_Console_App_net452.fsproj index 9213a48fb4..b3b4f89b78 100644 --- a/tests/projects/Sample_VS2015_FSharp_Console_App_net452/Sample_VS2015_FSharp_Console_App_net452.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Console_App_net452/Sample_VS2015_FSharp_Console_App_net452.fsproj @@ -24,7 +24,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2015_FSharp_Console_App_net452.XML + bin\Debug\Sample_VS2015_FSharp_Console_App_net452.xml true @@ -35,7 +35,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2015_FSharp_Console_App_net452.XML + bin\Release\Sample_VS2015_FSharp_Console_App_net452.xml true diff --git a/tests/projects/Sample_VS2015_FSharp_Console_App_net46/Sample_VS2015_FSharp_Console_App_net46.fsproj b/tests/projects/Sample_VS2015_FSharp_Console_App_net46/Sample_VS2015_FSharp_Console_App_net46.fsproj index af6010f6ea..fecd8cf165 100644 --- a/tests/projects/Sample_VS2015_FSharp_Console_App_net46/Sample_VS2015_FSharp_Console_App_net46.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Console_App_net46/Sample_VS2015_FSharp_Console_App_net46.fsproj @@ -24,7 +24,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\Sample_VS2015_FSharp_Console_App_net46.XML + bin\Debug\Sample_VS2015_FSharp_Console_App_net46.xml true @@ -35,7 +35,7 @@ TRACE 3 AnyCPU - bin\Release\Sample_VS2015_FSharp_Console_App_net46.XML + bin\Release\Sample_VS2015_FSharp_Console_App_net46.xml true diff --git a/tests/projects/Sample_VS2015_FSharp_Library_net40/Sample_VS2015_FSharp_Library_net40.fsproj b/tests/projects/Sample_VS2015_FSharp_Library_net40/Sample_VS2015_FSharp_Library_net40.fsproj index 7292d5fb70..f99425c2fc 100644 --- a/tests/projects/Sample_VS2015_FSharp_Library_net40/Sample_VS2015_FSharp_Library_net40.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Library_net40/Sample_VS2015_FSharp_Library_net40.fsproj @@ -23,7 +23,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2015_FSharp_Library_net40.XML + bin\Debug\Sample_VS2015_FSharp_Library_net40.xml pdbonly @@ -32,7 +32,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2015_FSharp_Library_net40.XML + bin\Release\Sample_VS2015_FSharp_Library_net40.xml diff --git a/tests/projects/Sample_VS2015_FSharp_Library_net45/Sample_VS2015_FSharp_Library_net45.fsproj b/tests/projects/Sample_VS2015_FSharp_Library_net45/Sample_VS2015_FSharp_Library_net45.fsproj index 0462505582..35b040d657 100644 --- a/tests/projects/Sample_VS2015_FSharp_Library_net45/Sample_VS2015_FSharp_Library_net45.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Library_net45/Sample_VS2015_FSharp_Library_net45.fsproj @@ -22,7 +22,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2015_FSharp_Library_net45.XML + bin\Debug\Sample_VS2015_FSharp_Library_net45.xml pdbonly @@ -31,7 +31,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2015_FSharp_Library_net45.XML + bin\Release\Sample_VS2015_FSharp_Library_net45.xml diff --git a/tests/projects/Sample_VS2015_FSharp_Library_net45_fsharp_30/Sample_VS2015_FSharp_Library_net45_fsharp_30.fsproj b/tests/projects/Sample_VS2015_FSharp_Library_net45_fsharp_30/Sample_VS2015_FSharp_Library_net45_fsharp_30.fsproj index 2edb2f5f5e..1f0e38aa21 100644 --- a/tests/projects/Sample_VS2015_FSharp_Library_net45_fsharp_30/Sample_VS2015_FSharp_Library_net45_fsharp_30.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Library_net45_fsharp_30/Sample_VS2015_FSharp_Library_net45_fsharp_30.fsproj @@ -23,7 +23,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2015_FSharp_Library_net45_fsharp_30.XML + bin\Debug\Sample_VS2015_FSharp_Library_net45_fsharp_30.xml pdbonly @@ -32,7 +32,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2015_FSharp_Library_net45_fsharp_30.XML + bin\Release\Sample_VS2015_FSharp_Library_net45_fsharp_30.xml diff --git a/tests/projects/Sample_VS2015_FSharp_Library_net45_fsharp_31/Sample_VS2015_FSharp_Library_net45_fsharp_31.fsproj b/tests/projects/Sample_VS2015_FSharp_Library_net45_fsharp_31/Sample_VS2015_FSharp_Library_net45_fsharp_31.fsproj index 85bc11fd7f..8e384a7829 100644 --- a/tests/projects/Sample_VS2015_FSharp_Library_net45_fsharp_31/Sample_VS2015_FSharp_Library_net45_fsharp_31.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Library_net45_fsharp_31/Sample_VS2015_FSharp_Library_net45_fsharp_31.fsproj @@ -23,7 +23,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2015_FSharp_Library_net45_fsharp_31.XML + bin\Debug\Sample_VS2015_FSharp_Library_net45_fsharp_31.xml pdbonly @@ -32,7 +32,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2015_FSharp_Library_net45_fsharp_31.XML + bin\Release\Sample_VS2015_FSharp_Library_net45_fsharp_31.xml diff --git a/tests/projects/Sample_VS2015_FSharp_Portable259_Library/Sample_VS2015_FSharp_Portable259_Library.fsproj b/tests/projects/Sample_VS2015_FSharp_Portable259_Library/Sample_VS2015_FSharp_Portable259_Library.fsproj index 0224387510..c383bcf6ac 100644 --- a/tests/projects/Sample_VS2015_FSharp_Portable259_Library/Sample_VS2015_FSharp_Portable259_Library.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Portable259_Library/Sample_VS2015_FSharp_Portable259_Library.fsproj @@ -24,7 +24,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2015_FSharp_Portable259_Library.XML + bin\Debug\Sample_VS2015_FSharp_Portable259_Library.xml pdbonly @@ -33,7 +33,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2015_FSharp_Portable259_Library.XML + bin\Release\Sample_VS2015_FSharp_Portable259_Library.xml diff --git a/tests/projects/Sample_VS2015_FSharp_Portable47_Library/Sample_VS2015_FSharp_Portable47_Library.fsproj b/tests/projects/Sample_VS2015_FSharp_Portable47_Library/Sample_VS2015_FSharp_Portable47_Library.fsproj index 26f92396f0..c290448293 100644 --- a/tests/projects/Sample_VS2015_FSharp_Portable47_Library/Sample_VS2015_FSharp_Portable47_Library.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Portable47_Library/Sample_VS2015_FSharp_Portable47_Library.fsproj @@ -23,7 +23,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2015_FSharp_Portable47_Library.XML + bin\Debug\Sample_VS2015_FSharp_Portable47_Library.xml pdbonly @@ -32,7 +32,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2015_FSharp_Portable47_Library.XML + bin\Release\Sample_VS2015_FSharp_Portable47_Library.xml diff --git a/tests/projects/Sample_VS2015_FSharp_Portable78_Library/Sample_VS2015_FSharp_Portable78_Library.fsproj b/tests/projects/Sample_VS2015_FSharp_Portable78_Library/Sample_VS2015_FSharp_Portable78_Library.fsproj index 6646e9dd8d..bcb234c2fb 100644 --- a/tests/projects/Sample_VS2015_FSharp_Portable78_Library/Sample_VS2015_FSharp_Portable78_Library.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Portable78_Library/Sample_VS2015_FSharp_Portable78_Library.fsproj @@ -24,7 +24,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2015_FSharp_Portable78_Library.XML + bin\Debug\Sample_VS2015_FSharp_Portable78_Library.xml pdbonly @@ -33,7 +33,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2015_FSharp_Portable78_Library.XML + bin\Release\Sample_VS2015_FSharp_Portable78_Library.xml diff --git a/tests/projects/Sample_VS2015_FSharp_Portable7_Library/Sample_VS2015_FSharp_Portable7_Library.fsproj b/tests/projects/Sample_VS2015_FSharp_Portable7_Library/Sample_VS2015_FSharp_Portable7_Library.fsproj index 4868cc7dd2..00b4f47c2a 100644 --- a/tests/projects/Sample_VS2015_FSharp_Portable7_Library/Sample_VS2015_FSharp_Portable7_Library.fsproj +++ b/tests/projects/Sample_VS2015_FSharp_Portable7_Library/Sample_VS2015_FSharp_Portable7_Library.fsproj @@ -24,7 +24,7 @@ bin\Debug\ DEBUG;TRACE 3 - bin\Debug\Sample_VS2015_FSharp_Portable7_Library.XML + bin\Debug\Sample_VS2015_FSharp_Portable7_Library.xml pdbonly @@ -33,7 +33,7 @@ bin\Release\ TRACE 3 - bin\Release\Sample_VS2015_FSharp_Portable7_Library.XML + bin\Release\Sample_VS2015_FSharp_Portable7_Library.xml diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index 217b6c1508..a8185dcc93 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -2,6 +2,7 @@ #if INTERACTIVE #r "../../bin/v4.5/FSharp.Compiler.Service.dll" #r "../../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.dll" +#r "../../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.Tool.exe" #r "../../packages/NUnit/lib/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" @@ -17,6 +18,7 @@ open System.IO open System.Collections.Generic open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Service open FSharp.Compiler.Service.Tests.Common // Create an interactive checker instance @@ -674,6 +676,57 @@ let ``Test expressions of declarations stress big expressions`` () = printDeclarations None (List.ofSeq file1.Declarations) |> Seq.toList |> ignore +#if FX_ATLEAST_45 + +[] +let ``Check use of type provider that provides calls to F# code`` () = + let config = +#if DEBUG + ["Configuration", "Debug"] +#else + ["Configuration", "Release"] +#endif + let options = + ProjectCracker.GetProjectOptionsFromProjectFile (Path.Combine(Path.Combine(Path.Combine(__SOURCE_DIRECTORY__, "data"),"TestProject"),"TestProject.fsproj"), config) + + printfn "options = %A" options + + let res = + options + |> checker.ParseAndCheckProject + |> Async.RunSynchronously + + for r in res.Errors do + printfn "%d, %d: %s" r.StartLineAlternate r.StartColumn r.Message + + res.Errors.Length |> shouldEqual 0 + + let results = + [ for f in res.AssemblyContents.ImplementationFiles do + for d in f.Declarations do + for line in d |> printDeclaration None do + yield line ] + results |> shouldEqual + ["type TestProject"; "type AssemblyInfo"; "type TestProject"; "type T"; + """type Class1"""; + """member .ctor(unitVar0) = (Object..ctor (); ()) @ (5,5--5,11)"""; + """member get_X1(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothing () @ (6,21--6,36)"""; + """member get_X2(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingGeneric (3) @ (7,21--7,43)"""; + """member get_X3(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in Helper.doNothingOneArg (3) @ (8,21--8,42)"""; + """member get_X4(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothing () @ (9,21--9,41)"""; + """member get_X5(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingGeneric (3) @ (10,21--10,48)"""; + """member get_X6(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingOneArg (3) @ (11,21--11,47)"""; + """member get_X7(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in C.DoNothingTwoArg (new C(),3) @ (12,21--12,47)"""; + """member get_X8(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothing() @ (13,21--13,49)"""; + """member get_X9(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingGeneric(3) @ (14,21--14,56)"""; + """member get_X10(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingOneArg(3) @ (15,22--15,56)"""; + """member get_X11(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in new C().InstanceDoNothingTwoArg(new C(),3) @ (16,22--16,56)"""; + """member get_X12(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothing () @ (17,22--17,49)"""; + """member get_X13(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothingOneArg (3) @ (18,22--18,55)"""; + """member get_X14(this) (unitVar1) = let this: Microsoft.FSharp.Core.obj = ("My internal state" :> Microsoft.FSharp.Core.obj) :> ErasedWithConstructor.Provided.MyType in G`1.DoNothingTwoArg (new C(),3) @ (19,22--19,55)"""] + +#endif + #if SELF_HOST_STRESS [] @@ -699,7 +752,7 @@ let ``Test Declarations selfhost whole compiler`` () = let projectFile = __SOURCE_DIRECTORY__ + @"/../../src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj" //let v = FSharpProjectFileInfo.Parse(projectFile, [("Configuration", "Debug"); ("NoFsSrGenTask", "true")],enableLogging=true) - let options = checker.GetProjectOptionsFromProjectFile(projectFile, [("Configuration", "Debug"); ("NoFsSrGenTask", "true")]) + let options = ProjectCracker.GetProjectOptionsFromProjectFile(projectFile, [("Configuration", "Debug"); ("NoFsSrGenTask", "true")]) // For subsets of the compiler: //let options = { options with OtherOptions = options.OtherOptions.[0..51] } diff --git a/tests/service/FSharp.Compiler.Service.Tests.fsproj b/tests/service/FSharp.Compiler.Service.Tests.fsproj index f55216f86c..f57233d904 100644 --- a/tests/service/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/service/FSharp.Compiler.Service.Tests.fsproj @@ -86,6 +86,11 @@ + + FSharp.Compiler.Service.ProjectCracker.Tool + {b1bdd96d-47e1-4e65-8107-fbae23a06db4} + True + FSharp.Compiler.Service.ProjectCracker {893c3cd9-5af8-4027-a667-21e62fc2c703} diff --git a/tests/service/MultiProjectAnalysisTests.fs b/tests/service/MultiProjectAnalysisTests.fs index 676f70a4b9..771b240646 100644 --- a/tests/service/MultiProjectAnalysisTests.fs +++ b/tests/service/MultiProjectAnalysisTests.fs @@ -20,7 +20,6 @@ open System open System.Collections.Generic open Microsoft.FSharp.Compiler.SourceCodeServices open FSharp.Compiler.Service.Tests.Common -open FSharp.Compiler.Service let numProjectsForStressTest = 100 let checker = FSharpChecker.Create(projectCacheSize=numProjectsForStressTest + 10) diff --git a/tests/service/ProjectOptionsTests.fs b/tests/service/ProjectOptionsTests.fs index 5973243ad5..94b69de513 100644 --- a/tests/service/ProjectOptionsTests.fs +++ b/tests/service/ProjectOptionsTests.fs @@ -1,5 +1,7 @@ #if INTERACTIVE #r "../../bin/v4.5/FSharp.Compiler.Service.dll" +#r "../../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.dll" +#r "../../bin/v4.5/FSharp.Compiler.Service.ProjectCracker.Tool.exe" #r "../../packages/NUnit/lib/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" @@ -14,7 +16,6 @@ open System.IO open NUnit.Framework open FsUnit open Microsoft.FSharp.Compiler.SourceCodeServices -open FSharp.Compiler.Service open FSharp.Compiler.Service.Tests.Common @@ -34,6 +35,7 @@ let checkOptionNotPresent (opts:string[]) s = |> shouldEqual notFound let getReferencedFilenames = Array.choose (fun (o:string) -> if o.StartsWith("-r:") then o.[3..] |> (Path.GetFileName >> Some) else None) +let getReferencedFilenamesAndContainingFolders = Array.choose (fun (o:string) -> if o.StartsWith("-r:") then o.[3..] |> (fun r -> ((r |> Path.GetFileName), (r |> Path.GetDirectoryName |> Path.GetFileName)) |> Some) else None) let getOutputFile = Array.pick (fun (o:string) -> if o.StartsWith("--out:") then o.[6..] |> Some else None) let getCompiledFilenames = Array.choose (fun (o:string) -> if o.EndsWith(".fs") then o |> (Path.GetFileName >> Some) else None) @@ -377,5 +379,25 @@ let ``Project file parsing -- Exe with a PCL reference``() = references |> should contain "mscorlib.dll" references |> should contain "System.Reflection.dll" references |> should contain "System.Reflection.Emit.Lightweight.dll" + + +[] +let ``Project file parsing -- project file contains project reference to out-of-solution project and is used in release mode``() = + + let f = normalizePath(__SOURCE_DIRECTORY__ + @"/data/TestProject/TestProject.fsproj") + let p = ProjectCracker.GetProjectOptionsFromProjectFile(f,[("Configuration","Release")]) + let references = getReferencedFilenamesAndContainingFolders p.OtherOptions |> set + // Check the reference is to a release DLL + references |> should contain ("TestTP.dll", "Release") + +[] +let ``Project file parsing -- project file contains project reference to out-of-solution project and is used in debug mode``() = + + let f = normalizePath(__SOURCE_DIRECTORY__ + @"/data/TestProject/TestProject.fsproj") + let p = ProjectCracker.GetProjectOptionsFromProjectFile(f,[("Configuration","Debug")]) + let references = getReferencedFilenamesAndContainingFolders p.OtherOptions |> set + // Check the reference is to a debug DLL + references |> should contain ("TestTP.dll", "Debug") + #endif diff --git a/tests/service/data/DifferingOutputDir/Dir1/Test1.fsproj b/tests/service/data/DifferingOutputDir/Dir1/Test1.fsproj index 13ab88be83..39c51e68b2 100644 --- a/tests/service/data/DifferingOutputDir/Dir1/Test1.fsproj +++ b/tests/service/data/DifferingOutputDir/Dir1/Test1.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 x86 - bin\Debug\Test1.XML + bin\Debug\Test1.xml pdbonly @@ -33,7 +33,7 @@ TRACE 3 x86 - bin\Release\Test1.XML + bin\Release\Test1.xml False diff --git a/tests/service/data/DifferingOutputDir/Dir2/Test2.fsproj b/tests/service/data/DifferingOutputDir/Dir2/Test2.fsproj index 4cfc70bbc7..ccc20f3fa8 100644 --- a/tests/service/data/DifferingOutputDir/Dir2/Test2.fsproj +++ b/tests/service/data/DifferingOutputDir/Dir2/Test2.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 x86 - bin\Debug\Test2.XML + bin\Debug\Test2.xml pdbonly @@ -33,7 +33,7 @@ TRACE 3 x86 - bin\Release\Test2.XML + bin\Release\Test2.xml False diff --git a/tests/service/data/MultiLanguageProject/ConsoleApplication1.fsproj b/tests/service/data/MultiLanguageProject/ConsoleApplication1.fsproj index 391e425ec6..fdc032e298 100644 --- a/tests/service/data/MultiLanguageProject/ConsoleApplication1.fsproj +++ b/tests/service/data/MultiLanguageProject/ConsoleApplication1.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\ConsoleApplication1.XML + bin\Debug\ConsoleApplication1.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\ConsoleApplication1.XML + bin\Release\ConsoleApplication1.xml true diff --git a/tests/service/data/MultiLanguageProject/ConsoleApplication2.fsproj b/tests/service/data/MultiLanguageProject/ConsoleApplication2.fsproj index 3d3ac3ec2a..84477a24db 100644 --- a/tests/service/data/MultiLanguageProject/ConsoleApplication2.fsproj +++ b/tests/service/data/MultiLanguageProject/ConsoleApplication2.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\ConsoleApplication2.XML + bin\Debug\ConsoleApplication2.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\ConsoleApplication2.XML + bin\Release\ConsoleApplication2.xml true diff --git a/tests/service/data/Test1.fsproj b/tests/service/data/Test1.fsproj index 0b7e8dd1bd..352940e792 100644 --- a/tests/service/data/Test1.fsproj +++ b/tests/service/data/Test1.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 x86 - bin\Debug\Test1.XML + bin\Debug\Test1.xml pdbonly @@ -33,7 +33,7 @@ TRACE 3 x86 - bin\Release\Test1.XML + bin\Release\Test1.xml False diff --git a/tests/service/data/Test2.fsproj b/tests/service/data/Test2.fsproj index 817bf6dba7..92283019b0 100644 --- a/tests/service/data/Test2.fsproj +++ b/tests/service/data/Test2.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 x86 - bin\Debug\Test2.XML + bin\Debug\Test2.xml pdbonly @@ -33,7 +33,7 @@ TRACE 3 x86 - bin\Release\Test2.XML + bin\Release\Test2.xml False diff --git a/tests/service/data/TestProject/AssemblyInfo.fs b/tests/service/data/TestProject/AssemblyInfo.fs new file mode 100644 index 0000000000..5c62ae5770 --- /dev/null +++ b/tests/service/data/TestProject/AssemblyInfo.fs @@ -0,0 +1,41 @@ +namespace TestProject.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/TestProject/Library.fs b/tests/service/data/TestProject/Library.fs new file mode 100644 index 0000000000..5983364772 --- /dev/null +++ b/tests/service/data/TestProject/Library.fs @@ -0,0 +1,22 @@ +namespace TestProject + +type T = ErasedWithConstructor.Provided.MyType + +type Class1() = + member this.X1 = T().DoNothing() + member this.X2 = T().DoNothingGeneric() + member this.X3 = T().DoNothingOneArg() + member this.X4 = T().ClassDoNothing() + member this.X5 = T().ClassDoNothingGeneric() + member this.X6 = T().ClassDoNothingOneArg() + member this.X7 = T().ClassDoNothingTwoArg() + member this.X8 = T().ClassInstanceDoNothing() + member this.X9 = T().ClassInstanceDoNothingGeneric() + member this.X10 = T().ClassInstanceDoNothingOneArg() + member this.X11 = T().ClassInstanceDoNothingTwoArg() + member this.X12 = T().GenericClassDoNothing() + member this.X13 = T().GenericClassDoNothingOneArg() + member this.X14 = T().GenericClassDoNothingTwoArg() + + + diff --git a/tests/service/data/TestProject/TestProject.fsproj b/tests/service/data/TestProject/TestProject.fsproj new file mode 100644 index 0000000000..c4697f8c5a --- /dev/null +++ b/tests/service/data/TestProject/TestProject.fsproj @@ -0,0 +1,79 @@ + + + + + Debug + AnyCPU + 2.0 + ed64425e-b549-439a-b105-6c921a81f31a + Library + TestProject + TestProject + v4.5 + 4.3.0.0 + 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 + + + + + True + + + + + + + + + + + + TestTP + {ff76bd3c-5e0a-4752-b6c3-044f6e15719b} + True + + + + 11 + + + + + $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets + + + + + $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets + + + + + + \ No newline at end of file diff --git a/tests/service/data/TestTP/Library.fs b/tests/service/data/TestTP/Library.fs new file mode 100644 index 0000000000..7530913eb4 --- /dev/null +++ b/tests/service/data/TestTP/Library.fs @@ -0,0 +1,136 @@ +namespace TestTP + +open ProviderImplementation.ProvidedTypes +open Microsoft.FSharp.Core.CompilerServices +open System.Reflection + +module Helper = + let doNothing() = () + let doNothingOneArg(x:int) = () + let doNothingGeneric(x:'T) = () + type C() = + static member DoNothing() = () + static member DoNothingOneArg(x:int) = () + static member DoNothingTwoArg(c:C, x:int) = () + static member DoNothingGeneric(x:'T) = () + member __.InstanceDoNothing() = () + member __.InstanceDoNothingOneArg(x:int) = () + member __.InstanceDoNothingTwoArg(c:C, x:int) = () + member __.InstanceDoNothingGeneric(x:'T) = () + + type G<'U>() = + static member DoNothing() = () + static member DoNothingOneArg(x:int) = () + static member DoNothingTwoArg(c:C, x:int) = () + static member DoNothingGeneric(x:'T) = () + member __.InstanceDoNothing() = () + member __.InstanceDoNothingOneArg(x:int) = () + member __.InstanceDoNothingTwoArg(c:C, x:int) = () + member __.InstanceDoNothingGeneric(x:'U) = () + +[] +type BasicProvider (config : TypeProviderConfig) as this = + inherit TypeProviderForNamespaces () + + let ns = "ErasedWithConstructor.Provided" + let asm = Assembly.GetExecutingAssembly() + + let createTypes () = + let myType = ProvidedTypeDefinition(asm, ns, "MyType", Some typeof) + + 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 @@>) + myType.AddMember(ctor2) + + let innerState = ProvidedProperty("InnerState", typeof, + GetterCode = fun args -> <@@ (%%(args.[0]) :> obj) :?> string @@>) + myType.AddMember(innerState) + + let someMethod = ProvidedMethod("DoNothing", [], typeof, + InvokeCode = fun args -> <@@ Helper.doNothing() @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("DoNothingOneArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.doNothingOneArg(3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("DoNothingGeneric", [], typeof, + InvokeCode = fun args -> <@@ Helper.doNothingGeneric(3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassDoNothing", [], typeof, + InvokeCode = fun args -> <@@ Helper.C.DoNothing() @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassDoNothingGeneric", [], typeof, + InvokeCode = fun args -> <@@ Helper.C.DoNothingGeneric(3) @@>) + + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassDoNothingOneArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.C.DoNothingOneArg(3) @@>) + + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassDoNothingTwoArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.C.DoNothingTwoArg(Helper.C(), 3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassInstanceDoNothing", [], typeof, + InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothing() @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassInstanceDoNothingGeneric", [], typeof, + InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingGeneric(3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassInstanceDoNothingOneArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingOneArg(3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("ClassInstanceDoNothingTwoArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.C().InstanceDoNothingTwoArg(Helper.C(), 3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("GenericClassDoNothing", [], typeof, + InvokeCode = fun args -> <@@ Helper.G.DoNothing() @@>) + myType.AddMember(someMethod) + + // These do not seem to compile correctly when used in provided expressions: + //Helper.G.DoNothingGeneric(3) + + // These do not seem to compile correctly when used in provided expressions: + //Helper.G().InstanceDoNothingGeneric(3) + + let someMethod = ProvidedMethod("GenericClassDoNothingOneArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.G.DoNothingOneArg(3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("GenericClassDoNothingTwoArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.G.DoNothingTwoArg(Helper.C(), 3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("GenericClassInstanceDoNothing", [], typeof, + InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothing() @@>) + myType.AddMember(someMethod) + + + let someMethod = ProvidedMethod("GenericClassInstanceDoNothingOneArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothingOneArg(3) @@>) + myType.AddMember(someMethod) + + let someMethod = ProvidedMethod("GenericClassInstanceDoNothingTwoArg", [], typeof, + InvokeCode = fun args -> <@@ Helper.G().InstanceDoNothingTwoArg(Helper.C(), 3) @@>) + myType.AddMember(someMethod) + + [myType] + + do + this.AddNamespace(ns, createTypes()) + +[] +do () \ No newline at end of file diff --git a/tests/service/data/TestTP/ProvidedTypes.fs b/tests/service/data/TestTP/ProvidedTypes.fs new file mode 100644 index 0000000000..5cf2954749 --- /dev/null +++ b/tests/service/data/TestTP/ProvidedTypes.fs @@ -0,0 +1,2736 @@ +#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 + +namespace ProviderImplementation.ProvidedTypes + +open System +open System.Text +open System.IO +open System.Reflection +open System.Reflection.Emit +open System.Linq.Expressions +open System.Collections.Generic +open Microsoft.FSharp.Core.CompilerServices + +type E = Quotations.Expr +module P = Quotations.Patterns +module ES = Quotations.ExprShape +module DP = Quotations.DerivedPatterns + +type internal ExpectedStackState = + | Empty = 1 + | Address = 2 + | Value = 3 + +[] +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 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 [| |] } + + /// 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 mkXmlDocCustomAttributeData(s:string) = mkXmlDocCustomAttributeDataLazy (lazy s) + + 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 [| |] } + + 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 + + // 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 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 @@> + + // 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 -> + + // 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 + + // 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 + + // 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 + + 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.nth (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 + + transExpr isGenerated expr + + 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 + +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 + + member __.DeclaringTypeImpl + with set x = + if declaringType<>null then failwith (sprintf "ProvidedConstructor: declaringType already set on '%s'" (nameText())); + declaringType <- x + + 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())) + + 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())) + + 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 + + // 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 + + 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) + + 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)) + + + /// 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 + + member __.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice + + member __.IsStatic + with get() = isStatic + and set x = isStatic <- x + + 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" + + 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" + + // 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 + + member __.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice + member __.IsStatic + with get() = isStatic + and set x = isStatic <- x + + 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" + + 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" + + // 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 + + member __.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice + + + // 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 + + member __.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice + + 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 + +/// 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[]) + + +/// 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] + | _ -> 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 + | _ -> failwith "unreachable" + + override __.IsAssignableFrom(otherTy) = + 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 + | _ -> 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.IsGenericMethod = + (if this.DeclaringType.IsGenericType then this.DeclaringType.GetGenericArguments().Length else 0) < parameters.Length + + override this.GetGenericArguments() = + Seq.skip (if this.DeclaringType.IsGenericType then this.DeclaringType.GetGenericArguments().Length else 0) parameters |> Seq.toArray + + override __.GetGenericMethodDefinition() = genericMethodDefinition + + 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 + + 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 + + + +type ProvidedTypeBuilder() = + static member MakeGenericType(genericTypeDefinition, genericArguments) = ProvidedSymbolType(Generic genericTypeDefinition, genericArguments) :> Type + static member MakeGenericMethod(genericMethodDefinition, genericArguments) = ProvidedSymbolMethod(genericMethodDefinition, genericArguments) :> MethodInfo + +[] +type 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 + 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 + + 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) + + // 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) + + member __.AnnotateType (basicType, annotation) = ProvidedSymbolType(Generic basicType, annotation) :> Type + + + +[] +type TypeContainer = + | Namespace of Assembly * string // namespace + | Type of System.Type + | TypeToBeDecided + +module GlobalProvidedAssemblyElementsTable = + let theTable = Dictionary>() + +type ProvidedTypeDefinition(container:TypeContainer,className : string, baseType : Type option) as this = + inherit Type() + + do match container, !ProvidedTypeDefinition.Logger with + | TypeContainer.Namespace _, Some logger -> logger (sprintf "Creating ProvidedTypeDefinition %s [%d]" className (System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode this)) + | _ -> () + + // state + let mutable attributes = + TypeAttributes.Public ||| + TypeAttributes.Class ||| + TypeAttributes.Sealed ||| + enum (int32 TypeProviderTypeAttributes.IsErased) + + + 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() + + // 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() + + // 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() + + 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) + + 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) + + 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 + | _ -> () + + 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 + + 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 __.UnderlyingSystemType = typeof + + member __.SetEnumUnderlyingType(ty) = enumUnderlyingType <- ty + + override __.GetEnumUnderlyingType() = if this.IsEnum then enumUnderlyingType else invalidOp "not enum type" + + member __.SetBaseType t = baseType <- lazy Some t + + member __.SetBaseTypeDelayed baseTypeFunction = baseType <- lazy (Some (baseTypeFunction())) + + member __.SetAttributes x = attributes <- x + + // Add MemberInfos + member __.AddMembersDelayed(membersFunction : unit -> list<#MemberInfo>) = + membersQueue.Add (fun () -> membersFunction() |> List.map (fun x -> patchUpAddedMemberInfo this x; x :> MemberInfo )) + + 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)) + + member __.AddMember(memberInfo:MemberInfo) = + this.AddMembers [memberInfo] + + member __.AddMemberDelayed(memberFunction : unit -> #MemberInfo) = + this.AddMembersDelayed(fun () -> [memberFunction()]) + + 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 + | _ -> () ] + + // 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 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) + + /// 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 + + else + failwith (sprintf "ProvidedTypeDefinition: static parameters supplied but not expected for %s" (fullName.Force())) + + 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 + + // Implement overloads + override __.Assembly = theAssembly.Force() + + member __.SetAssembly assembly = theAssembly <- lazy assembly + + member __.SetAssemblyLazy assembly = theAssembly <- assembly + + override __.FullName = fullName.Force() + + override __.Namespace = rootNamespace.Force() + + 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 + // 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" + | t when t.IsGenericType && not t.IsGenericTypeDefinition -> + let genericTypeDefinition = t.GetGenericTypeDefinition() + 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) + + // 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 + + + 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) +#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 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 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 + | 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) ] + + 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 + + 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_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 + 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) + | _ -> () + + | 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 +#else + | :? System.Enum as x when x.GetType().GetEnumUnderlyingType() = typeof -> ilg.Emit(OpCodes.Ldc_I4, unbox v) +#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) + + 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 + + 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 ])) + + + // phase 4 - complete types + iterateTypes (fun tb _ptd -> tb.CreateType() |> ignore) + +#if FX_NO_LOCAL_FILESYSTEM +#else + assembly.Save (Path.GetFileName assemblyFileName) +#endif + + let assemblyLoadedInMemory = assemblyMainModule.Assembly + + iterateTypes (fun _tb ptd -> + match ptd with + | None -> () + | Some ptd -> ptd.SetAssembly assemblyLoadedInMemory) + +#if FX_NO_LOCAL_FILESYSTEM +#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 +#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 +#else + let theAssemblyBytesLazy = + lazy + assemblyGenerator.GetFinalBytes() + + do + GlobalProvidedAssemblyElementsTable.theTable.Add(assemblyGenerator.Assembly, theAssemblyBytesLazy) + +#endif + + 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 + + member x.AddNestedTypes (providedTypeDefinitions, enclosingTypeNames) = add (providedTypeDefinitions, Some enclosingTypeNames) + member x.AddTypes (providedTypeDefinitions) = add (providedTypeDefinitions, None) +#if FX_NO_LOCAL_FILESYSTEM +#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 +#endif + + +module Local = + + 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 + } + + +#if FX_NO_LOCAL_FILESYSTEM +type TypeProviderForNamespaces(namespacesAndTypes : list<(string * list)>) = +#else +type TypeProviderForNamespaces(namespacesAndTypes : list<(string * list)>) as this = +#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 invalidateE = new Event() + + let disposing = Event() + +#if FX_NO_LOCAL_FILESYSTEM +#else + 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([]) + + [] + member __.Disposing = disposing.Publish + +#if FX_NO_LOCAL_FILESYSTEM + interface System.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) + + // FSharp.Data addition: this method is used by Debug.fs + member __.Namespaces = Seq.readonly otherNamespaces + + member this.Invalidate() = invalidateE.Trigger(this,EventArgs()) + + member __.GetStaticParametersForMethod(mb: MethodBase) = + printfn "In GetStaticParametersForMethod" + match mb with + | :? ProvidedMethod as t -> t.GetStaticParameters() + | _ -> [| |] + + 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) + + interface ITypeProvider with + + [] + 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) + 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<_> + + +#endif + override __.GetStaticParameters(ty) = + match ty with + | :? ProvidedTypeDefinition as t -> + if ty.Name = t.Name (* REVIEW: use equality? *) then + t.GetStaticParameters() + 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) + +#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" +#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 +#endif diff --git a/tests/service/data/TestTP/ProvidedTypes.fsi b/tests/service/data/TestTP/ProvidedTypes.fsi new file mode 100644 index 0000000000..3eb5025f6d --- /dev/null +++ b/tests/service/data/TestTP/ProvidedTypes.fsi @@ -0,0 +1,467 @@ +// 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 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.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 + +/// Represents a provided static parameter. +type ProvidedStaticParameter = + inherit ParameterInfo + new : parameterName: string * parameterType:Type * ?parameterDefaultValue:obj -> ProvidedStaticParameter + + /// Add XML documentation information to this provided constructor + 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 + +/// Represents an erased provided constructor. +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 + + /// 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 + + /// 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 + + /// FSharp.Data addition: this method is used by Debug.fs + member internal GetInvokeCodeInternal : bool -> (Quotations.Expr [] -> Quotations.Expr) + + /// 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 + + /// 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 + + /// Add definition location information to the provided constructor. + member AddDefinitionLocation : line:int * column:int * filePath:string -> unit + + member IsTypeInitializer : bool with get,set + +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 + + /// Add XML documentation information to this provided method + member AddObsoleteAttribute : message: string * ?isError: bool -> unit + + /// Add XML documentation information to this provided constructor + 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 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 + + /// 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 + + /// 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) + + /// Add definition location information to the provided type definition. + member AddDefinitionLocation : line:int * column:int * filePath:string -> unit + + /// Add a custom attribute to the provided method definition. + member AddCustomAttribute : CustomAttributeData -> unit + + /// Define the static parameters available on a statically parameterized method + member DefineStaticParameters : parameters: ProvidedStaticParameter list * instantiationFunction: (string -> obj[] -> ProvidedMethod) -> unit + +/// 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 + + /// Add a 'System.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 + + /// 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 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 + + /// Set the function used to compute the implementation of sets of this property. + member SetterCode : (Quotations.Expr list -> Quotations.Expr) with set + + /// Add definition location information to the provided type definition. + member AddDefinitionLocation : line:int * column:int * filePath:string -> unit + + /// Add a custom attribute to the provided property definition. + 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 + + /// Add XML documentation information to this provided constructor + 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 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 + + /// Set the function used to compute the implementation of sets of this property. + member RemoverCode : (Quotations.Expr list -> Quotations.Expr) with set + + /// Add definition location information to the provided type definition. + member AddDefinitionLocation : line:int * column:int * filePath:string -> unit + +/// Represents an erased provided field. +type ProvidedLiteralField = + 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 + + /// Add a 'System.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 + + /// 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 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 + + /// Add a 'System.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 + + /// 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 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[]) + +/// 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 + + /// Return the provided types used as arguments of this symbolic type + member Args : list + + +/// Helpers to build symbolic provided types +[] +type ProvidedTypeBuilder = + + /// Like typ.MakeGenericType, but will also work with unit-annotated types + static member MakeGenericType: genericTypeDefinition: Type * genericArguments: Type list -> Type + + /// Like methodInfo.MakeGenericMethod, but will also work with unit-annotated types and provided types + static member MakeGenericMethod: genericMethodDefinition: MethodInfo * genericArguments: Type list -> MethodInfo + +/// 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 + + /// Returns the measure indicating the product of two units of measure, e.g. kg * m + member Product : measure1: Type * measure1: Type -> Type + + /// Returns the measure indicating the inverse of two units of measure, e.g. 1 / s + 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 + + /// Returns the measure indicating the square of a unit of measure, e.g. m * m + 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 + + /// 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 + + +/// Represents a provided type definition. +type ProvidedTypeDefinition = + inherit Type + + /// Create a new provided type definition in a namespace. + new : assembly: Assembly * namespaceName: string * className: string * baseType: Type option -> 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 + + /// Add the given type as an implemented interface. + member AddInterfaceImplementation : interfaceType: Type -> unit + + /// Add the given function as a set of on-demand computed interfaces. + 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 + + /// Add a 'System.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 + + /// Set the base type + 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 + + /// Set underlying type for generated enums + 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 + + /// 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 + + /// 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 + + /// Add a method, property, nested type or other member to a ProvidedTypeDefinition + member AddMember : memberInfo:MemberInfo -> unit + + /// Add a set of members to a ProvidedTypeDefinition + 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 + + /// 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 + + /// 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 + + /// Define the static parameters available on a statically parameterized type + 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 + + /// Suppress System.Object entries in intellisense menus in instances of this provided type + member HideObjectMethods : bool with set + + /// Disallows the use of the null literal. + member NonNullable : bool with set + + /// Get or set a flag indicating if the ProvidedTypeDefinition is erased + member IsErased : bool with get,set + + /// Get or set a flag indicating if the ProvidedTypeDefinition has type-relocation suppressed + [] + member SuppressRelocation : bool with get,set + + /// FSharp.Data addition: this method is used by Debug.fs + member MakeParametricType : name:string * args:obj[] -> ProvidedTypeDefinition + + /// Add a custom attribute to the provided type definition. + member AddCustomAttribute : CustomAttributeData -> unit + + /// 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 + + /// 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 + +/// A provided generated assembly +type ProvidedAssembly = + /// Create a provided generated assembly + new : assemblyFileName:string -> ProvidedAssembly + + /// 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 + + /// + /// 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 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 + +#if FX_NO_LOCAL_FILESYSTEM +#else + /// Register that a given file is a provided generated assembly + static member RegisterGenerated : fileName:string -> Assembly +#endif + + +/// A base type providing default implementations of type provider functionality when all provided +/// types are of type ProvidedTypeDefinition. +type TypeProviderForNamespaces = + + /// Initializes a type provider to provide the types in the given namespace. + new : namespaceName:string * types: ProvidedTypeDefinition list -> TypeProviderForNamespaces + + /// Initializes a type provider + new : unit -> 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 + + /// Invoked by the type provider to get all provided namespaces with their provided types. + member Namespaces : seq + + /// Invoked by the type provider to invalidate the information provided by the provider + member Invalidate : unit -> unit + + /// Invoked by the host of the type provider to get the static parameters for a method. + 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 + +#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 + + /// Registers custom probing path that can be used for probing assemblies + member RegisterProbingFolder : folder: string -> unit + + /// Registers location of RuntimeAssembly (from TypeProviderConfig) as probing folder + member RegisterRuntimeAssemblyLocationAsProbingFolder : config: TypeProviderConfig -> unit + +#endif + + [] + member Disposing : IEvent + + interface ITypeProvider diff --git a/tests/service/data/TestTP/TestTP.fsproj b/tests/service/data/TestTP/TestTP.fsproj new file mode 100644 index 0000000000..1f2b216503 --- /dev/null +++ b/tests/service/data/TestTP/TestTP.fsproj @@ -0,0 +1,78 @@ + + + + + Debug + AnyCPU + 2.0 + ff76bd3c-5e0a-4752-b6c3-044f6e15719b + Library + TestTP + TestTP + v4.5 + true + 4.3.0.0 + TestTP + + + + true + full + false + false + bin\Debug\ + DEBUG;TRACE + 3 + AnyCPU + bin\Debug\TestTP.xml + true + + + pdbonly + true + true + bin\Release\ + TRACE + 3 + AnyCPU + bin\Release\TestTP.xml + true + + + 11 + + + + + $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets + + + + + $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets + + + + + + + + + + + + + True + + + + + + + \ No newline at end of file diff --git a/tests/service/data/TestTP/bin/Debug/TestTP.dll b/tests/service/data/TestTP/bin/Debug/TestTP.dll new file mode 100644 index 0000000000..757d55b47d Binary files /dev/null and b/tests/service/data/TestTP/bin/Debug/TestTP.dll differ diff --git a/tests/service/data/TestTP/bin/Release/TestTP.dll b/tests/service/data/TestTP/bin/Release/TestTP.dll new file mode 100644 index 0000000000..50a36a6805 Binary files /dev/null and b/tests/service/data/TestTP/bin/Release/TestTP.dll differ diff --git a/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj b/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj index bbadae52c5..0aafd35458 100644 --- a/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj +++ b/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj @@ -23,7 +23,7 @@ DEBUG;TRACE 3 AnyCPU - bin\Debug\TypeProviderConsole.XML + bin\Debug\TypeProviderConsole.xml true @@ -34,7 +34,7 @@ TRACE 3 AnyCPU - bin\Release\TypeProviderConsole.XML + bin\Release\TypeProviderConsole.xml true diff --git a/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj b/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj index 336560aacf..72e19ebb24 100644 --- a/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj +++ b/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj @@ -21,7 +21,7 @@ .\ DEBUG;TRACE 3 - bin\Debug\TypeProviderLibrary.XML + bin\Debug\TypeProviderLibrary.xml pdbonly @@ -30,7 +30,7 @@ .\ TRACE 3 - bin\Release\TypeProviderLibrary.XML + bin\Release\TypeProviderLibrary.xml