[WIP] Add Reference Assembly support

src/fsharp/CompilerConfig.fs

@@ -317,6 +317,13 @@ type PackageManagerLine =
     static member StripDependencyManagerKey (packageKey: string) (line: string): string =
         line.Substring(packageKey.Length + 1).Trim()
 
+[<RequireQualifiedAccess>]
+type ReferenceAssemblyGeneration =
+    | None
+    | Complete
+    | Partial
+    | Test
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     {
@@ -429,6 +436,7 @@ type TcConfigBuilder =
       mutable emitTailcalls: bool
       mutable deterministic: bool
       mutable concurrentBuild: bool
+      mutable emitReferenceAssemblyOnly: ReferenceAssemblyGeneration
       mutable preferredUiLang: string option
       mutable lcid: int option
       mutable productNameForBannerText: string
@@ -634,6 +642,7 @@ type TcConfigBuilder =
           emitTailcalls = true
           deterministic = false
           concurrentBuild = true
+          emitReferenceAssemblyOnly = ReferenceAssemblyGeneration.None
           preferredUiLang = None
           lcid = None
           productNameForBannerText = FSharpProductName
@@ -1014,6 +1023,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member x.emitTailcalls = data.emitTailcalls
     member x.deterministic = data.deterministic
     member x.concurrentBuild = data.concurrentBuild
+    member x.emitReferenceAssemblyOnly = data.emitReferenceAssemblyOnly
     member x.pathMap = data.pathMap
     member x.langVersion = data.langVersion
     member x.preferredUiLang = data.preferredUiLang

src/fsharp/CompilerConfig.fsi

@@ -130,6 +130,16 @@ type PackageManagerLine =
     static member SetLinesAsProcessed: string -> Map<string, PackageManagerLine list> -> Map<string, PackageManagerLine list>
     static member StripDependencyManagerKey: string -> string -> string
 
+[<RequireQualifiedAccess>]
+type ReferenceAssemblyGeneration =
+    | None
+    /// Complete means we include F# signature and optimization metadata as resources in the emitting assembly.
+    | Complete
+    /// Partial means we do not include F# optimization metadata as a resource in the emitting assembly.
+    | Partial
+    /// This is only for used for testing.
+    | Test
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     { mutable primaryAssembly: PrimaryAssembly
@@ -236,6 +246,7 @@ type TcConfigBuilder =
       mutable emitTailcalls: bool
       mutable deterministic: bool
       mutable concurrentBuild: bool
+      mutable emitReferenceAssemblyOnly: ReferenceAssemblyGeneration
       mutable preferredUiLang: string option
       mutable lcid        : int option
       mutable productNameForBannerText: string
@@ -426,6 +437,7 @@ type TcConfig =
     member emitTailcalls: bool
     member deterministic: bool
     member concurrentBuild: bool
+    member emitReferenceAssemblyOnly: ReferenceAssemblyGeneration
     member pathMap: PathMap
     member preferredUiLang: string option
     member optsOn       : bool 

src/fsharp/CompilerOptions.fs

@@ -411,6 +411,9 @@ let SetTailcallSwitch (tcConfigB: TcConfigBuilder) switch =
 let SetDeterministicSwitch (tcConfigB: TcConfigBuilder) switch =
     tcConfigB.deterministic <- (switch = OptionSwitch.On)
 
+let SetReferenceAssemblyOnlySwitch (tcConfigB: TcConfigBuilder) switch =
+    tcConfigB.emitReferenceAssemblyOnly <- if (switch = OptionSwitch.On) then ReferenceAssemblyGeneration.Complete else ReferenceAssemblyGeneration.None
+
 let AddPathMapping (tcConfigB: TcConfigBuilder) (pathPair: string) =
     match pathPair.Split([|'='|], 2) with
     | [| oldPrefix; newPrefix |] ->
@@ -816,6 +819,11 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) =
             OptionSwitch (SetDeterministicSwitch tcConfigB), None,
             Some (FSComp.SR.optsDeterministic()))
 
