Revert the usage of the TP SDK. We need real C# types...

...to be embedded into the F# assembly - not mirrored types

Re https://github.com/xamarin/xamarin-android/issues/1513
and https://github.com/mono/monodevelop/issues/4456

Bump to 1.0.0.22

We also need code such as the following adding to the NUnit template and
possibly others.

```fs
namespace fsandroidnunit
// the name of the type here needs to match the name inside the ResourceDesigner attribute
type Resources = fsandroidnunit.Resource
[<assembly: Android.Runtime.ResourceDesigner("fsandroidnunit.Resources", IsApplication=true)>]
()
```
This commit is contained in:
nosami 2018-04-06 16:09:34 +01:00
Родитель cbd66c10b9
Коммит d673111b8c
15 изменённых файлов: 87 добавлений и 15951 удалений

Двоичные данные
.paket/paket.exe

Двоичный файл не отображается.

Просмотреть файл

@ -8,7 +8,7 @@ open System.Reflection
// The assembly version has the format {Major}.{Minor}.{Build}.{Revision}
[<assembly: AssemblyVersion("1.0.0.21")>]
[<assembly: AssemblyVersion("1.0.0.22")>]
//[<assembly: AssemblyDelaySign(false)>]
//[<assembly: AssemblyKeyFile("")>]

Просмотреть файл

