code

src/Compiler/Checking/CheckDeclarations.fs

@@ -1042,7 +1042,7 @@ module MutRecBindingChecking =
                         AddLocalTyconRefs true g cenv.amap tcref.Range [tcref] initialEnvForTycon
 
                 // Make fresh version of the class type for type checking the members and lets *
-                let _, copyOfTyconTypars, _, objTy, thisTy = FreshenObjectArgType cenv tcref.Range TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
+                let _, copyOfTyconTypars, _, objTy, thisTy = FreshenObjectArgType cenv tcref.Range TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars true
 
                 // The basic iteration over the declarations in a single type definition
                 let initialInnerState = (None, envForTycon, tpenv, recBindIdx, uncheckedBindsRev)

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -1834,13 +1834,18 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_>
 // to C<_> occurs then generate C<?ty> for a fresh type inference variable ?ty.
 //-------------------------------------------------------------------------
 
-let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars =
+let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars doCopyTypars =
     let origTypars = declaredTyconTypars
     let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers
-    let freshTypars = copyTypars clearStaticReq origTypars
-    if rigid <> TyparRigidity.Rigid then
-        for tp in freshTypars do
-            tp.SetRigidity rigid
+    let freshTypars =
+        if doCopyTypars then
+            let typars = copyTypars clearStaticReq origTypars
+            if rigid <> TyparRigidity.Rigid then
+                for tp in typars do
+                    tp.SetRigidity rigid
+            typars
+        else
+            origTypars
 
     let renaming, tinst = FixupNewTypars m [] [] origTypars freshTypars
     let origTy = TType_app(tcref, List.map mkTyparTy origTypars, g.knownWithoutNull)
@@ -2673,11 +2678,11 @@ module EventDeclarationNormalization =
 
 /// Make a copy of the "this" type for a generic object type, e.g. List<'T> --> List<'?> for a fresh inference variable.
 /// Also adjust the "this" type to take into account whether the type is a struct.
-let FreshenObjectArgType (cenv: cenv) m rigid tcref isExtrinsic declaredTyconTypars =
+let FreshenObjectArgType (cenv: cenv) m rigid tcref isExtrinsic declaredTyconTypars (doCopyTypars: bool) =
     let g = cenv.g
 
     let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy =
-        FreshenTyconRef g m rigid tcref declaredTyconTypars
+        FreshenTyconRef g m rigid tcref declaredTyconTypars doCopyTypars
 
     // Struct members have a byref 'this' type (unless they are extrinsic extension members)
     let thisTy =
@@ -4208,7 +4213,7 @@ and TcValSpec (cenv: cenv) env declKind newOk containerInfo memFlagsOpt thisTyOp
         | Some(MemberOrValContainerInfo(tcref, _, _, _, declaredTyconTypars)) ->
             let isExtrinsic = (declKind = ExtrinsicExtensionBinding)
             let _, enclosingDeclaredTypars, _, _, thisTy =
-                FreshenObjectArgType cenv m TyparRigidity.Rigid tcref isExtrinsic declaredTyconTypars
+                FreshenObjectArgType cenv m TyparRigidity.Rigid tcref isExtrinsic declaredTyconTypars (not cenv.g.realsig)
 
             // An implemented interface type is in terms of the type's type parameters.
             // We need a signature in terms of the values' type parameters.
@@ -11894,7 +11899,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl
            CheckForNonAbstractInterface g declKind tcref memberFlags true id.idRange
 
            let isExtrinsic = (declKind = ExtrinsicExtensionBinding)
-           let tcrefObjTy, enclosingDeclaredTypars, renaming, _, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
+           let tcrefObjTy, enclosingDeclaredTypars, renaming, _, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars (not cenv.g.realsig)
            let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner
            let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic
 
@@ -11919,7 +11924,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl
             error(Error(FSComp.SR.tcConstructorsDisallowedInExceptionAugmentation(), id.idRange))
 
         let isExtrinsic = (declKind = ExtrinsicExtensionBinding)
-        let _, enclosingDeclaredTypars, _, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
+        let _, enclosingDeclaredTypars, _, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars true
         let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner
         let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic
 