+          CompilerOption
+           ("refonly", tagNone,
+            OptionSwitch (SetReferenceAssemblyOnlySwitch tcConfigB), None,
+            Some (FSComp.SR.optsRefOnly()))
+
           CompilerOption
            ("pathmap", tagPathMap,
             OptionStringList (AddPathMapping tcConfigB), None,
@@ -1046,6 +1054,8 @@ let testFlag tcConfigB =
                 | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true
                 | "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true
                 | "ParallelOff" -> tcConfigB.concurrentBuild <- false
+                | "RefOnlyWithoutOpt" -> tcConfigB.emitReferenceAssemblyOnly <- ReferenceAssemblyGeneration.Partial
+                | "RefOnlyMockTypedImplFile" -> tcConfigB.emitReferenceAssemblyOnly <- ReferenceAssemblyGeneration.Test
 #if DEBUG
                 | "ShowParserStackOnParseError" -> showParserStackOnParseError <- true
 #endif

src/fsharp/FSComp.txt

@@ -871,6 +871,7 @@ optsDebug,"Specify debugging type: full, portable, embedded, pdbonly. ('%s' is t
 optsOptimize,"Enable optimizations (Short form: -O)"
 optsTailcalls,"Enable or disable tailcalls"
 optsDeterministic,"Produce a deterministic assembly (including module version GUID and timestamp)"
+optsRefOnly,"Produce a reference assembly, instead of a full assembly, as the primary output"
 optsPathMap,"Maps physical paths to source path names output by the compiler"
 optsCrossoptimize,"Enable or disable cross-module optimizations"
 optsWarnaserrorPM,"Report all warnings as errors"

src/fsharp/IlxGen.fs

@@ -74,6 +74,12 @@ let mkLdfldMethodDef (ilMethName, reprAccess, isStatic, ilTy, ilFieldName, ilPro
            mkILNonGenericInstanceMethod (ilMethName, reprAccess, [], ilReturn, mkMethodBody (true, [], 2, nonBranchingInstrsToCode [ mkLdarg0; mkNormalLdfld ilFieldSpec], None))
    ilMethodDef.WithSpecialName
 
+let ilThrowNullInstrs = [|ILInstr.AI_ldnull; ILInstr.I_throw|]
+let emptyDict = Dictionary()
+let mkILThrowNullMethodBody name =
+    let ilCode = IL.buildILCode name emptyDict ilThrowNullInstrs [] []
+    mkILMethodBody(false, ILLocals.Empty, 0, ilCode, None)
+
 /// Choose the constructor parameter names for fields
 let ChooseParamNames fieldNamesAndTypes =
     let takenFieldNames = fieldNamesAndTypes |> List.map p23 |> Set.ofList
@@ -213,7 +219,10 @@ type IlxGenOptions =
       isInteractiveItExpr: bool
 
       /// Whenever possible, use callvirt instead of call
-      alwaysCallVirt: bool 
+      alwaysCallVirt: bool
+
+      /// Indicates that we are only generating a reference assembly.
+      referenceAssemblyOnly: bool
     }
 
 /// Compilation environment for compiling a fragment of an assembly
@@ -253,6 +262,9 @@ type cenv =
 
       /// Delayed Method Generation - prevents stack overflows when we need to generate methods that are split into many methods by the optimizer.
       delayedGenMethods: Queue<cenv -> unit>
+
+      /// Indicates that the generating assembly will have an assembly-level attribute, System.Runtime.CompilerServices.InternalsVisibleToAttribute.
+      hasInternalsVisibleToAttr: bool
     }
 
     override x.ToString() = "<cenv>"
@@ -6130,6 +6142,14 @@ and GenMethodForBinding
          ctorThisValOpt, baseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, returnTy) =
     let g = cenv.g
     let m = v.Range
+
+    // When emitting a reference assembly, do not emit methods that are private unless they are virtual/abstract or provide an explicit interface implementation.
+    // Internal methods can be omitted only if the assembly does not contain a System.Runtime.CompilerServices.InternalsVisibleToAttribute.
+    if cenv.opts.referenceAssemblyOnly && 
+       (access = ILMemberAccess.Private || 
+        ((access = ILMemberAccess.Assembly || access = ILMemberAccess.FamilyAndAssembly) && not cenv.hasInternalsVisibleToAttr)) && 
+       not (v.IsOverrideOrExplicitImpl || v.IsDispatchSlot) then ()
+    else
 
     // If a method has a witness-passing version of the code, then suppress
     // the generation of any witness in the non-witness passing version of the code