@ -1,680 +0,0 @@
// --------------------------------------------------------------------------------------
// Helpers for writing type providers
// ----------------------------------------------------------------------------------------------
namespace ProviderImplementation.ProvidedTypesTesting
open System
open System.Collections.Generic
open System.Reflection
open System.IO
open System.Text
open Microsoft.FSharp.Core.CompilerServices
open Microsoft.FSharp.Core.Printf
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Reflection
open ProviderImplementation.ProvidedTypes
/// Simulate a real host of TypeProviderConfig
type internal DllInfo(path: string) =
member x.FileName = path
/// Simulate a real host of TypeProviderConfig
type internal TcImports(bas: TcImports option, dllInfos: DllInfo list) =
member x.Base = bas
member x.DllInfos = dllInfos
type internal Testing() =
/// Simulates a real instance of TypeProviderConfig
static member MakeSimulatedTypeProviderConfig (resolutionFolder: string, runtimeAssembly: string, runtimeAssemblyRefs: string list) =
let cfg = new TypeProviderConfig(fun _ -> false)
let (?<-) cfg prop value =
let ty = cfg.GetType()
match ty.GetProperty(prop,BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic) with
| null -> ty.GetField(prop,BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic).SetValue(cfg, value)|> ignore
| p -> p.GetSetMethod(nonPublic = true).Invoke(cfg, [| box value |]) |> ignore
cfg?ResolutionFolder <- resolutionFolder
cfg?RuntimeAssembly <- runtimeAssembly
cfg?ReferencedAssemblies <- Array.zeroCreate<string> 0
// Fake an implementation of SystemRuntimeContainsType the shape expected by AssemblyResolver.fs.
let dllInfos = [yield DllInfo(runtimeAssembly); for r in runtimeAssemblyRefs do yield DllInfo(r)]
let tcImports = TcImports(Some(TcImports(None,[])),dllInfos)
let systemRuntimeContainsType = (fun (_s:string) -> if tcImports.DllInfos.Length = 1 then true else true)
cfg?systemRuntimeContainsType <- systemRuntimeContainsType
//Diagnostics.Debugger.Launch() |> ignore
Diagnostics.Debug.Assert(cfg.GetType().GetField("systemRuntimeContainsType",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) <> null)
Diagnostics.Debug.Assert(systemRuntimeContainsType.GetType().GetField("tcImports",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) <> null)
Diagnostics.Debug.Assert(typeof<TcImports>.GetField("dllInfos",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) <> null)
Diagnostics.Debug.Assert(typeof<TcImports>.GetProperty("Base",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) <> null)
Diagnostics.Debug.Assert(typeof<DllInfo>.GetProperty("FileName",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) <> null)
cfg
/// Simulates a real instance of TypeProviderConfig and then creates an instance of the last
/// type provider added to a namespace by the type provider constructor
static member GenerateProvidedTypeInstantiation (resolutionFolder: string, runtimeAssembly: string, runtimeAssemblyRefs: string list, typeProviderForNamespacesConstructor, args) =
let cfg = Testing.MakeSimulatedTypeProviderConfig (resolutionFolder, runtimeAssembly, runtimeAssemblyRefs)
let typeProviderForNamespaces = typeProviderForNamespacesConstructor cfg :> TypeProviderForNamespaces
let providedTypeDefinition = typeProviderForNamespaces.Namespaces |> Seq.last |> snd |> Seq.last
match args with
| [||] -> providedTypeDefinition
| args ->
let typeName =
if providedTypeDefinition.IsErased then
providedTypeDefinition.Name + (args |> Seq.map (fun s -> ",\"" + (if s = null then "" else s.ToString()) + "\"") |> Seq.reduce (+))
else
// The type name ends up quite mangled in the dll output if we combine the name using static parameters, so for generated types we don't do that
providedTypeDefinition.Name
providedTypeDefinition.MakeParametricType(typeName, args)
/// Returns a string representation of the signature (and optionally also the body) of all the
/// types generated by the type provider up to a certain depth and width
/// If ignoreOutput is true, this will still visit the full graph, but it will output an empty string to be faster
static member FormatProvidedType (t: ProvidedTypeDefinition, ?signatureOnly, ?ignoreOutput, ?maxDepth, ?maxWidth, ?useQualifiedNames) =
let signatureOnly = defaultArg signatureOnly false
let ignoreOutput = defaultArg ignoreOutput false
let maxDepth = defaultArg maxDepth 10
let maxWidth = defaultArg maxWidth 100
let useQualifiedNames = defaultArg useQualifiedNames false
let knownNamespaces =
[ t.Namespace
"Microsoft.FSharp.Core"
"Microsoft.FSharp.Core.Operators"
"Microsoft.FSharp.Collections"
"Microsoft.FSharp.Control"
"Microsoft.FSharp.Text" ]
|> Set.ofSeq
let pending = new Queue<_>()
let visited = new HashSet<_>()
let add t =
if visited.Add t then
pending.Enqueue t
let fullName (t: Type) =
let fullName =
if useQualifiedNames && not (t :? ProvidedTypeDefinition) then
t.AssemblyQualifiedName
else t.Namespace + "." + t.Name
if fullName.StartsWith "FSI_" then
fullName.Substring(fullName.IndexOf('.') + 1)
else
fullName
let rec toString useFullName (t: Type) =
let hasUnitOfMeasure = t.Name.Contains("[")
let innerToString (t: Type) =
match t with
| _ when t.Name = typeof<bool>.Name -> "bool"
| _ when t.Name = typeof<obj>.Name -> "obj"
| _ when t.Name = typeof<int>.Name -> "int"
| _ when t.Name = typeof<int64>.Name -> "int64"
| _ when t.Name = typeof<float>.Name -> "float"
| _ when t.Name = typeof<float32>.Name -> "float32"
| _ when t.Name = typeof<decimal>.Name -> "decimal"
| _ when t.Name = typeof<string>.Name -> "string"
| _ when t.Name = typeof<Void>.Name -> "()"
| _ when t.Name = typeof<unit>.Name -> "()"
| t when t.IsArray -> (t.GetElementType() |> toString useFullName) + "[]"
| :? ProvidedTypeDefinition as t ->
add t
t.Name.Split(',').[0]
| t when t.IsGenericType ->
let args =
if useFullName then
t.GetGenericArguments()
|> Seq.map (if hasUnitOfMeasure then (fun t -> t.Name) else toString useFullName)
else
t.GetGenericArguments()
|> Seq.map (fun _ -> "_")
if t.FullName.StartsWith "System.Tuple`" then
String.concat " * " args
elif t.Name.StartsWith "FSharpFunc`" then
"(" + (String.concat " -> " args) + ")"
else
let args = String.concat "," args
let name, reverse =
match t with
| t when hasUnitOfMeasure -> toString useFullName t.UnderlyingSystemType, false
// Short names for some known generic types
| t when not useQualifiedNames && t.GetGenericTypeDefinition().Name = typeof<int seq>.GetGenericTypeDefinition().Name -> "seq", true
| t when not useQualifiedNames && t.GetGenericTypeDefinition().Name = typeof<int list>.GetGenericTypeDefinition().Name -> "list", true
| t when not useQualifiedNames && t.GetGenericTypeDefinition().Name = typeof<int option>.GetGenericTypeDefinition().Name -> "option", true
| t when not useQualifiedNames && t.GetGenericTypeDefinition().Name = typeof<int ref>.GetGenericTypeDefinition().Name -> "ref", true
| t when not useQualifiedNames && t.Name = "FSharpAsync`1" -> "async", true
// Short names for types in F# namespaces
| t when not useQualifiedNames && knownNamespaces.Contains t.Namespace -> t.Name, false
| t -> (if useFullName then fullName t else t.Name), false
let name = name.Split('`').[0]
if reverse then
args + " " + name
else
name + "<" + args + ">"
// Short names for types in F# namespaces
| t when not useQualifiedNames && knownNamespaces.Contains t.Namespace -> t.Name
// Short names for generic parameters
| t when t.IsGenericParameter -> t.Name
| t -> if useFullName then fullName t else t.Name
let rec warnIfWrongAssembly (t:Type) =
match t with
| :? ProvidedTypeDefinition -> ""
| t when t.IsGenericType -> defaultArg (t.GetGenericArguments() |> Seq.map warnIfWrongAssembly |> Seq.tryFind (fun s -> s <> "")) ""
| t when t.IsArray -> warnIfWrongAssembly <| t.GetElementType()
| t -> if not t.IsGenericParameter && t.Assembly = Assembly.GetExecutingAssembly() then " [DESIGNTIME]" else ""
if ignoreOutput then
""
elif hasUnitOfMeasure || t.IsGenericParameter || t.DeclaringType = null then
innerToString t + (warnIfWrongAssembly t)
else
(toString useFullName t.DeclaringType) + "+" + (innerToString t) + (warnIfWrongAssembly t)
let toSignature (parameters: ParameterInfo[]) =
if parameters.Length = 0 then
"()"
else
parameters
|> Seq.map (fun p -> p.Name + ":" + (toString true p.ParameterType))
|> String.concat " -> "
let printExpr expr =
let sb = StringBuilder ()
let print (str:string) = sb.Append(str) |> ignore
let getCurrentIndent() =
let lastEnterPos = sb.ToString().LastIndexOf('\n')
if lastEnterPos = -1 then sb.Length + 4 else sb.Length - lastEnterPos - 1
let breakLine indent =
print "\n"
print (new String(' ', indent))
let isBigExpression = function
| Let _ | NewArray _ | NewTuple _ -> true
| _ -> false
let inline getAttrs attrName m =
( ^a : (member GetCustomAttributesData : unit -> IList<CustomAttributeData>) m)
|> Seq.filter (fun attr -> attr.Constructor.DeclaringType.Name = attrName)
let inline hasAttr attrName m =
not (Seq.isEmpty (getAttrs attrName m))
let rec printSeparatedByCommas exprs =
match exprs with
| [] -> ()
| e::es ->
printExpr false true e
for e in es do
print ", "
printExpr false true e
and printCall fromPipe printName (mi:MethodInfo) args =
if fromPipe && List.length args = 1 then
printName()
elif not (hasAttr "CompilationArgumentCountsAttribute" mi) then
printName()
match args with
| [] -> print "()"
| arg::args ->
print "("
let indent = getCurrentIndent()
printExpr false true arg
for arg in args do
print ", "
if isBigExpression arg then
breakLine indent
printExpr false true arg
print ")"
else
print "("
printName()
for arg in args do
print " "
printExpr false true arg
print ")"
and printExpr fromPipe needsParens = function
| Call (instance, mi, args) ->
if mi.Name = "GetArray" && mi.DeclaringType.FullName = "Microsoft.FSharp.Core.LanguagePrimitives+IntrinsicFunctions" then
printExpr false true args.Head
print ".["
printExpr false true args.Tail.Head
print "]"
elif mi.DeclaringType.IsGenericType && mi.DeclaringType.GetGenericTypeDefinition().Name = typeof<int option>.GetGenericTypeDefinition().Name then
if args.IsEmpty then
match instance with
| None -> print "None"
| Some instance ->
printExpr false true instance
print "."
print <| mi.Name.Substring("get_".Length)
else
print "Some "
printExpr false true args.Head
elif mi.Name.Contains "." && not args.IsEmpty then
// instance method in type extension
let printName() =
printExpr false true args.Head
print "."
print (mi.Name.Substring(mi.Name.IndexOf '.' + 1))
printCall fromPipe printName mi args.Tail
elif mi.Attributes &&& MethodAttributes.SpecialName = MethodAttributes.SpecialName && mi.Name.StartsWith "get_" && args.IsEmpty then
// property get
match instance with
| Some expr -> printExpr false true expr
| None -> print (toString false mi.DeclaringType)
print "."
print <| mi.Name.Substring("get_".Length)
elif mi.Name = "op_PipeRight" && args.Length = 2 then
printExpr false false args.Head
print " |> "
match args.Tail.Head with
| Lambda (_, (Call(_,_,_) as call)) -> printExpr true false call
| _ as expr -> printExpr false false expr
else
let printName() =
match instance with
| Some expr -> printExpr false true expr
| None -> print (toString false mi.DeclaringType)
print "."
print mi.Name
let isOptional (arg:Expr, param:ParameterInfo) =
hasAttr "OptionalArgumentAttribute" param
&& arg.ToString() = "Call (None, get_None, [])"
let args =
mi.GetParameters()
|> List.ofArray
|> List.zip args
|> List.filter (not << isOptional)
|> List.map fst
printCall fromPipe printName mi args
| Let (var1, TupleGet (Var x, 1), Let (var2, TupleGet (Var y, 0), body)) when x = y ->
let indent = getCurrentIndent()
bprintf sb "let %s, %s = %s" var2.Name var1.Name x.Name
breakLine indent
printExpr false false body
| Let (var, value, body) ->
let indent = getCurrentIndent()
let usePattern = sprintf "IfThenElse(TypeTest(IDisposable,Coerce(%s,Object)),Call(Some(Call(None,UnboxGeneric,[Coerce(%s,Object)])),Dispose,[]),Value(<null>))" var.Name var.Name
let body =
match body with
| TryFinally (tryExpr, finallyExpr) when finallyExpr.ToString().Replace("\n", null).Replace(" ", null) = usePattern ->
bprintf sb "use %s = " var.Name
tryExpr
| _ ->
if var.IsMutable then
bprintf sb "let mutable %s = " var.Name
else
bprintf sb "let %s = " var.Name
body
match value with
| Let _ ->
breakLine (indent + 4)
printExpr false false value
| _ -> printExpr false false value
breakLine indent
printExpr false false body
| Value (null, _) ->
print "null"
| Value (value, typ) when typ = typeof<string> && (value :?> string).Contains("\\") ->
bprintf sb "@%A" value
| Value (value, _) ->
bprintf sb "%A" value
| Var (var) ->
print var.Name
| NewObject (ci, args) ->
let getSourceConstructFlags (attr:CustomAttributeData) =
let arg = attr.ConstructorArguments
|> Seq.filter (fun arg -> arg.ArgumentType.Name = "SourceConstructFlags")
|> Seq.head
arg.Value :?> int
let compilationMappings = getAttrs "CompilationMappingAttribute" ci.DeclaringType
if not (Seq.isEmpty compilationMappings) && (getSourceConstructFlags (Seq.head compilationMappings)) = int SourceConstructFlags.RecordType then
print "{ "
let indent = getCurrentIndent()
let recordFields = FSharpType.GetRecordFields(ci.DeclaringType)
args |> List.iteri (fun i arg ->
if i > 0 then
breakLine indent
print recordFields.[i].Name
print " = "
printExpr false false arg)
print " }"
else
print "(new "
print (toString false ci.DeclaringType)
print "("
printSeparatedByCommas args
print "))"
| NewDelegate (typ, vars, expr) ->
print "new "
print (toString false typ)
match expr with
| Var v when not vars.IsEmpty && vars.Tail.IsEmpty && vars.Head = v -> print "(id)"
| _ ->
let indent = getCurrentIndent()
if vars.IsEmpty then
print "(fun () -> "
else
print "(fun"
for var in vars do
bprintf sb " (%s:%s)" var.Name (toString false var.Type)
print " -> "
if isBigExpression expr then
breakLine (indent + 4)
printExpr false false expr
else
printExpr false false expr
print ")"
| NewTuple (exprs) ->
if needsParens then print "("
let indent = getCurrentIndent()
printExpr false true exprs.Head
for e in exprs.Tail do
print ","
breakLine indent
printExpr false true e
if needsParens then print ")"
| NewArray (_, exprs) ->
if exprs.Length = 0 then print "[| |]"
else
print "[| "
let indent = getCurrentIndent()
printExpr false true exprs.Head
for e in exprs.Tail do
breakLine indent
printExpr false true e
print " |]"
| Coerce (expr, typ) ->
print "("
printExpr false false expr
print " :> "
print (toString false typ)
print ")"
| TupleGet (expr, index) ->
print "(let "
let rec getTupleLength (typ:Type) =
let length = typ.GetGenericArguments().Length
if length = 0 then // happens in the Apiary provider
let typeNameSuffix = typ.Name.Substring(typ.Name.IndexOf('`') + 1)
typeNameSuffix.Substring(0, typeNameSuffix.IndexOf('[')) |> Int32.Parse
else
let lastItem = typ.GetGenericArguments() |> Seq.last
if lastItem.Name.StartsWith "Tuple`"
then length + getTupleLength lastItem - 1
else length
let tupleLength = getTupleLength expr.Type
let varName = "t" + (string (index + 1))
for i in 0..tupleLength-1 do
if i = index then
print varName
else
print "_"
if i <> tupleLength-1 then
print ","
print " = "
printExpr false false expr
print (" in " + varName + ")")
| expr -> print (expr.ToString())
printExpr false false expr
sb.ToString()
let sb = StringBuilder ()
let print (str: string) =
if not ignoreOutput then
sb.Append(str) |> ignore
let println() =
if not ignoreOutput then
sb.AppendLine() |> ignore
let printMember (memberInfo: MemberInfo) =
let print str =
print " "
print str
println()
let getMethodBody (m: ProvidedMethod) =
seq { if not m.IsStatic then yield (ProvidedTypeDefinition.EraseType m.DeclaringType)
for param in m.GetParameters() do yield (ProvidedTypeDefinition.EraseType param.ParameterType) }
|> Seq.map (fun typ -> Expr.Value(null, typ))
|> Array.ofSeq
|> m.GetInvokeCodeInternal false
let getConstructorBody (c: ProvidedConstructor) =
if c.IsImplicitCtor then Expr.Value(()) else
seq { for param in c.GetParameters() do yield (ProvidedTypeDefinition.EraseType param.ParameterType) }
|> Seq.map (fun typ -> Expr.Value(null, typ))
|> Array.ofSeq
|> c.GetInvokeCodeInternal false
let printExpr x =
if not ignoreOutput then
let rec removeParams x =
match x with
| Let (_, Value(null, _), body) -> removeParams body
| _ -> x
let formattedExpr = printExpr (removeParams x)
print formattedExpr
println()
let printObj x =
if ignoreOutput then
""
else
sprintf "\n%O\n" x
let getName (m:MemberInfo) =
if memberInfo.Name.Contains(" ") then
"``" + m.Name + "``"
else
m.Name
match memberInfo with
| :? ProvidedConstructor as cons ->
if not ignoreOutput then
print <| "new : " +
(toSignature <| cons.GetParameters()) + " -> " +
(toString true memberInfo.DeclaringType)
if not signatureOnly then
cons |> getConstructorBody |> printExpr
| :? ProvidedLiteralField as field ->
let value =
if signatureOnly then ""
else field.GetRawConstantValue() |> printObj
if not ignoreOutput then
print <| "val " + (getName field) + ": " +
(toString true field.FieldType) +
value
| :? ProvidedProperty as prop ->
if not ignoreOutput then
print <| (if prop.IsStatic then "static " else "") + "member " +
(getName prop) + ": " + (toString true prop.PropertyType) +
" with " + (if prop.CanRead && prop.CanWrite then "get, set" else if prop.CanRead then "get" else "set")
if not signatureOnly then
if prop.CanRead then
getMethodBody (prop.GetGetMethod() :?> ProvidedMethod) |> printExpr
if prop.CanWrite then
getMethodBody (prop.GetSetMethod() :?> ProvidedMethod) |> printExpr
| :? ProvidedMethod as m ->
if m.Attributes &&& MethodAttributes.SpecialName <> MethodAttributes.SpecialName then
if not ignoreOutput then
print <| (if m.IsStatic then "static " else "") + "member " +
(getName m) + ": " + (toSignature <| m.GetParameters()) +
" -> " + (toString true m.ReturnType)
if not signatureOnly then
m |> getMethodBody |> printExpr
| _ -> ()
add t
let currentDepth = ref 0
while pending.Count <> 0 && !currentDepth <= maxDepth do
let pendingForThisDepth = new List<_>(pending)
pending.Clear()
let pendingForThisDepth =
pendingForThisDepth
|> Seq.sortBy (fun m -> m.Name)
|> Seq.truncate maxWidth
for t in pendingForThisDepth do
//Disabled because not working on Mono
//for attr in t.GetCustomAttributesData() do
// print <| (sprintf "[<%A>]" attr).Replace("Microsoft.FSharp.Core.", null).Replace("CompilerServices.", null).Replace("Attribute(", "(")
// println()
match t with
| t when FSharpType.IsRecord t-> "record "
| t when FSharpType.IsModule t -> "module "
| t when t.IsValueType -> "struct "
| t when t.IsClass && t.IsSealed && t.IsAbstract -> "static class "
| t when t.IsClass && t.IsAbstract -> "abstract class "
| t when t.IsClass -> "class "
| _ -> ""
|> print
print (toString true t)
let bt = if t.BaseType = null then typeof<obj> else t.BaseType
print " : "
print (toString true bt)
println()
t.GetMembers(BindingFlags.DeclaredOnly ||| BindingFlags.Instance ||| BindingFlags.Static ||| BindingFlags.Public)
|> Seq.sortBy (fun m -> m.Name)
|> Seq.iter printMember
println()
currentDepth := !currentDepth + 1
sb.ToString()
module internal Targets =
let private (++) a b = System.IO.Path.Combine(a,b)
let runningOnMono = Type.GetType("Mono.Runtime") <> null
let runningOnMac =
(Environment.OSVersion.Platform = PlatformID.MacOSX)
|| (Environment.OSVersion.Platform = PlatformID.Unix) && Directory.Exists("/Applications") && Directory.Exists("/System") && Directory.Exists("/Users") && Directory.Exists("/Volumes")
let runningOnLinux =
(Environment.OSVersion.Platform = PlatformID.Unix) && not runningOnMac
// Assumes OSX
let monoRoot =
Path.GetFullPath(Path.Combine(System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(),".."))
//match System.Environment.OSVersion.Platform with
//| System.PlatformID.MacOSX -> "/Library/Frameworks/Mono.framework/Versions/Current/lib/mono"
//| System.PlatformID.MacOSX -> "/Library/Frameworks/Mono.framework/Versions/Current/lib/mono"
//| _ ->
let referenceAssembliesPath =
(if runningOnMono then monoRoot else Environment.GetFolderPath Environment.SpecialFolder.ProgramFilesX86)
++ "Reference Assemblies"
++ "Microsoft"
let private fsharpPortableAssembliesPath fsharp profile =
match fsharp, profile with
| "3.1", 47 -> referenceAssembliesPath ++ "FSharp" ++ ".NETPortable" ++ "2.3.5.1" ++ "FSharp.Core.dll"
| "3.1", 7 -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.3.1.0" ++ "FSharp.Core.dll"
| "3.1", 78 -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.78.3.1" ++ "FSharp.Core.dll"
| "3.1", 259 -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.259.3.1" ++ "FSharp.Core.dll"
| "4.0", 47 -> referenceAssembliesPath ++ "FSharp" ++ ".NETPortable" ++ "3.47.4.0" ++ "FSharp.Core.dll"
| "4.0", 7 -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.7.4.0" ++ "FSharp.Core.dll"
| "4.0", 78 -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.78.4.0" ++ "FSharp.Core.dll"
| "4.0", 259 -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.259.4.0" ++ "FSharp.Core.dll"
| _ -> failwith "unimplemented portable profile"
let private fsharpPortableAssembliesPathFromNuGet fsharp profile =
let paketGroup =
match fsharp with
| "3.1" -> "fs31"
| "4.0" -> "fs40"
| _ -> failwith "unimplemented F# versin"
let profileFolder =
match profile with
| 47 -> "portable-net45+sl5+netcore45" //"portable-net45+sl5+win8"
| 7 -> "portable-net45+netcore45" //"portable-net45+win8"
| 78 -> "portable-net45+netcore45+wp8" //"portable-net45+win8+wp8"
| 259 -> "portable-net45+netcore45+wpa81+wp8" //"portable-net45+win8+wpa81+wp8"
| _ -> failwith "unimplemented portable profile"
__SOURCE_DIRECTORY__ ++ ".." ++ "packages" ++ paketGroup ++ "FSharp.Core" ++ "lib" ++ profileFolder ++ "FSharp.Core.dll"
let private fsharpAssembliesPath fsharp =
match fsharp with
| "3.1" ->
if runningOnMono then monoRoot ++ "gac" ++ "FSharp.Core" ++ "4.3.1.0__b03f5f7f11d50a3a"
else referenceAssembliesPath ++ "FSharp" ++ ".NETFramework" ++ "v4.0" ++ "4.3.1.0"
| "4.0" ->
if runningOnMono then monoRoot ++ "gac" ++ "FSharp.Core" ++ "4.4.0.0__b03f5f7f11d50a3a"
else referenceAssembliesPath ++ "FSharp" ++ ".NETFramework" ++ "v4.0" ++ "4.4.0.0"
| _ -> failwith "unimplemented portable profile"
let private net45AssembliesPath =
if runningOnMono then monoRoot ++ "4.5"
else referenceAssembliesPath ++ "Framework" ++ ".NETFramework" ++ "v4.5"
let private portableAssembliesPath profile =
let portableRoot = if runningOnMono then monoRoot ++ "xbuild-frameworks" else referenceAssembliesPath ++ "Framework"
match profile with
| 47 -> portableRoot ++ ".NETPortable" ++ "v4.0" ++ "Profile" ++ "Profile47"
| 7 -> portableRoot ++ ".NETPortable" ++ "v4.5" ++ "Profile" ++ "Profile7"
| 78 -> portableRoot ++ ".NETPortable" ++ "v4.5" ++ "Profile" ++ "Profile78"
| 259 -> portableRoot ++ ".NETPortable" ++ "v4.5" ++ "Profile" ++ "Profile259"
| _ -> failwith "unimplemented portable profile"
let private portableCoreFSharpRefs fsharp profile =
[ for asm in [ "System.Runtime"; "mscorlib"; "System.Collections"; "System.Core"; "System"; "System.Globalization"; "System.IO"; "System.Linq"; "System.Linq.Expressions";
"System.Linq.Queryable"; "System.Net"; "System.Net.NetworkInformation"; "System.Net.Primitives"; "System.Net.Requests"; "System.ObjectModel"; "System.Reflection";
"System.Reflection.Extensions"; "System.Reflection.Primitives"; "System.Resources.ResourceManager"; "System.Runtime.Extensions";
"System.Runtime.InteropServices.WindowsRuntime"; "System.Runtime.Serialization"; "System.Threading"; "System.Threading.Tasks"; "System.Xml"; "System.Xml.Linq"; "System.Xml.XDocument";
"System.Runtime.Serialization.Json"; "System.Runtime.Serialization.Primitives"; "System.Windows" ] do
yield portableAssembliesPath profile ++ asm + ".dll"
let installedFSharpCore = fsharpPortableAssembliesPath fsharp profile
let restoredFSharpCore = fsharpPortableAssembliesPathFromNuGet fsharp profile
if (not(File.Exists(installedFSharpCore)) && File.Exists(restoredFSharpCore))
then yield restoredFSharpCore
else yield installedFSharpCore
]
let DotNet45Refs = [net45AssembliesPath ++ "mscorlib.dll"; net45AssembliesPath ++ "System.Xml.dll"; net45AssembliesPath ++ "System.Core.dll"; net45AssembliesPath ++ "System.Xml.Linq.dll"; net45AssembliesPath ++ "System.dll" ]
let FSharpCoreRef fsharp = fsharpAssembliesPath fsharp ++ "FSharp.Core.dll"
let DotNet45FSharpRefs fsharp = [ yield! DotNet45Refs; yield FSharpCoreRef fsharp ]
let Portable47FSharpRefs fsharp = [portableAssembliesPath 47 ++ "mscorlib.dll"; portableAssembliesPath 47 ++ "System.Xml.Linq.dll"; fsharpPortableAssembliesPath fsharp 47]
let DotNet45FSharp31Refs = DotNet45FSharpRefs "3.1"
let Portable47FSharp31Refs = Portable47FSharpRefs "3.1"
let Portable7FSharp31Refs = portableCoreFSharpRefs "3.1" 7
let Portable78FSharp31Refs = portableCoreFSharpRefs "3.1" 78
let Portable259FSharp31Refs = portableCoreFSharpRefs "3.1" 259
let FSharpCore40Ref = FSharpCoreRef "4.0"
let DotNet45FSharp40Refs = DotNet45FSharpRefs "4.0"
let Portable7FSharp40Refs = portableCoreFSharpRefs "4.0" 7
let Portable78FSharp40Refs = portableCoreFSharpRefs "4.0" 78
let Portable259FSharp40Refs = portableCoreFSharpRefs "4.0" 259
let supportsFSharp40 = (try File.Exists FSharpCore40Ref with _ -> false)
// Some tests disabled on Linux for now because the standard packages don't come with F# PCL FSharp.Core.dll for this profile
let hasPortableFSharpCoreDLLs = not runningOnLinux