@@ -12005,7 +12010,7 @@ and AnalyzeRecursiveInstanceMemberDecl
 
          // The type being augmented tells us the type of 'this'
          let isExtrinsic = (declKind = ExtrinsicExtensionBinding)
-         let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
+         let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars (not cenv.g.realsig)
 
          let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner
 

src/Compiler/Checking/Expressions/CheckExpressions.fsi

@@ -483,7 +483,8 @@ val FreshenObjectArgType:
     tcref: TyconRef ->
     isExtrinsic: bool ->
     declaredTyconTypars: Typar list ->
-        TType * Typar list * TyparInstantiation * TType * TType
+    bool ->
+    TType * Typar list * TyparInstantiation * TType * TType
 
 /// Get the accumulated module/namespace type for the current module/namespace being processed.
 val GetCurrAccumulatedModuleOrNamespaceType: env: TcEnv -> ModuleOrNamespaceType

src/Compiler/Checking/PostInferenceChecks.fs

@@ -2664,9 +2664,9 @@ and CheckModuleSpec cenv env mbind =
         let env = { env with reflect = env.reflect || HasFSharpAttribute cenv.g cenv.g.attrib_ReflectedDefinitionAttribute mspec.Attribs }
         CheckDefnInModule cenv env rhs
 
-let CheckImplFileContents cenv env implFileTy implFileContents  =
+let CheckImplFileContents cenv env implFileTy implFileContents =
     let rpi, mhi = ComputeRemappingFromImplementationToSignature cenv.g implFileContents implFileTy
-    let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: env.sigToImplRemapInfo }
+    let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi cenv.g.realsig, mhi) :: env.sigToImplRemapInfo }
     UpdatePrettyTyparNames.updateModuleOrNamespaceType implFileTy
     CheckDefnInModule cenv env implFileContents
 

src/Compiler/Checking/SignatureConformance.fs

@@ -15,6 +15,7 @@ open FSharp.Compiler.Features
 open FSharp.Compiler.InfoReader
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.SyntaxTreeOps
+open FSharp.Compiler.TcGlobals
 open FSharp.Compiler.Text
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeBasics
@@ -48,16 +49,16 @@ exception DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer of
     range: range
 
 // Use a type to capture the constant, common parameters 