@@ -6212,10 +6232,16 @@ and GenMethodForBinding
                 else
                     body
 
-            let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel)
+            if cenv.opts.referenceAssemblyOnly then
+                // The reason for using 'throw null' bodies (as opposed to no bodies) is so 
+                // that PEVerify can run and pass (thus validating the completeness of the metadata).
+                let ilMethBody = mkILThrowNullMethodBody mspec.Name
+                false, MethodBody.IL(notlazy ilMethBody), false
+            else
+                let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel)
 
-            // This is the main code generation for most methods
-            false, MethodBody.IL(ilCodeLazy), false
+                // This is the main code generation for most methods
+                false, MethodBody.IL(ilCodeLazy), false
 
     match ilMethodBody with
     | MethodBody.IL(ilCodeLazy) ->
@@ -8065,6 +8091,20 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization impl
     // Generate the whole assembly
     CodegenAssembly cenv eenv mgbuf implFiles
 
+    let assemAttribs =
+        // Emit System.Runtime.CompilerServices.ReferenceAssemblyAttribute as an assembly-level when generating a reference assembly.
+        // Useful for the runtime to know that the assembly is a reference assembly.
+        if cenv.opts.referenceAssemblyOnly && g.attrib_ReferenceAssemblyAttribute.TyconRef.CanDeref then
+            let ilRefAsmAttribMethRef =
+                let ilTyRef = g.attrib_ReferenceAssemblyAttribute.TypeRef
+                let ilTySpec = mkILTySpec(ilTyRef, [])
+                let ilMethSpec = mkILCtorMethSpecForTy(mkILBoxedType ilTySpec, [])
+                ilMethSpec.MethodRef
+            let refAsmAttrib = Attrib(g.attrib_ReferenceAssemblyAttribute.TyconRef, AttribKind.ILAttrib ilRefAsmAttribMethRef, [], [], false, None, range0)
+            refAsmAttrib :: assemAttribs
+        else
+            assemAttribs
+
     let ilAssemAttrs = GenAttrs cenv eenv assemAttribs
 
     let tdefs, reflectedDefinitions = mgbuf.Close()
@@ -8249,6 +8289,8 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai
 
     /// Generate ILX code for an assembly fragment
     member _.GenerateCode (codeGenOpts, typedAssembly, assemAttribs, moduleAttribs) =
+        let hasInternalsVisibleToAttr = HasFSharpAttribute tcGlobals tcGlobals.attrib_InternalsVisibleToAttribute assemAttribs
+
         let cenv: cenv =
             { g=tcGlobals
               tcVal = tcVal
@@ -8260,7 +8302,8 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai
               opts = codeGenOpts
               optimizeDuringCodeGen = (fun _flag expr -> expr)
               exprRecursionDepth = 0
-              delayedGenMethods = Queue () }
+              delayedGenMethods = Queue ()
+              hasInternalsVisibleToAttr = hasInternalsVisibleToAttr }
         GenerateCode (cenv, anonTypeTable, ilxGenEnv, typedAssembly, assemAttribs, moduleAttribs)
 
     /// Invert the compilation of the given value and clear the storage of the value

src/fsharp/IlxGen.fsi

@@ -52,6 +52,9 @@ type internal IlxGenOptions =
 
       /// Indicates that, whenever possible, use callvirt instead of call
       alwaysCallVirt: bool
+
+      /// Indicates that we are only generating a reference assembly.
+      referenceAssemblyOnly: bool
     }
 
 /// The results of the ILX compilation of one fragment of an assembly

src/fsharp/OptimizeInputs.fs

@@ -178,7 +178,8 @@ let GenerateIlxCode
           ilxBackend = ilxBackend
           isInteractive = tcConfig.isInteractive
           isInteractiveItExpr = isInteractiveItExpr