6
Resource.designer.cs сгенерированный
Просмотреть файл

@ -2,7 +2,7 @@
{
public partial class Resource
public partial class Resources
{
public partial class Attribute
@ -65,5 +65,9 @@
{
}
}
public static UpdateIdValues()
{
}
}
}

Просмотреть файл

@ -4,18 +4,19 @@ open System
open System.IO
open System.Reflection
open System.CodeDom.Compiler
open System.Collections.Generic
open System.Xml.Linq
open FSharp.Core.CompilerServices
open FSharp.Quotations
open Microsoft.CSharp
open ProviderImplementation.ProvidedTypes
[<TypeProvider>]
type ResourceProvider(config : TypeProviderConfig) as this =
inherit TypeProviderForNamespaces()
let ctxt = ProvidedTypesContext.Create(config)
type ResourceProvider(config : TypeProviderConfig) =
let mutable providedAssembly = None
let invalidateEvent = Event<EventHandler,EventArgs>()
let isInsideIDE = config.IsInvalidationSupported // msbuild doesn't support invalidation
let isMsBuild = not isInsideIDE
let compiler = new CSharpCodeProvider()
let (/) a b = Path.Combine(a,b)
@ -61,7 +62,8 @@ type ResourceProvider(config : TypeProviderConfig) as this =
| Some ref -> addRef ref
| None -> printfn "Did not find %s in referenced assemblies." assemblyFileName
printfn "F# Android resource provider"
let version = Assembly.GetExecutingAssembly().GetName().Version
printfn "F# Android resource provider %A" version
addReference "System.dll"
addReference "mscorlib.dll"
@ -86,20 +88,32 @@ type ResourceProvider(config : TypeProviderConfig) as this =
failwithf "%A" errors
let asm = Assembly.ReflectionOnlyLoadFrom cp.OutputAssembly
let resourceType = asm.GetTypes() |> Array.tryFind(fun t -> t.Name = "Resource")
match resourceType with
| Some typ ->
let csharpAssembly = Assembly.GetExecutingAssembly()
let providedAssembly = ProvidedAssembly(ctxt)
let providedType = ctxt.ProvidedTypeDefinition(csharpAssembly, typ.Namespace, typ.Name, Some typeof<obj>, true, true, false)
let generatedAssembly = ProvidedAssembly.RegisterGenerated(ctxt, outputPath)
providedType.AddMembers (typ.GetNestedTypes() |> List.ofArray)
providedAssembly.AddTypes [providedType]
this.AddNamespace(typ.Namespace, [providedType])
| None -> failwith "No resource type found"
let types = asm.GetTypes()
let namespaces =
let dict = Dictionary<_,List<_>>()
for t in types do
let namespc = if isNull t.Namespace then "global" else t.Namespace
match dict.TryGetValue(namespc) with
| true, ns -> ns.Add(t)
| _, _ ->
let ns = List<_>()
ns.Add(t)
dict.Add(namespc, ns)
dict
|> Seq.map (fun kv ->
{ new IProvidedNamespace with
member x.NamespaceName = kv.Key
member x.GetNestedNamespaces() = [||] //FIXME
member x.GetTypes() = kv.Value.ToArray()
member x.ResolveTypeName(typeName: string) = null
}
)
|> Seq.toArray
providedAssembly <- Some(File.ReadAllBytes(result.PathToAssembly), namespaces)
let invalidate _ =
printfn "Invalidating resources"
this.Invalidate()
invalidateEvent.Trigger(null, null)
do
printfn "Resource folder %s" config.ResolutionFolder
@ -107,6 +121,20 @@ type ResourceProvider(config : TypeProviderConfig) as this =
watcher.Changed.Add invalidate
watcher.Created.Add invalidate
AppDomain.CurrentDomain.add_ReflectionOnlyAssemblyResolve(fun _ args ->
let name = AssemblyName(args.Name)
printfn "Resolving %s" args.Name
let existingAssembly =
AppDomain.CurrentDomain.GetAssemblies()
|> Seq.tryFind(fun a -> AssemblyName.ReferenceMatchesDefinition(name, a.GetName()))
let asm =
match existingAssembly with
| Some a -> printfn "Resolved to %s" a.Location
Assembly.ReflectionOnlyLoadFrom a.Location
| None -> null
asm)
let getRootNamespace() =
// Try and guess what the namespace should be...
// This will work 99%+ of the time and if it
@ -125,9 +153,13 @@ type ResourceProvider(config : TypeProviderConfig) as this =
/// Filter out all lines that use the global namespace. These are only used at
/// runtime and require references to Mono.Android and XF which are problematic to load
/// inside the IDE context
/// inside the IDE context.
///
/// The C# code also contains private static constructors that contain code that we
/// don't want to execute inside the IDE. This code is needed inside the msbuild / runtime
/// context to update resource ID values between libraries.
let shouldAddLine (line: string) =
not isInsideIDE ||
isMsBuild ||
isInsideIDE && not (line.Contains("global::"))
let source =
@ -146,5 +178,32 @@ type ResourceProvider(config : TypeProviderConfig) as this =
generate source
interface ITypeProvider with
[<CLIEvent>]
member x.Invalidate = invalidateEvent.Publish
member x.GetStaticParameters(typeWithoutArguments) = [||]
member x.GetGeneratedAssemblyContents(assembly) =
match providedAssembly with
| Some(bytes, _) -> bytes
| _ -> failwith "Generate was never called"
member x.GetNamespaces() =
match providedAssembly with
| Some(_, namespaces) -> namespaces
| _ -> failwith "Generate was never called"
member x.ApplyStaticArguments(typeWithoutArguments, typeNameWithArguments, staticArguments) = null
member x.GetInvokerExpression(methodBase, parameters) =
match methodBase with
| :? ConstructorInfo as cinfo ->
Expr.NewObject(cinfo, Array.toList parameters)
| :? MethodInfo as minfo ->
if minfo.IsStatic then
Expr.Call(minfo, Array.toList parameters)
else
Expr.Call(parameters.[0], minfo, Array.toList parameters.[1..])
| _ -> failwith ("GetInvokerExpression: not a ConstructorInfo/MethodInfo, name=" + methodBase.Name + " class=" + methodBase.GetType().FullName)
member x.Dispose() =
compiler.Dispose()
watcher.Dispose()
[<assembly: TypeProviderAssembly>]
do()