-type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = 
+type Checker(g: TcGlobals, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = 
 
         // Build a remap that maps tcrefs in the signature to tcrefs in the implementation
         // Used when checking attributes.
         let sigToImplRemap = 
-            let remap = Remap.Empty 
+            let remap = {Remap.Empty with realsig = g.realsig}
             let remap = (remapInfo.RepackagedEntities, remap) ||> List.foldBack (fun (implTcref, signTcref) acc -> addTyconRefRemap signTcref implTcref acc) 
             let remap = (remapInfo.RepackagedVals, remap) ||> List.foldBack (fun (implValRef, signValRef) acc -> addValRemap signValRef.Deref implValRef.Deref acc) 
             remap
-            
+
         // For all attributable elements (types, modules, exceptions, record fields, unions, parameters, generic type parameters)
         //
         // (a)	Start with lists AImpl and ASig containing the attributes in the implementation and signature, in declaration order

src/Compiler/CodeGen/IlxGen.fs

@@ -1197,6 +1197,10 @@ and IlxGenEnv =
         /// Full list of enclosing bound values. First non-compiler-generated element is used to help give nice names for closures and other expressions.
         letBoundVars: ValRef list
 
+
+        /// nested type generic parameters for currentloc
+        nestedTypars: Zset<Typar>
+
         /// The set of IL local variable indexes currently in use by lexically scoped variables, to allow reuse on different branches.
         /// Really an integer set.
         liveLocals: IntMap<unit>
@@ -1259,7 +1263,7 @@ let AddTyparsToEnv typars (eenv: IlxGenEnv) =
 
 let AddSignatureRemapInfo _msg (rpi, mhi) eenv =
     { eenv with
-        sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: eenv.sigToImplRemapInfo
+        sigToImplRemapInfo = (mkRepackageRemapping rpi eenv.realsig, mhi) :: eenv.sigToImplRemapInfo
     }
 
 //--------------------------------------------------------------------------
@@ -1281,7 +1285,7 @@ let AddStorageForVal (g: TcGlobals) (v, s) eenv =
     if g.compilingFSharpCore then
         // Passing an empty remap is sufficient for FSharp.Core.dll because it turns out the remapped type signature can
         // still be resolved.
-        match tryRescopeVal g.fslibCcu Remap.Empty v with
+        match tryRescopeVal g.fslibCcu { Remap.Empty with realsig = g.realsig } v with
         | ValueNone -> eenv
         | ValueSome vref ->
             match vref.TryDeref with
@@ -6892,14 +6896,6 @@ and GenFreevar cenv m eenvouter tyenvinner (fv: Val) =
 and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenv takenNames expr =
     let g = cenv.g
 
-    // Choose a base name for the closure
-    let basename =
-        let boundv = eenv.letBoundVars |> List.tryFind (fun v -> not v.IsCompilerGenerated)
-
-        match boundv with
-        | Some v -> v.CompiledName cenv.g.CompilerGlobalState
-        | None -> "clo"
-
     // Get a unique stamp for the closure. This must be stable for things that can be part of a let rec.
     let uniq =
         match expr with
@@ -6909,18 +6905,28 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenv takenNames
         | _ -> newUnique ()
 
     // Choose a name for the closure
-    let ilCloTypeRef =
+    let ilCloTypeRef, initialFreeTyvars =
+        let boundvar =
+            eenv.letBoundVars |> List.tryFind (fun v -> not v.IsCompilerGenerated)
+
+        let basename =
+            match boundvar with
+            | Some v -> v.CompiledName cenv.g.CompilerGlobalState
+            | None -> "clo"
+
         // FSharp 1.0 bug 3404: System.Reflection doesn't like '.' and '`' in type names
         let basenameSafeForUseAsTypename = CleanUpGeneratedTypeName basename
 
-        let suffixmark = expr.Range
-
         let cloName =
             // Ensure that we have an g.CompilerGlobalState
             assert (g.CompilerGlobalState |> Option.isSome)
-            g.CompilerGlobalState.Value.StableNameGenerator.GetUniqueCompilerGeneratedName(basenameSafeForUseAsTypename, suffixmark, uniq)
+            g.CompilerGlobalState.Value.StableNameGenerator.GetUniqueCompilerGeneratedName(basenameSafeForUseAsTypename, expr.Range, uniq)
+
+        let ilCloTypeRef = NestedTypeRefForCompLoc eenv.cloc cloName
+
+        let initialFreeTyvars = { emptyFreeTyvars with FreeTypars = eenv.nestedTypars }
 
-        NestedTypeRefForCompLoc eenv.cloc cloName
+        ilCloTypeRef, initialFreeTyvars
 
     // Collect the free variables of the closure
     let cloFreeVarResults =
@@ -6931,7 +6937,8 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenv takenNames
             | None -> opts
             | Some(tcref, _, typars, _) -> opts.WithTemplateReplacement(tyconRefEq g tcref, typars)
 
-        freeInExpr opts expr
+        //freeInExpr opts expr
+        accFreeInExpr opts expr { emptyFreeVars with FreeTyvars = initialFreeTyvars }
 
     // Partition the free variables when some can be accessed from places besides the immediate environment
     // Also filter out the current value being bound, if any, as it is available from the "this"
@@ -8166,7 +8173,7 @@ and GenLetRecFixup cenv cgbuf eenv (ilxCloSpec: IlxClosureSpec, e, ilField: ILFi
     CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld (mkILFieldSpec (ilField.FieldRef, ilxCloSpec.ILType)))
 
 /// Generate letrec bindings
-and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) (dict: Dictionary<Stamp, ILTypeRef> option) =
+and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) (dict: Dictionary<Stamp, Entity * ILTypeRef> option) =
 
     // 'let rec' bindings are always considered to be in loops, that is each may have backward branches for the
     // tailcalls back to the entry point. This means we don't rely on zero-init of mutable locals