-          alwaysCallVirt = tcConfig.alwaysCallVirt }
+          alwaysCallVirt = tcConfig.alwaysCallVirt
+          referenceAssemblyOnly = tcConfig.emitReferenceAssemblyOnly <> ReferenceAssemblyGeneration.None }
 
     ilxGenerator.GenerateCode (ilxGenOpts, optimizedImpls, topAttrs.assemblyAttrs, topAttrs.netModuleAttrs) 
 

src/fsharp/ParseAndCheckInputs.fs

@@ -37,6 +37,7 @@ open FSharp.Compiler.Text.Range
 open FSharp.Compiler.Xml
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeOps
+open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TcGlobals
 
 let CanonicalizeFilename filename = 
@@ -755,6 +756,115 @@ let GetInitialTcState(m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcIm
       tcsRootImpls = Zset.empty qnameOrder
       tcsCcuSig = Construct.NewEmptyModuleOrNamespaceType Namespace }
 
+let mkDummyParameterVal name attribs ty =
+    Construct.NewVal(
+        name, range0, None, ty, ValMutability.Immutable, false, None, taccessPublic,
+        ValRecursiveScopeInfo.ValNotInRecScope, None, ValBaseOrThisInfo.NormalVal, attribs, ValInline.Never,
+        XmlDoc.Empty, false, false, false, false, false, false, None, ParentNone)
+
+let rec createDummyModuleOrNamespaceExpr (g: TcGlobals) (mty: ModuleOrNamespaceType) =
+
+    let dummyValAsBinding (v: Val) =
+        let dummyExpr =
+            // It does not matter what this expression is as it will never get checked or emitted.
+            let retDummyExpr = Expr.Op(TOp.Return, [], [], range0)
+
+            if isFunTy g v.Type || isForallFunctionTy g v.Type then
+                match v.ValReprInfo with
+                | Some valReprInfo ->
+                    let memberFlags =
+                        match v.MemberInfo with
+                        | Some memberInfo -> memberInfo.MemberFlags
+                        | _ ->
+                            {
+                                SynMemberFlags.IsInstance = false
+                                IsDispatchSlot = false
+                                IsOverrideOrExplicitImpl = false
+                                IsFinal = false
+                                MemberKind = SynMemberKind.Member
+                            }
+
+                    let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v
+                    let typars, _, curriedArgInfos, retTy, _retInfo = GetMemberTypeInMemberForm g memberFlags valReprInfo numEnclosingTypars v.Type v.Range
+                    let retTy =
+                        retTy
+                        |> Option.defaultValue g.unit_ty
+
+                    let valParams =
+                        curriedArgInfos
+                        |> List.map (fun argInfos ->
+                            argInfos
+                            |> List.map (fun (ty, argInfo) ->
+                                let name =
+                                    argInfo.Name
+                                    |> Option.map (fun x -> x.idText)
+                                    |> Option.defaultValue ""
+                                mkDummyParameterVal name argInfo.Attribs ty
+                            )
+                        )
+
+                    if valParams.IsEmpty || (valParams.Length = 1 && valParams.Head.IsEmpty) then
+                        // We have to create a lambda like this as `mkMemberLambdas` will throw if it is passed
+                        // a single empty curried argument list.
+                        Expr.Lambda(newUnique(), None, None, [], retDummyExpr, range0, retTy)
+                    else
+                        mkMemberLambdas range0 typars None None valParams (retDummyExpr, retTy)
+                | _ ->
+                    failwith "Expected top-level val"
+            else
+                retDummyExpr
+        mkBind DebugPointAtBinding.NoneAtLet v dummyExpr
+
+    let dummyValAsModuleOrNamespaceExpr (v: Val) =
+        ModuleOrNamespaceExpr.TMDefLet(dummyValAsBinding v, range0)
+
+    let dummyValAsModuleOrNamespaceExprs (vs: Val seq) =
+        vs
+        |> Seq.map dummyValAsModuleOrNamespaceExpr
+
+    let dummyEntityAsModuleOrNamespaceBinding (ent: Entity) =
+        ModuleOrNamespaceBinding.Module(ent, createDummyModuleOrNamespaceExpr g ent.ModuleOrNamespaceType)
+
+    let dummyEntitiesAsModuleOrNamespaceBindings (ents: Entity seq) =
+        ents
+        |> Seq.map dummyEntityAsModuleOrNamespaceBinding
+
+    let entBindings =
+        mty.ModuleAndNamespaceDefinitions
+        |> dummyEntitiesAsModuleOrNamespaceBindings
+        |> List.ofSeq
+
+    let tycons = mty.TypeAndExceptionDefinitions
+
+    let dummyExprs = 
+        dummyValAsModuleOrNamespaceExprs mty.AllValsAndMembers 
+        |> List.ofSeq
+
+    let dummyExprs =
+        if entBindings.IsEmpty && tycons.IsEmpty then
+            dummyExprs
+        else
+            ModuleOrNamespaceExpr.TMDefRec(false, tycons, entBindings, range0) :: dummyExprs
+
+    ModuleOrNamespaceExpr.TMDefs dummyExprs
+
+let createDummyModuleOrNamespaceExprWithSig g (sigTy: ModuleOrNamespaceType) =
+    let dummyExpr = createDummyModuleOrNamespaceExpr g sigTy
+    ModuleOrNamespaceExprWithSig(sigTy, ModuleOrNamespaceExpr.TMDefs [dummyExpr], range0)
+
+/// Similar to 'createDummyTypedImplFile', only diffference is that there are no definitions and is not used for emitting any kind of assembly.
+let createEmptyDummyTypedImplFile qualNameOfFile sigTy =
+    let dummyExpr = ModuleOrNamespaceExprWithSig.ModuleOrNamespaceExprWithSig(sigTy, ModuleOrNamespaceExpr.TMDefs [], range0)
+    TypedImplFile.TImplFile(qualNameOfFile, [], dummyExpr, false, false, StampMap.Empty)
+
+/// 'dummy' in this context means it acts as a placeholder so other parts of the compiler will work with it.
+/// In this case, this is used to create a typed impl file based on a signature so we can emit a partial reference assembly
+///     for tooling, IDEs, etc - without having to actually check an implementation file.
+/// An example of this use would be for other .NET languages wanting cross-project referencing with F# as they require an assembly.
+let createDummyTypedImplFile g qualNameOfFile sigTy =
+    let exprWithSig = createDummyModuleOrNamespaceExprWithSig g sigTy
+    TypedImplFile.TImplFile(qualNameOfFile, [], exprWithSig, false, false, StampMap.Empty)
+
 /// Typecheck a single file (or interactive entry into F# Interactive)
 let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixPathOpt, tcSink, tcState: TcState, inp: ParsedInput, skipImplIfSigExists: bool) =
 