Просмотреть файл

@ -8,7 +8,7 @@ open System.Reflection
// The assembly version has the format {Major}.{Minor}.{Build}.{Revision}
[<assembly: AssemblyVersion("1.0.0.21")>]
[<assembly: AssemblyVersion("1.0.0.22")>]
//[<assembly: AssemblyDelaySign(false)>]
//[<assembly: AssemblyKeyFile("")>]

Просмотреть файл

@ -42,12 +42,6 @@
<ItemGroup>
<EmbeddedResource Include="Resource.designer.cs" />
<Compile Include="AssemblyInfo.fs" />
<Compile Include="paket-files\fsprojects\FSharp.TypeProviders.StarterPack\src\ProvidedTypes.fsi">
<Link>ProvidedTypes.fsi</Link>
</Compile>
<Compile Include="paket-files\fsprojects\FSharp.TypeProviders.StarterPack\src\ProvidedTypes.fs">
<Link>ProvidedTypes.fs</Link>
</Compile>
<Compile Include="ResourceTypeProvider.fs" />
</ItemGroup>
<Import Project="$(FSharpTargetsPath)" />

Просмотреть файл

@ -2,7 +2,7 @@
<package xmlns="http://schemas.microsoft.com/packaging/2011/08/nuspec.xsd">
<metadata>
<id>Xamarin.Android.FSharp.ResourceProvider</id>
<version>1.0.0.21</version>
<version>1.0.0.22</version>
<title>Xamarin.Android.FSharp.ResourceProvider</title>
<authors>Xamarin</authors>
<owners>Xamarin</owners>

Разница между файлами не показана из-за своего большого размера Загрузить разницу

Просмотреть файл