@@ -8320,7 +8327,8 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) (
                     ||> List.fold (fun forwardReferenceSet (bind: Binding) ->
                         GenBinding cenv cgbuf eenv bind false
                         updateForwardReferenceSet bind forwardReferenceSet)
-                | true, tref ->
+                | true, (tc, tref) ->
+                    let eenv = { eenv with nestedTypars = (eenv.nestedTypars |> Zset.addList tc.TyparsNoRange) }
                     CodeGenInitMethod
                         cenv
                         cgbuf
@@ -10250,7 +10258,7 @@ and GenModuleOrNamespaceContents cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo
     | TMDefRec(_isRec, opens, tycons, mbinds, m) ->
         let eenvinner = AddDebugImportsToEnv cenv eenv opens
 
-        let dict = Some(Dictionary<Stamp, ILTypeRef>())
+        let dict = Some(Dictionary<Stamp, Entity * ILTypeRef>())
 
         for tc in tycons do
             let optTref =
@@ -10260,7 +10268,7 @@ and GenModuleOrNamespaceContents cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo
                     GenTypeDef cenv cgbuf.mgbuf lazyInitInfo eenv m tc
 
             match optTref with
-            | Some tref -> dict.Value.Add(tc.Stamp, tref)
+            | Some tref -> dict.Value.Add(tc.Stamp, (tc, tref))
             | None -> ()
 
         // Generate chunks of non-nested bindings together to allow recursive fixups.
@@ -11984,6 +11992,7 @@ let GetEmptyIlxGenEnv (g: TcGlobals) ccu =
         someTypeInThisAssembly = g.ilg.typ_Object // dummy value
         isFinalFile = false
         letBoundVars = []
+        nestedTypars = Zset.empty typarOrder
         liveLocals = IntMap.empty ()
         innerVals = []
         sigToImplRemapInfo = [] (* "module remap info" *)

src/Compiler/Driver/fsc.fs

@@ -841,7 +841,7 @@ let main3
     =
     // Encode the signature data
     ReportTime tcConfig "Encode Interface Data"
-    let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents
+    let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents tcConfig.realsig
 
     let sigDataAttributes, sigDataResources =
         try

src/Compiler/Optimize/Optimizer.fs

@@ -588,7 +588,7 @@ let BindExternalLocalVal cenv (v: Val) vval env =
         if g.compilingFSharpCore then 
             // Passing an empty remap is sufficient for FSharp.Core.dll because it turns out the remapped type signature can
             // still be resolved.
-            match tryRescopeVal g.fslibCcu Remap.Empty v with 
+            match tryRescopeVal g.fslibCcu {Remap.Empty with realsig = g.realsig} v with 
             | ValueSome vref -> BindValueForFslib vref.nlr v vval env 
             | _ -> env
         else env
@@ -1523,8 +1523,8 @@ let RemapOptimizationInfo g tmenv =
     remapLazyModulInfo
 
 /// Hide information when a value is no longer visible
-let AbstractAndRemapModulInfo g (repackage, hidden) info =
-    let mrpi = mkRepackageRemapping repackage
+let AbstractAndRemapModulInfo (g: TcGlobals) (repackage, hidden) info =
+    let mrpi = mkRepackageRemapping repackage g.realsig
     let info = info |> AbstractLazyModulInfoByHiding false hidden
     let info = info |> RemapOptimizationInfo g mrpi
     info

src/Compiler/Service/IncrementalBuild.fs

@@ -634,9 +634,9 @@ module Utilities =
 /// as a cross-assembly reference.  Note the assembly has not been generated on disk, so this is
 /// a virtualized view of the assembly contents as computed by background checking.
 [<Sealed>]
-type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, generatedCcu: CcuThunk, outfile, topAttrs, assemblyName, ilAssemRef) =
+type RawFSharpAssemblyDataBackedByLanguageService (tcConfig: TcConfig, tcGlobals, generatedCcu: CcuThunk, outfile, topAttrs, assemblyName, ilAssemRef) =
 
-    let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents
+    let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents tcConfig.realsig
 
     let sigData =
         let _sigDataAttributes, sigDataResources = EncodeSignatureData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, true)

src/Compiler/TypedTree/CompilerGlobalState.fs

@@ -73,4 +73,6 @@ let newUnique() = System.Threading.Interlocked.Increment &uniqueCount
 /// Unique name generator for stamps attached to to val_specs, tycon_specs etc.
 //++GLOBAL MUTABLE STATE (concurrency-safe)
 let mutable private stampCount = 0L
-let newStamp() = System.Threading.Interlocked.Increment &stampCount
+let newStamp() =
+    let x = System.Threading.Interlocked.Increment &stampCount
+    x