Provided Types virtualization (#2)

src/fsharp/CheckDeclarations.fs

@@ -3453,7 +3453,7 @@ module EstablishTypeDefinitionCores =
             let ctxt = ProvidedTypeContext.Create(lookupILTypeRef, lookupTyconRef)
 
             // Create a new provided type which captures the reverse-remapping tables.
-            let theRootTypeWithRemapping = theRootType.PApply ((fun x -> ProvidedType.ApplyContext(x, ctxt)), m)
+            let theRootTypeWithRemapping = theRootType.PApply ((fun x -> x.ApplyContext(ctxt)), m)
 
             let isRootGenerated, rootProvAssemStaticLinkInfoOpt = 
                 let stRootAssembly = theRootTypeWithRemapping.PApply((fun st -> st.Assembly), m)

src/fsharp/CompilerImports.fs

@@ -1434,8 +1434,7 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
                             // NOTE: The types provided by GetTypes() are available for name resolution
                             // when the namespace is "opened". This is part of the specification of the language
                             // feature.
-                            let tys = providedNamespace.PApplyArray((fun provider -> provider.GetTypes()), "GetTypes", m)
-                            let ptys = [| for ty in tys -> ty.PApply((fun ty -> ty |> ProvidedType.CreateNoContext), m) |]
+                            let ptys = providedNamespace.PApplyArray(GetProvidedTypes, "GetTypes", m)
                             for st in ptys do
                                 tcImportsStrong.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, entityToInjectInto, [], path, provider, Some st)
 

src/fsharp/TypedTreeOps.fs

@@ -5486,7 +5486,7 @@ and remapTyconRepr g tmenv repr =
                  ProvidedType = 
                      info.ProvidedType.PApplyNoFailure (fun st -> 
                          let ctxt = st.Context.RemapTyconRefs(unbox >> remapTyconRef tmenv.tyconRefRemap >> box) 
-                         ProvidedType.ApplyContext (st, ctxt)) }
+                         st.ApplyContext(ctxt)) }
 #endif
     | TNoRepr _ -> repr
     | TAsmRepr _ -> repr

src/fsharp/tainted.fs

@@ -18,7 +18,7 @@ type internal TypeProviderToken() = interface LockToken
 type internal TypeProviderLock() =
     inherit Lock<TypeProviderToken>()
 
-type internal TypeProviderError
+type TypeProviderError
     (
         errNum: int,
         tpDesignation: string,
@@ -77,19 +77,19 @@ type internal TypeProviderError
             for msg in errors do
                 f (new TypeProviderError(errNum, tpDesignation, m, [msg], typeNameContext, methodNameContext))
 
-type TaintedContext = { TypeProvider: ITypeProvider; TypeProviderAssemblyRef: ILScopeRef; Lock: TypeProviderLock }
+type TaintedContext = { TypeProvider : ITypeProvider; TypeProviderAssemblyRef : ILScopeRef; TypeProviderDesignation: string; Lock : TypeProviderLock }
 
 [<NoEquality>][<NoComparison>] 
-type internal Tainted<'T> (context: TaintedContext, value: 'T) =
+type Tainted<'T> (context : TaintedContext, value : 'T) =
     do
         match box context.TypeProvider with 
         | null -> 
             assert false
             failwith "null ITypeProvider in Tainted constructor"
         | _ -> ()
 
-    member _.TypeProviderDesignation = 
-        context.TypeProvider.GetType().FullName
+    member _.TypeProviderDesignation =
+        context.TypeProviderDesignation
 
     member _.TypeProviderAssemblyRef = 
         context.TypeProviderAssemblyRef
@@ -148,9 +148,9 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) =
     /// Access the target object directly. Use with extreme caution.
     member this.AccessObjectDirectly = value
 
-    static member CreateAll(providerSpecs: (ITypeProvider * ILScopeRef) list) =
-        [for (tp,nm) in providerSpecs do
-             yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm; Lock=TypeProviderLock() },tp) ] 
+    static member CreateAll(providerSpecs : (ITypeProvider * ILScopeRef * string) list) =
+        [for (tp,nm, tpd) in providerSpecs do
+             yield Tainted<_>({ TypeProvider = tp; TypeProviderAssemblyRef = nm; TypeProviderDesignation = tpd; Lock=TypeProviderLock() },tp) ] 
 
     member this.OfType<'U> () =
         match box value with
@@ -160,7 +160,7 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) =
     member this.Coerce<'U> (range:range) =
         Tainted(context, this.Protect(fun value -> box value :?> 'U) range)
 
-module internal Tainted =
+module Tainted =
     let (|Null|_|) (p:Tainted<'T>) =
         if p.PUntaintNoFailure(fun p -> match p with null -> true | _ -> false) then Some() else None
 
@@ -169,6 +169,9 @@ module internal Tainted =
     let EqTainted (t1:Tainted<'T>) (t2:Tainted<'T>) = 
         t1.PUntaintNoFailure(fun t1 -> t1 === t2.AccessObjectDirectly)
 
+    let PhysicallyEqTainted (t1:Tainted<'T>) (t2:Tainted<'T>) =
+        t1.PUntaintNoFailure(fun t1 -> t1 = t2.AccessObjectDirectly)
+
     let GetHashCodeTainted (t:Tainted<'T>) = t.PUntaintNoFailure(fun t -> hash t)
 
 #endif

src/fsharp/tainted.fsi

@@ -18,7 +18,7 @@ type internal TypeProviderLock =
     inherit Lock<TypeProviderToken>
 
 /// Stores and transports aggregated list of errors reported by the type provider
-type internal TypeProviderError =
+type TypeProviderError =
     inherit System.Exception
 
     /// creates new instance of TypeProviderError that represents one error
@@ -45,10 +45,10 @@ type internal TypeProviderError =
 
 /// This struct wraps a value produced by a type provider to properly attribute any failures.
 [<NoEquality; NoComparison; Class>]
-type internal Tainted<'T> =
+type Tainted<'T> =
 
     /// Create an initial tainted value
-    static member CreateAll : (ITypeProvider * ILScopeRef) list -> Tainted<ITypeProvider> list
+    static member CreateAll : (ITypeProvider * ILScopeRef * string) list -> Tainted<ITypeProvider> list
 
     /// A type provider that produced the value
     member TypeProvider : Tainted<ITypeProvider>
@@ -98,7 +98,7 @@ type internal Tainted<'T> =
     member Coerce<'U> : range:range -> Tainted<'U>
 
 [<RequireQualifiedAccess>]
-module internal Tainted =
+module Tainted =
 
     /// Test whether the tainted value is null
     val (|Null|_|) : Tainted<'T> -> unit option when 'T : null
@@ -110,6 +110,8 @@ module internal Tainted =
     /// Test whether the tainted value equals given value. Type providers are ignored (equal tainted values produced by different type providers are equal)
     /// Failure in call to equality operation will be blamed on type provider of first operand
     val EqTainted : Tainted<'T> -> Tainted<'T> -> bool when 'T : equality and 'T : not struct
+
+    val PhysicallyEqTainted : Tainted<'T> -> Tainted<'T> -> bool when 'T : equality
 
     /// Compute the hash value for the tainted value
     val GetHashCodeTainted : Tainted<'T> -> int when 'T : equality