@ -1,583 +0,0 @@
// 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.Collections.Generic
open System.Reflection
open System.Linq.Expressions
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Core.CompilerServices
/// Represents an erased provided parameter
[<Class>]
type ProvidedParameter =
inherit ParameterInfo
/// Indicates if the parameter is marked as ParamArray
member IsParamArray: bool with get,set
/// Indicates if the parameter is marked as ReflectedDefinition
member IsReflectedDefinition: bool with get,set
/// Indicates if the parameter has a default value
member HasDefaultParameterValue: bool
/// Represents a provided static parameter.
[<Class>]
type ProvidedStaticParameter =
inherit ParameterInfo
/// 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.
[<Class>]
type ProvidedConstructor =
inherit ConstructorInfo
/// Add a '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 target and arguments of the base constructor call. Only used for generated types.
member BaseConstructorCall: (Expr list -> ConstructorInfo * Expr list) with set
/// Set a flag indicating that the constructor acts like an F# implicit constructor, so the
/// parameters of the constructor become fields and can be accessed using Expr.GlobalVar with the
/// same name.
member IsImplicitCtor: bool with get,set
/// Add definition location information to the provided constructor.
member AddDefinitionLocation: line:int * column:int * filePath:string -> unit
member IsTypeInitializer: bool with get,set
/// This method is for internal use only in the type provider SDK
member internal GetInvokeCodeInternal: isGenerated: bool * convToTgt: (Type -> Type) -> (Expr [] -> Expr)
[<Class>]
type ProvidedMethod =
inherit MethodInfo
/// 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
/// 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
/// This method is for internal use only in the type provider SDK
member internal GetInvokeCodeInternal: isGenerated: bool * convToTgt: (Type -> Type) -> (Expr [] -> Expr)
/// Represents an erased provided property.
[<Class>]
type ProvidedProperty =
inherit PropertyInfo
/// Add a 'Obsolete' attribute to this provided property
member AddObsoleteAttribute: message: string * ?isError: bool -> unit
/// Add XML documentation information to this provided constructor
member AddXmlDoc: xmlDoc: string -> unit
/// 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
/// 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.
[<Class>]
type ProvidedEvent =
inherit EventInfo
/// 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 a flag indicating if the property is static.
member IsStatic: bool with get
/// Add definition location information to the provided type definition.
member AddDefinitionLocation: line:int * column:int * filePath:string -> unit
/// Represents an erased provided field.
[<Class>]
type ProvidedLiteralField =
inherit FieldInfo
/// Add a 'Obsolete' attribute to this provided field
member AddObsoleteAttribute: message: string * ?isError: bool -> unit
/// Add XML documentation information to this provided field
member AddXmlDoc: xmlDoc: string -> unit
/// 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.
[<Class>]
type ProvidedField =
inherit FieldInfo
/// Add a 'Obsolete' attribute to this provided field
member AddObsoleteAttribute: message: string * ?isError: bool -> unit
/// Add XML documentation information to this provided field
member AddXmlDoc: xmlDoc: string -> unit
/// 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.
[<NoComparison>]
type ProvidedSymbolKind =
/// 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.
[<Class>]
type ProvidedSymbolType =
inherit TypeDelegator
/// Returns the kind of this symbolic type
member Kind: ProvidedSymbolKind
/// Return the provided types used as arguments of this symbolic type
member Args: list<Type>
/// For example, kg
member IsFSharpTypeAbbreviation: bool
/// For example, int<kg> or int<kilogram>
member IsFSharpUnitAnnotated: bool
/// Helpers to build symbolic provided types
[<Class>]
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.
[<Class>]
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 * measure2: 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<kg>, Vector<int, kg>
member AnnotateType: basic: Type * argument: Type list -> Type
/// Represents a provided type definition.
[<Class>]
type ProvidedTypeDefinition =
inherit TypeDelegator
/// 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 '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
/// 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 Object entries in intellisense menus in instances of this provided type
member HideObjectMethods: bool
/// Disallows the use of the null literal.
member NonNullable: bool
/// Get a flag indicating if the ProvidedTypeDefinition is erased
member IsErased: bool
/// Get or set a flag indicating if the ProvidedTypeDefinition has type-relocation suppressed
[<Experimental("SuppressRelocation is a workaround and likely to be removed")>]
member SuppressRelocation: bool with get,set
// This method is used by Debug.fs
member ApplyStaticArguments: name:string * args:obj[] -> ProvidedTypeDefinition
/// Add a custom attribute to the provided type definition.
member AddCustomAttribute: CustomAttributeData -> unit
/// 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
[<Class>]
type ProvidedTypesContext =
/// Create a context for providing types for a particular rntime target.
/// Specific assembly renaming replacements can be provided using assemblyReplacementMap.
static member Create : cfg: TypeProviderConfig * ?assemblyReplacementMap : seq<string*string> -> ProvidedTypesContext
/// Create a new provided static parameter, for use with DefineStaticParamaeters on a provided type definition.
///
/// When making a cross-targeting type provider, use this method instead of the ProvidedParameter constructor from ProvidedTypes
member ProvidedStaticParameter: parameterName: string * parameterType: Type * ?parameterDefaultValue: obj -> ProvidedStaticParameter
/// Create a new provided field. It is not initially associated with any specific provided type definition.
///
/// When making a cross-targeting type provider, use this method instead of the ProvidedProperty constructor from ProvidedTypes
member ProvidedField: fieldName: string * fieldType: Type -> ProvidedField
/// Create a new provided literal field. It is not initially associated with any specific provided type definition.
///
/// When making a cross-targeting type provider, use this method instead of the ProvidedProperty constructor from ProvidedTypes
member ProvidedLiteralField: fieldName: string * fieldType: Type * literalValue:obj -> ProvidedLiteralField
/// Create a new provided parameter.
///
/// When making a cross-targeting type provider, use this method instead of the ProvidedProperty constructor from ProvidedTypes
member ProvidedParameter: parameterName: string * parameterType: Type * ?isOut: bool * ?optionalValue: obj -> ProvidedParameter
/// Create a new provided property. It is not initially associated with any specific provided type definition.
///
/// When making a cross-targeting type provider, use this method instead of the ProvidedProperty constructor from ProvidedTypes
member ProvidedProperty: propertyName: string * propertyType: Type * ?isStatic: bool * ?getterCode: (Expr list -> Expr) * ?setterCode: (Expr list -> Expr) * ?parameters: ProvidedParameter list -> ProvidedProperty
/// Create a new provided event. It is not initially associated with any specific provided type definition.
///
/// When making a cross-targeting type provider, use this method instead of the ProvidedProperty constructor from ProvidedTypes
member ProvidedEvent: eventName: string * eventHandlerType: Type * ?isStatic: bool * ?adderCode: (Expr list -> Expr) * ?removerCode: (Expr list -> Expr) -> ProvidedEvent
/// When making a cross-targeting type provider, use this method instead of the ProvidedConstructor constructor from ProvidedTypes
member ProvidedConstructor: parameters: ProvidedParameter list * ?invokeCode: (Expr list -> Expr) -> ProvidedConstructor
/// When making a cross-targeting type provider, use this method instead of the ProvidedMethod constructor from ProvidedTypes
member ProvidedMethod: methodName: string * parameters: ProvidedParameter list * returnType: Type * ?isStatic: bool * ?invokeCode: (Expr list -> Expr) -> ProvidedMethod
/// When making a cross-targeting type provider, use this method instead of the corresponding ProvidedTypeDefinition constructor from ProvidedTypes
member ProvidedTypeDefinition: className: string * baseType: Type option * ?hideObjectMethods: bool * ?nonNullable: bool * ?isErased: bool -> ProvidedTypeDefinition
/// When making a cross-targeting type provider, use this method instead of the corresponding ProvidedTypeDefinition constructor from ProvidedTypes
member ProvidedTypeDefinition: assembly: Assembly * namespaceName: string * className: string * baseType: Type option * ?hideObjectMethods: bool * ?nonNullable: bool * ?isErased: bool -> ProvidedTypeDefinition
/// When making a cross-targeting type provider, use this method instead of ProvidedTypeBuilder.MakeGenericType
member MakeGenericType: genericTypeDefinition: Type * genericArguments: Type list -> Type
/// When making a cross-targeting type provider, use this method instead of ProvidedTypeBuilder.MakeGenericMethod
member MakeGenericMethod: genericMethodDefinition: MethodInfo * genericArguments: Type list -> MethodInfo
/// Try to find the given assembly in the context
member TryBindAssembly: aref: AssemblyName -> Choice<Assembly, exn>
/// Try to find the given assembly in the context
member TryBindAssemblyBySimpleName: assemblyName: string -> Choice<Assembly, exn>
/// Get the list of referenced assemblies determined by the type provider configuration
member ReferencedAssemblyPaths: string list
/// Get the resolved referenced assemblies determined by the type provider configuration
member ReferencedAssemblies : Assembly[]
/// Try to get the version of FSharp.Core referenced. May raise an exception if FSharp.Core has not been correctly resolved
member FSharpCoreAssemblyVersion: Version
/// Returns a type from the referenced assemblies that corresponds to the given design-time type. Normally
/// this method should not be used directly when authoring a type provider.
member ConvertDesignTimeTypeToTargetType: Type -> Type
/// Returns the design-time type that corresponds to the given type from the referenced assemblies. Normally
/// this method should not be used directly when authoring a type provider.
member ConvertTargetTypeToDesignTimeType: Type -> Type
/// Returns a quotation rebuilt with resepct to the types from the referenced assemblies. Normally
/// this method should not be used directly when authoring a type provider.
member ConvertDesignTimeExprToTargetExpr: Expr -> Expr
/// Returns a quotation rebuilt with resepct to the types from the design-time assemblies. Normally
/// this method should not be used directly when authoring a type provider.
member ConvertTargetExprToDesignTimeExpr: Expr -> Expr
/// 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<string * ProvidedTypeDefinition list>
/// 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
/// AssemblyResolve handler. Default implementation searches <assemblyname>.dll file in registered folders
abstract ResolveAssembly: ResolveEventArgs -> Assembly
default ResolveAssembly: ResolveEventArgs -> Assembly
/// Registers custom probing path that can be used for probing assemblies
member RegisterProbingFolder: folder: string -> unit
/// Registers location of RuntimeAssembly (from TypeProviderConfig) as probing folder
member RegisterRuntimeAssemblyLocationAsProbingFolder: config: TypeProviderConfig -> unit
#endif
[<CLIEvent>]
member Disposing: IEvent<EventHandler,EventArgs>
interface ITypeProvider
#if !NO_GENERATIVE
/// An internal type used in the implementation of ProvidedAssembly
[<Class>]
type ContextAssembly =
inherit Assembly
/// A provided generated assembly
type ProvidedAssembly =
inherit ContextAssembly
/// Create a provided generated assembly
new: assemblyName: AssemblyName * assemblyFileName:string * context:ProvidedTypesContext -> ProvidedAssembly
/// Create a provided generated assembly using a temporary file as the interim assembly storage
new: context:ProvidedTypesContext -> 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
/// <summary>
/// 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.
/// </summary>
/// <param name="enclosingTypeNames">A path of type names to wrap the generated types. The generated types are then generated as nested types.</param>
member AddNestedTypes: types: ProvidedTypeDefinition list * enclosingGeneratedTypeNames: string list -> unit
#if !FX_NO_LOCAL_FILESYSTEM
/// Register that a given file is a provided generated assembly
static member RegisterGenerated: context: ProvidedTypesContext * fileName: string -> Assembly
#endif
#endif
module internal UncheckedQuotations =
type Expr with
static member NewDelegateUnchecked: ty:Type * vs:Var list * body:Expr -> Expr
static member NewObjectUnchecked: cinfo:ConstructorInfo * args:Expr list -> Expr
static member NewArrayUnchecked: elementType:Type * elements:Expr list -> Expr
static member CallUnchecked: minfo:MethodInfo * args:Expr list -> Expr
static member CallUnchecked: obj:Expr * minfo:MethodInfo * args:Expr list -> Expr
static member ApplicationUnchecked: f:Expr * x:Expr -> Expr
static member PropertyGetUnchecked: pinfo:PropertyInfo * args:Expr list -> Expr
static member PropertyGetUnchecked: obj:Expr * pinfo:PropertyInfo * ?args:Expr list -> Expr
static member PropertySetUnchecked: pinfo:PropertyInfo * value:Expr * ?args:Expr list -> Expr
static member PropertySetUnchecked: obj:Expr * pinfo:PropertyInfo * value:Expr * args:Expr list -> Expr
static member FieldGetUnchecked: pinfo:FieldInfo -> Expr
static member FieldGetUnchecked: obj:Expr * pinfo:FieldInfo -> Expr
static member FieldSetUnchecked: pinfo:FieldInfo * value:Expr -> Expr
static member FieldSetUnchecked: obj:Expr * pinfo:FieldInfo * value:Expr -> Expr
static member TupleGetUnchecked: e:Expr * n:int -> Expr
static member LetUnchecked: v:Var * e:Expr * body:Expr -> Expr
type Shape
val ( |ShapeCombinationUnchecked|ShapeVarUnchecked|ShapeLambdaUnchecked| ): e:Expr -> Choice<(Shape * Expr list),Var, (Var * Expr)>
val RebuildShapeCombinationUnchecked: Shape * args:Expr list -> Expr

Просмотреть файл