@@ -823,17 +933,20 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports:
               // Typecheck the implementation file 
               let typeCheckOne = 
                   if skipImplIfSigExists && hadSig then
-                    let dummyExpr = ModuleOrNamespaceExprWithSig.ModuleOrNamespaceExprWithSig(rootSigOpt.Value, ModuleOrNamespaceExpr.TMDefs [], range.Zero)
-                    let dummyImplFile = TypedImplFile.TImplFile(qualNameOfFile, [], dummyExpr, false, false, StampMap [])
-
-                    (EmptyTopAttrs, dummyImplFile, Unchecked.defaultof<_>, tcImplEnv, false)
+                    (EmptyTopAttrs, createEmptyDummyTypedImplFile qualNameOfFile rootSigOpt.Value, Unchecked.defaultof<_>, tcImplEnv, false)
                     |> Eventually.Done
                   else
                     TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring) tcImplEnv rootSigOpt file
 
-              let! topAttrs, implFile, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = typeCheckOne
+              let! topAttrs, implFile0, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = typeCheckOne
+
+              let implFileSigType = SigTypeOfImplFile implFile0
 
-              let implFileSigType = SigTypeOfImplFile implFile
+              let implFile =
+                if tcConfig.emitReferenceAssemblyOnly = ReferenceAssemblyGeneration.Test then
+                    createDummyTypedImplFile tcGlobals qualNameOfFile implFileSigType
+                else
+                    implFile0
 
               let rootImpls = Zset.add qualNameOfFile tcState.tcsRootImpls