@ -1,737 +0,0 @@
// --------------------------------------------------------------------------------------
// Helpers for writing type providers
// ----------------------------------------------------------------------------------------------
namespace ProviderImplementation.ProvidedTypesTesting
open System
open System.Collections.Generic
open System.Reflection
open System.IO
open System.Text
open Microsoft.FSharp.Core.CompilerServices
open Microsoft.FSharp.Core.Printf
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Reflection
open ProviderImplementation.ProvidedTypes
[<AutoOpen>]
module Utils =
let isNull x = match x with null -> true | _ -> false
/// Simulate a real host of TypeProviderConfig
type internal DllInfo(path: string) =
member x.FileName = path
/// Simulate a real host of TypeProviderConfig
type internal TcImports(bas: TcImports option, dllInfos: DllInfo list) =
member x.Base = bas
member x.DllInfos = dllInfos
type internal Testing() =
/// Simulates a real instance of TypeProviderConfig
static member MakeSimulatedTypeProviderConfig (resolutionFolder: string, runtimeAssembly: string, runtimeAssemblyRefs: string list) =
let cfg = TypeProviderConfig(fun _ -> false)
let (?<-) cfg prop value =
let ty = cfg.GetType()
match ty.GetProperty(prop,BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic) with
| null -> ty.GetField(prop,BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic).SetValue(cfg, value)|> ignore
| p -> p.GetSetMethod(nonPublic = true).Invoke(cfg, [| box value |]) |> ignore
cfg?ResolutionFolder <- resolutionFolder
cfg?RuntimeAssembly <- runtimeAssembly
cfg?ReferencedAssemblies <- Array.zeroCreate<string> 0
// Fake an implementation of SystemRuntimeContainsType the shape expected by AssemblyResolver.fs.
let dllInfos = [yield DllInfo(runtimeAssembly); for r in runtimeAssemblyRefs do yield DllInfo(r)]
let tcImports = TcImports(Some(TcImports(None,[])),dllInfos)
let systemRuntimeContainsType = (fun (_s:string) -> if tcImports.DllInfos.Length = 1 then true else true)
cfg?systemRuntimeContainsType <- systemRuntimeContainsType
//Diagnostics.Debugger.Launch() |> ignore
Diagnostics.Debug.Assert(cfg.GetType().GetField("systemRuntimeContainsType",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) |> isNull |> not)
Diagnostics.Debug.Assert(systemRuntimeContainsType.GetType().GetField("tcImports",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) |> isNull |> not)
Diagnostics.Debug.Assert(typeof<TcImports>.GetField("dllInfos",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) |> isNull |> not)
Diagnostics.Debug.Assert(typeof<TcImports>.GetProperty("Base",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) |> isNull |> not)
Diagnostics.Debug.Assert(typeof<DllInfo>.GetProperty("FileName",BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Instance) |> isNull |> not)
cfg
/// Simulates a real instance of TypeProviderConfig and then creates an instance of the last
/// type provider added to a namespace by the type provider constructor
static member GenerateProvidedTypeInstantiation (resolutionFolder: string, runtimeAssembly: string, runtimeAssemblyRefs: string list, typeProviderForNamespacesConstructor, args) =
let cfg = Testing.MakeSimulatedTypeProviderConfig (resolutionFolder, runtimeAssembly, runtimeAssemblyRefs)
let typeProviderForNamespaces = typeProviderForNamespacesConstructor cfg :> TypeProviderForNamespaces
let providedTypeDefinition = typeProviderForNamespaces.Namespaces |> Seq.last |> snd |> Seq.last
match args with
| [||] -> providedTypeDefinition
| args ->
let typeName =
if providedTypeDefinition.IsErased then
providedTypeDefinition.Name + (args |> Seq.map (fun s -> ",\"" + (if s = null then "" else s.ToString()) + "\"") |> Seq.reduce (+))
else
// The type name ends up quite mangled in the dll output if we combine the name using static parameters, so for generated types we don't do that
providedTypeDefinition.Name
providedTypeDefinition.ApplyStaticArguments(typeName, args)
/// Returns a string representation of the signature (and optionally also the body) of all the
/// types generated by the type provider up to a certain depth and width
/// If ignoreOutput is true, this will still visit the full graph, but it will output an empty string to be faster
static member FormatProvidedType (t: ProvidedTypeDefinition, ?signatureOnly, ?ignoreOutput, ?maxDepth, ?maxWidth, ?useQualifiedNames) =
let signatureOnly = defaultArg signatureOnly false
let ignoreOutput = defaultArg ignoreOutput false
let maxDepth = defaultArg maxDepth 10
let maxWidth = defaultArg maxWidth 100
let useQualifiedNames = defaultArg useQualifiedNames false
let knownNamespaces =
[ t.Namespace
"Microsoft.FSharp.Core"
"Microsoft.FSharp.Core.Operators"
"Microsoft.FSharp.Collections"
"Microsoft.FSharp.Control"
"Microsoft.FSharp.Text" ]
|> Set.ofSeq
let pending = new Queue<_>()
let visited = new HashSet<_>()
let add t =
if visited.Add t then
pending.Enqueue t
let fullName (t: Type) =
let fullName =
if useQualifiedNames && not (t :? ProvidedTypeDefinition) then
t.AssemblyQualifiedName
else t.Namespace + "." + t.Name
if fullName.StartsWith "FSI_" then
fullName.Substring(fullName.IndexOf('.') + 1)
else
fullName
let rec toString useFullName (t: Type) =
let hasUnitOfMeasure = t.Name.Contains("[")
let innerToString (t: Type) =
match t with
| _ when t.Name = typeof<bool>.Name -> "bool"
| _ when t.Name = typeof<obj>.Name -> "obj"
| _ when t.Name = typeof<int>.Name -> "int"
| _ when t.Name = typeof<int64>.Name -> "int64"
| _ when t.Name = typeof<float>.Name -> "float"
| _ when t.Name = typeof<float32>.Name -> "float32"
| _ when t.Name = typeof<decimal>.Name -> "decimal"
| _ when t.Name = typeof<string>.Name -> "string"
| _ when t.Name = typeof<Void>.Name -> "()"
| _ when t.Name = typeof<unit>.Name -> "()"
| t when t.IsArray -> (t.GetElementType() |> toString useFullName) + "[]"
| :? ProvidedTypeDefinition as t ->
add t
t.Name.Split(',').[0]
| t when t.IsGenericType ->
let args =
if useFullName then
t.GetGenericArguments()
|> Seq.map (if hasUnitOfMeasure then (fun t -> t.Name) else toString useFullName)
else
t.GetGenericArguments()
|> Seq.map (fun _ -> "_")
if t.FullName.StartsWith "System.Tuple`" then
String.concat " * " args
elif t.Name.StartsWith "FSharpFunc`" then
"(" + (String.concat " -> " args) + ")"
else
let args = String.concat "," args
let name, reverse =
match t with
| t when hasUnitOfMeasure -> toString useFullName t.UnderlyingSystemType, false
// Short names for some known generic types
| t when not useQualifiedNames && t.GetGenericTypeDefinition().Name = typeof<int seq>.GetGenericTypeDefinition().Name -> "seq", true
| t when not useQualifiedNames && t.GetGenericTypeDefinition().Name = typeof<int list>.GetGenericTypeDefinition().Name -> "list", true
| t when not useQualifiedNames && t.GetGenericTypeDefinition().Name = typeof<int option>.GetGenericTypeDefinition().Name -> "option", true
| t when not useQualifiedNames && t.GetGenericTypeDefinition().Name = typeof<int ref>.GetGenericTypeDefinition().Name -> "ref", true
| t when not useQualifiedNames && t.Name = "FSharpAsync`1" -> "async", true
// Short names for types in F# namespaces
| t when not useQualifiedNames && knownNamespaces.Contains t.Namespace -> t.Name, false
| t -> (if useFullName then fullName t else t.Name), false
let name = name.Split('`').[0]
if reverse then
args + " " + name
else
name + "<" + args + ">"
// Short names for types in F# namespaces
| t when not useQualifiedNames && knownNamespaces.Contains t.Namespace -> t.Name
// Short names for generic parameters
| t when t.IsGenericParameter -> t.Name
| t -> if useFullName then fullName t else t.Name
let rec warnIfWrongAssembly (t:Type) =
match t with
| :? ProvidedTypeDefinition -> ""
| t when t.IsGenericType -> defaultArg (t.GetGenericArguments() |> Seq.map warnIfWrongAssembly |> Seq.tryFind (fun s -> s <> "")) ""
| t when t.IsArray -> warnIfWrongAssembly <| t.GetElementType()
| t -> if not t.IsGenericParameter && t.Assembly = Assembly.GetExecutingAssembly() then " [DESIGNTIME]" else ""
if ignoreOutput then
""
elif hasUnitOfMeasure || t.IsGenericParameter || t.DeclaringType = null then
innerToString t + (warnIfWrongAssembly t)
else
(toString useFullName t.DeclaringType) + "+" + (innerToString t) + (warnIfWrongAssembly t)
let toSignature (parameters: ParameterInfo[]) =
if parameters.Length = 0 then
"()"
else
parameters
|> Seq.map (fun p -> p.Name + ":" + (toString true p.ParameterType))
|> String.concat " -> "
let printExpr expr =
let sb = StringBuilder ()
let print (str:string) = sb.Append(str) |> ignore
let getCurrentIndent() =
let lastEnterPos = sb.ToString().LastIndexOf('\n')
if lastEnterPos = -1 then sb.Length + 4 else sb.Length - lastEnterPos - 1
let breakLine indent =
print "\n"
print (String(' ', indent))
let isBigExpression = function
| Let _ | NewArray _ | NewTuple _ -> true
| _ -> false
let inline getAttrs attrName m =
( ^a : (member GetCustomAttributesData : unit -> IList<CustomAttributeData>) m)
|> Seq.filter (fun attr -> attr.Constructor.DeclaringType.Name = attrName)
let inline hasAttr attrName m =
not (Seq.isEmpty (getAttrs attrName m))
let rec printSeparatedByCommas exprs =
match exprs with
| [] -> ()
| e::es ->
printExpr false true e
for e in es do
print ", "
printExpr false true e
and printCall fromPipe printName (mi:MethodInfo) args =
//eprintfn "printCall: %s" mi.Name
if fromPipe && List.length args = 1 then
printName()
elif not (hasAttr "CompilationArgumentCountsAttribute" mi) then
printName()
match args with
| [] -> print "()"
| arg::args ->
print "("
let indent = getCurrentIndent()
printExpr false true arg
for arg in args do
print ", "
if isBigExpression arg then
breakLine indent
printExpr false true arg
print ")"
else
print "("
printName()
for arg in args do
print " "
printExpr false true arg
print ")"
and printExpr fromPipe needsParens = function
| Call (instance, mi, args) ->
if mi.Name = "GetArray" && mi.DeclaringType.FullName = "Microsoft.FSharp.Core.LanguagePrimitives+IntrinsicFunctions" then
printExpr false true args.Head
print ".["
printExpr false true args.Tail.Head
print "]"
elif mi.DeclaringType.IsGenericType && mi.DeclaringType.GetGenericTypeDefinition().Name = typeof<int option>.GetGenericTypeDefinition().Name then
if args.IsEmpty then
match instance with
| None -> print "None"
| Some instance ->
printExpr false true instance
print "."
print <| mi.Name.Substring("get_".Length)
else
print "Some "
printExpr false true args.Head
elif mi.Name.Contains "." && not args.IsEmpty then
// instance method in type extension
let printName() =
printExpr false true args.Head
print "."
print (mi.Name.Substring(mi.Name.IndexOf '.' + 1))
printCall fromPipe printName mi args.Tail
elif mi.Attributes &&& MethodAttributes.SpecialName = MethodAttributes.SpecialName && mi.Name.StartsWith "get_" && args.IsEmpty then
// property get
match instance with
| Some expr -> printExpr false true expr
| None -> print (toString false mi.DeclaringType)
print "."
print <| mi.Name.Substring("get_".Length)
elif mi.Name = "op_PipeRight" && args.Length = 2 then
printExpr false false args.Head
print " |> "
match args.Tail.Head with
| Lambda (_, (Call(_,_,_) as call)) -> printExpr true false call
| expr -> printExpr false false expr
else
let printName() =
match instance with
| Some expr -> printExpr false true expr
| None -> print (toString false mi.DeclaringType)
print "."
print mi.Name
let isOptional (arg:Expr, param:ParameterInfo) =
hasAttr "OptionalArgumentAttribute" param
&& arg.ToString() = "Call (None, get_None, [])"
let args =
mi.GetParameters()
|> List.ofArray
|> List.zip args
|> List.filter (not << isOptional)
|> List.map fst
printCall fromPipe printName mi args
| Let (var1, TupleGet (Var x, 1), Let (var2, TupleGet (Var y, 0), body)) when x = y ->
let indent = getCurrentIndent()
bprintf sb "let %s, %s = %s" var2.Name var1.Name x.Name
breakLine indent
printExpr false false body
| Let (var, value, body) ->
let indent = getCurrentIndent()
let usePattern = sprintf "IfThenElse(TypeTest(IDisposable,Coerce(%s,Object)),Call(Some(Call(None,UnboxGeneric,[Coerce(%s,Object)])),Dispose,[]),Value(<null>))" var.Name var.Name
let body =
match body with
| TryFinally (tryExpr, finallyExpr) when finallyExpr.ToString().Replace("\n", null).Replace(" ", null) = usePattern ->
bprintf sb "use %s = " var.Name
tryExpr
| _ ->
if var.IsMutable then
bprintf sb "let mutable %s = " var.Name
else
bprintf sb "let %s = " var.Name
body
match value with
| Let _ ->
breakLine (indent + 4)
printExpr false false value
| _ -> printExpr false false value
breakLine indent
printExpr false false body
| Value (null, _) ->
print "null"
| Value (value, typ) when typ = typeof<string> && (value :?> string).Contains("\\") ->
bprintf sb "@%A" value
| Value (value, _) ->
bprintf sb "%A" value
| Var (var) ->
print var.Name
| NewObject (ci, args) ->
let getSourceConstructFlags (attr:CustomAttributeData) =
let arg = attr.ConstructorArguments
|> Seq.filter (fun arg -> arg.ArgumentType.Name = "SourceConstructFlags")
|> Seq.head
arg.Value :?> int
let compilationMappings = getAttrs "CompilationMappingAttribute" ci.DeclaringType
if not (Seq.isEmpty compilationMappings) && (getSourceConstructFlags (Seq.head compilationMappings)) = int SourceConstructFlags.RecordType then
print "{ "
let indent = getCurrentIndent()
let recordFields = FSharpType.GetRecordFields(ci.DeclaringType)
args |> List.iteri (fun i arg ->
if i > 0 then
breakLine indent
print recordFields.[i].Name
print " = "
printExpr false false arg)
print " }"
else
print "(new "
print (toString false ci.DeclaringType)
print "("
printSeparatedByCommas args
print "))"
| NewDelegate (typ, vars, expr) ->
print "new "
print (toString false typ)
match expr with
| Var v when not vars.IsEmpty && vars.Tail.IsEmpty && vars.Head = v -> print "(id)"
| _ ->
let indent = getCurrentIndent()
if vars.IsEmpty then
print "(fun () -> "
else
print "(fun"
for var in vars do
bprintf sb " (%s:%s)" var.Name (toString false var.Type)
print " -> "
if isBigExpression expr then
breakLine (indent + 4)
printExpr false false expr
else
printExpr false false expr
print ")"
| NewTuple (exprs) ->
if needsParens then print "("
let indent = getCurrentIndent()
printExpr false true exprs.Head
for e in exprs.Tail do
print ","
breakLine indent
printExpr false true e
if needsParens then print ")"
| NewArray (_, exprs) ->
if exprs.Length = 0 then print "[| |]"
else
print "[| "
let indent = getCurrentIndent()
printExpr false true exprs.Head
for e in exprs.Tail do
breakLine indent
printExpr false true e
print " |]"
| Coerce (expr, typ) ->
print "("
printExpr false false expr
print " :> "
print (toString false typ)
print ")"
| TupleGet (expr, index) ->
print "(let "
let rec getTupleLength (typ:Type) =
let length = typ.GetGenericArguments().Length
if length = 0 then // happens in the Apiary provider
let typeNameSuffix = typ.Name.Substring(typ.Name.IndexOf('`') + 1)
typeNameSuffix.Substring(0, typeNameSuffix.IndexOf('[')) |> Int32.Parse
else
let lastItem = typ.GetGenericArguments() |> Seq.last
if lastItem.Name.StartsWith "Tuple`"
then length + getTupleLength lastItem - 1
else length
let tupleLength = getTupleLength expr.Type
let varName = "t" + (string (index + 1))
for i in 0..tupleLength-1 do
if i = index then
print varName
else
print "_"
if i <> tupleLength-1 then
print ","
print " = "
printExpr false false expr
print (" in " + varName + ")")
| expr -> print (expr.ToString())
printExpr false false expr
sb.ToString()
let sb = StringBuilder ()
let print (str: string) =
if not ignoreOutput then
sb.Append(str) |> ignore
let println() =
if not ignoreOutput then
sb.AppendLine() |> ignore
let printMember (memberInfo: MemberInfo) =
let print str =
print " "
print str
println()
let getMethodBody (m: ProvidedMethod) =
seq { if not m.IsStatic then yield (ProvidedTypeDefinition.EraseType m.DeclaringType)
for param in m.GetParameters() do yield (ProvidedTypeDefinition.EraseType param.ParameterType) }
|> Seq.map (fun typ -> Expr.Value(null, typ))
|> Array.ofSeq
|> m.GetInvokeCodeInternal (false, id)
let getConstructorBody (c: ProvidedConstructor) =
if c.IsImplicitCtor then Expr.Value(()) else
seq { for param in c.GetParameters() do yield (ProvidedTypeDefinition.EraseType param.ParameterType) }
|> Seq.map (fun typ -> Expr.Value(null, typ))
|> Array.ofSeq
|> c.GetInvokeCodeInternal (false, id)
let printExpr x =
if not ignoreOutput then
let rec removeParams x =
match x with
| Let (_, Value(null, _), body) -> removeParams body
| _ -> x
let formattedExpr = printExpr (removeParams x)
print formattedExpr
println()
let printObj x =
if ignoreOutput then
""
else
sprintf "\n%O\n" x
let getName (m:MemberInfo) =
if memberInfo.Name.Contains(" ") then
"``" + m.Name + "``"
else
m.Name
match memberInfo with
| :? ProvidedConstructor as cons ->
if not ignoreOutput then
print <| "new : " +
(toSignature <| cons.GetParameters()) + " -> " +
(toString true memberInfo.DeclaringType)
if not signatureOnly then
cons |> getConstructorBody |> printExpr
| :? ProvidedLiteralField as field ->
let value =
if signatureOnly then ""
else field.GetRawConstantValue() |> printObj
if not ignoreOutput then
print <| "val " + (getName field) + ": " +
(toString true field.FieldType) +
value
| :? ProvidedProperty as prop ->
if not ignoreOutput then
print <| (if prop.IsStatic then "static " else "") + "member " +
(getName prop) + ": " + (toString true prop.PropertyType) +
" with " + (if prop.CanRead && prop.CanWrite then "get, set" else if prop.CanRead then "get" else "set")
if not signatureOnly then
if prop.CanRead then
getMethodBody (prop.GetGetMethod() :?> ProvidedMethod) |> printExpr
if prop.CanWrite then
getMethodBody (prop.GetSetMethod() :?> ProvidedMethod) |> printExpr
| :? ProvidedMethod as m ->
if m.Attributes &&& MethodAttributes.SpecialName <> MethodAttributes.SpecialName then
if not ignoreOutput then
print <| (if m.IsStatic then "static " else "") + "member " +
(getName m) + ": " + (toSignature <| m.GetParameters()) +
" -> " + (toString true m.ReturnType)
if not signatureOnly then
m |> getMethodBody |> printExpr
| _ -> ()
add t
let currentDepth = ref 0
while pending.Count <> 0 && !currentDepth <= maxDepth do
let pendingForThisDepth = new List<_>(pending)
pending.Clear()
let pendingForThisDepth =
pendingForThisDepth
|> Seq.sortBy (fun m -> m.Name)
|> Seq.truncate maxWidth
for t in pendingForThisDepth do
//Disabled because not working on Mono
//for attr in t.GetCustomAttributesData() do
// print <| (sprintf "[<%A>]" attr).Replace("Microsoft.FSharp.Core.", null).Replace("CompilerServices.", null).Replace("Attribute(", "(")
// println()
match t with
| t when FSharpType.IsRecord t-> "record "
| t when FSharpType.IsModule t -> "module "
| t when t.IsValueType -> "struct "
| t when t.IsClass && t.IsSealed && t.IsAbstract -> "static class "
| t when t.IsClass && t.IsAbstract -> "abstract class "
| t when t.IsClass -> "class "
| _ -> ""
|> print
print (toString true t)
let bt = if isNull t.BaseType then typeof<obj> else t.BaseType
print " : "
print (toString true bt)
println()
t.GetMembers(BindingFlags.DeclaredOnly ||| BindingFlags.Instance ||| BindingFlags.Static ||| BindingFlags.Public)
|> Seq.sortBy (fun m -> m.Name)
|> Seq.iter printMember
println()
currentDepth := !currentDepth + 1
sb.ToString()
module internal Targets =
let private (++) a b = System.IO.Path.Combine(a,b)
let runningOnMono = Type.GetType("Mono.Runtime") |> isNull |> not
let runningOnMac =
(Environment.OSVersion.Platform = PlatformID.MacOSX)
|| (Environment.OSVersion.Platform = PlatformID.Unix) && Directory.Exists("/Applications") && Directory.Exists("/System") && Directory.Exists("/Users") && Directory.Exists("/Volumes")
let runningOnLinux =
(Environment.OSVersion.Platform = PlatformID.Unix) && not runningOnMac
// Assumes OSX
let monoRoot =
Path.GetFullPath(Path.Combine(System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(),".."))
//match System.Environment.OSVersion.Platform with
//| System.PlatformID.MacOSX -> "/Library/Frameworks/Mono.framework/Versions/Current/lib/mono"
//| System.PlatformID.MacOSX -> "/Library/Frameworks/Mono.framework/Versions/Current/lib/mono"
//| _ ->
let referenceAssembliesPath =
(if runningOnMono then monoRoot else Environment.GetFolderPath Environment.SpecialFolder.ProgramFilesX86)
++ "Reference Assemblies"
++ "Microsoft"
let private fsharpInstalledAssembliesPath fsharp profile =
match fsharp, profile with
| "3.1", "net45" ->
if runningOnMono then monoRoot ++ "gac" ++ "FSharp.Core" ++ "4.3.1.0__b03f5f7f11d50a3a" ++ "FSharp.Core.dll"
else referenceAssembliesPath ++ "FSharp" ++ ".NETFramework" ++ "v4.0" ++ "4.3.1.0" ++ "FSharp.Core.dll"
| "4.0", "net45" ->
if runningOnMono then monoRoot ++ "gac" ++ "FSharp.Core" ++ "4.4.0.0__b03f5f7f11d50a3a" ++ "FSharp.Core.dll"
else referenceAssembliesPath ++ "FSharp" ++ ".NETFramework" ++ "v4.0" ++ "4.4.0.0" ++ "FSharp.Core.dll"
| "4.1", "net45" ->
if runningOnMono then monoRoot ++ "gac" ++ "FSharp.Core" ++ "4.4.1.0__b03f5f7f11d50a3a" ++ "FSharp.Core.dll"
else referenceAssembliesPath ++ "FSharp" ++ ".NETFramework" ++ "v4.0" ++ "4.4.0.1" ++ "FSharp.Core.dll"
| "3.1", "portable47" -> referenceAssembliesPath ++ "FSharp" ++ ".NETPortable" ++ "2.3.5.1" ++ "FSharp.Core.dll"
| "3.1", "portable7" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.3.1.0" ++ "FSharp.Core.dll"
| "3.1", "portable78" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.78.3.1" ++ "FSharp.Core.dll"
| "3.1", "portable259" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.259.3.1" ++ "FSharp.Core.dll"
| "4.0", "portable47" -> referenceAssembliesPath ++ "FSharp" ++ ".NETPortable" ++ "3.47.4.0" ++ "FSharp.Core.dll"
| "4.0", "portable7" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.7.4.0" ++ "FSharp.Core.dll"
| "4.0", "portable78" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.78.4.0" ++ "FSharp.Core.dll"
| "4.0", "portable259" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.259.4.0" ++ "FSharp.Core.dll"
| "4.1", "portable47" -> referenceAssembliesPath ++ "FSharp" ++ ".NETPortable" ++ "3.47.4.1" ++ "FSharp.Core.dll"
| "4.1", "portable7" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.7.4.1" ++ "FSharp.Core.dll"
| "4.1", "portable78" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.78.4.1" ++ "FSharp.Core.dll"
| "4.1", "portable259" -> referenceAssembliesPath ++ "FSharp" ++ ".NETCore" ++ "3.259.4.1" ++ "FSharp.Core.dll"
| "4.1", "netstandard1.6" -> referenceAssembliesPath // file won't exist, must be from package
| _ -> failwith (sprintf "unimplemented profile, fsharpVersion = %s, profile = %s" fsharp profile)
let private fsharpRestoredAssembliesPath fsharp profile =
let paketGroup =
match fsharp with
| "3.1" -> "fs31"
| "4.0" -> "fs40"
| "4.1" -> "fs41"
| _ -> failwith ("unimplemented F# version" + fsharp)
let compatProfiles =
match profile with
| "net45" -> ["net45";"net40" ]
| "netstandard1.6" -> [ "netstandard1.6" ]
| "netstandard2.0" -> [ "netstandard2.0"; "netstandard1.6" ]
| "netcoreapp2.0" -> [ "netcoreapp2.0"; "netstandard2.0"; "netstandard1.6" ]
| "portable47" -> ["portable-net45+sl5+netcore45"]
| "portable7" -> ["portable-net45+netcore45"]
| "portable78" -> ["portable-net45+netcore45+wp8"]
| "portable259" -> ["portable-net45+netcore45+wpa81+wp8"]
| _ -> failwith "unimplemented portable profile"
let packagesDirectory =
let rec loop dir =
if Directory.Exists(dir ++ "packages" ) then
dir ++ "packages"
else
let parent = Path.GetDirectoryName(dir)
match parent with
| null -> failwith ("couldn't find packages directory anywhere above " + __SOURCE_DIRECTORY__)
| _ -> loop parent
loop __SOURCE_DIRECTORY__
let groupDirectory =
if Directory.Exists (packagesDirectory ++ paketGroup) then
packagesDirectory ++ paketGroup
else
printfn "assuming package at %s/FSharp.Core is for F# version %s" packagesDirectory fsharp
packagesDirectory
compatProfiles |> List.tryPick (fun profileFolder ->
let file = groupDirectory ++ "FSharp.Core" ++ "lib" ++ profileFolder ++ "FSharp.Core.dll"
if File.Exists file then Some file else None
) |> function
| None -> groupDirectory ++ "no.compat.FSharp.Core.dll.found.under.here"
| Some res -> res
let private sysInstalledAssembliesPath profile =
let portableRoot = if runningOnMono then monoRoot ++ "xbuild-frameworks" else referenceAssembliesPath ++ "Framework"
match profile with
| "net45"->
if runningOnMono then monoRoot ++ "4.5"
else referenceAssembliesPath ++ "Framework" ++ ".NETFramework" ++ "v4.5"
| "portable47" -> portableRoot ++ ".NETPortable" ++ "v4.0" ++ "Profile" ++ "Profile47"
| "portable7" -> portableRoot ++ ".NETPortable" ++ "v4.5" ++ "Profile" ++ "Profile7"
| "portable78" -> portableRoot ++ ".NETPortable" ++ "v4.5" ++ "Profile" ++ "Profile78"
| "portable259" -> portableRoot ++ ".NETPortable" ++ "v4.5" ++ "Profile" ++ "Profile259"
| _ -> failwith (sprintf "unimplemented profile '%s'" profile)
let FSharpCoreRef fsharp profile =
let installedFSharpCore = fsharpInstalledAssembliesPath fsharp profile
let restoredFSharpCore = fsharpRestoredAssembliesPath fsharp profile
if File.Exists(installedFSharpCore) then
installedFSharpCore
elif File.Exists(restoredFSharpCore) then
restoredFSharpCore
else failwith ("couldn't find FSharp.Core.dll at either '" + installedFSharpCore + "' or '" + restoredFSharpCore + "'")
let FSharpRefs fsharp profile =
[ match profile with
| "portable7" | "portable78" | "portable259" ->
for asm in [ "System.Runtime"; "mscorlib"; "System.Collections"; "System.Core"; "System"; "System.Globalization"; "System.IO"; "System.Linq"; "System.Linq.Expressions";
"System.Linq.Queryable"; "System.Net"; "System.Net.NetworkInformation"; "System.Net.Primitives"; "System.Net.Requests"; "System.ObjectModel"; "System.Reflection";
"System.Reflection.Extensions"; "System.Reflection.Primitives"; "System.Resources.ResourceManager"; "System.Runtime.Extensions";
"System.Runtime.InteropServices.WindowsRuntime"; "System.Runtime.Serialization"; "System.Threading"; "System.Threading.Tasks"; "System.Xml"; "System.Xml.Linq"; "System.Xml.XDocument";
"System.Runtime.Serialization.Json"; "System.Runtime.Serialization.Primitives"; "System.Windows" ] do
yield sysInstalledAssembliesPath profile ++ asm + ".dll"
| "portable47" ->
yield sysInstalledAssembliesPath profile ++ "mscorlib.dll"
yield sysInstalledAssembliesPath profile ++ "System.Xml.Linq.dll"
yield fsharpInstalledAssembliesPath fsharp "portable47"
| "net45" ->
yield sysInstalledAssembliesPath profile ++ "mscorlib.dll"
yield sysInstalledAssembliesPath profile ++ "System.Xml.dll"
yield sysInstalledAssembliesPath profile ++ "System.Core.dll"
yield sysInstalledAssembliesPath profile ++ "System.Xml.Linq.dll"
yield sysInstalledAssembliesPath profile ++ "System.dll"
| _ -> failwith (sprintf "unimplemented profile, fsharpVersion = %s, profile = %s" fsharp profile)
yield FSharpCoreRef fsharp profile
]
let DotNet45FSharp31Refs() = FSharpRefs "3.1" "net45"
let Portable47FSharp31Refs() = FSharpRefs "3.1" "portable47"
let Portable7FSharp31Refs() = FSharpRefs "3.1" "portable7"
let Portable78FSharp31Refs() = FSharpRefs "3.1" "portable78"
let Portable259FSharp31Refs() = FSharpRefs "3.1" "portable259"
let FSharpCore40Ref() = FSharpCoreRef "4.0" "net45"
let DotNet45FSharp40Refs() = FSharpRefs "4.0" "net45"
let Portable7FSharp40Refs() = FSharpRefs "4.0" "portable7"
let Portable78FSharp40Refs() = FSharpRefs "4.0" "portable78"
let Portable259FSharp40Refs() = FSharpRefs "4.0" "portable259"
let FSharpCore41Ref() = FSharpCoreRef "4.1" "net45"
let DotNet45FSharp41Refs() = FSharpRefs "4.1" "net45"
let Portable7FSharp41Refs() = FSharpRefs "4.1" "portable7"
let Portable78FSharp41Refs() = FSharpRefs "4.1" "portable78"
let Portable259FSharp41Refs() = FSharpRefs "4.1" "portable259"
let supportsFSharp40 = (try File.Exists (FSharpCore40Ref()) with _ -> false)
let hasPortable47Assemblies() = Directory.Exists (sysInstalledAssembliesPath "portable47")
let hasPortable7Assemblies() = Directory.Exists (sysInstalledAssembliesPath "portable7")
let hasPortable78Assemblies() = Directory.Exists (sysInstalledAssembliesPath "portable78")
let hasPortable259Assemblies() = Directory.Exists (sysInstalledAssembliesPath "portable259")

Просмотреть файл

@ -1 +0,0 @@
e0436b11faed9e7938b3c90d874a535f94311b87

Просмотреть файл

@ -1,6 +0,0 @@
framework: auto-detect
source http://nuget.org/api/v2
nuget FSharp.Core 4.0.0.1
github fsprojects/FSharp.TypeProviders.StarterPack src/ProvidedTypes.fsi
github fsprojects/FSharp.TypeProviders.StarterPack src/ProvidedTypes.fs
github fsprojects/FSharp.TypeProviders.StarterPack src/ProvidedTypesTesting.fs

Просмотреть файл

@ -1,8 +0,0 @@
NUGET
remote: http://www.nuget.org/api/v2
FSharp.Core (4.0.0.1)
GITHUB
remote: fsprojects/FSharp.TypeProviders.StarterPack
src/ProvidedTypes.fs (e0436b11faed9e7938b3c90d874a535f94311b87)
src/ProvidedTypes.fsi (e0436b11faed9e7938b3c90d874a535f94311b87)
src/ProvidedTypesTesting.fs (e0436b11faed9e7938b3c90d874a535f94311b87)