Add Reference Assembly support - 'refonly' and 'refout' compiler options

eng/test-determinism.cmd

@@ -1,2 +1,2 @@
 @echo off
-powershell -noprofile -executionPolicy RemoteSigned -file "%~dp0\test-determinism.ps1" %*
+powershell -noprofile -executionPolicy RemoteSigned -file "%~dp0\test-determinism.ps1" %*

src/fsharp/CompilerConfig.fs

@@ -328,6 +328,12 @@ type PackageManagerLine =
     static member StripDependencyManagerKey (packageKey: string) (line: string): string =
         line.Substring(packageKey.Length + 1).Trim()
 
+[<RequireQualifiedAccess>]
+type MetadataAssemblyGeneration =
+    | None
+    | ReferenceOut of outputPath: string
+    | ReferenceOnly
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     {
@@ -441,6 +447,7 @@ type TcConfigBuilder =
       mutable emitTailcalls: bool
       mutable deterministic: bool
       mutable concurrentBuild: bool
+      mutable emitMetadataAssembly: MetadataAssemblyGeneration
       mutable preferredUiLang: string option
       mutable lcid: int option
       mutable productNameForBannerText: string
@@ -654,6 +661,7 @@ type TcConfigBuilder =
           emitTailcalls = true
           deterministic = false
           concurrentBuild = true
+          emitMetadataAssembly = MetadataAssemblyGeneration.None
           preferredUiLang = None
           lcid = None
           productNameForBannerText = FSharpProductName
@@ -1121,6 +1129,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.emitMetadataAssembly = data.emitMetadataAssembly
     member x.pathMap = data.pathMap
     member x.langVersion = data.langVersion
     member x.preferredUiLang = data.preferredUiLang

src/fsharp/CompilerConfig.fsi

@@ -143,6 +143,16 @@ type PackageManagerLine =
     static member SetLinesAsProcessed: string -> Map<string, PackageManagerLine list> -> Map<string, PackageManagerLine list>
     static member StripDependencyManagerKey: string -> string -> string
 
+[<RequireQualifiedAccess>]
+type MetadataAssemblyGeneration =
+    | None
+    /// Includes F# signature and optimization metadata as resources in the emitting assembly.
+    /// Implementation assembly will still be emitted normally, but will emit the reference assembly with the specified output path. 
+    | ReferenceOut of outputPath: string
+    /// Includes F# signature and optimization metadata as resources in the emitting assembly.
+    /// Only emits the assembly as a reference assembly.
+    | ReferenceOnly
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     { mutable primaryAssembly: PrimaryAssembly
@@ -256,6 +266,7 @@ type TcConfigBuilder =
       mutable emitTailcalls: bool
       mutable deterministic: bool
       mutable concurrentBuild: bool
+      mutable emitMetadataAssembly: MetadataAssemblyGeneration
       mutable preferredUiLang: string option
       mutable lcid        : int option
       mutable productNameForBannerText: string
@@ -452,6 +463,7 @@ type TcConfig =
     member emitTailcalls: bool
     member deterministic: bool
     member concurrentBuild: bool
+    member emitMetadataAssembly: MetadataAssemblyGeneration
     member pathMap: PathMap
     member preferredUiLang: string option
     member optsOn       : bool

src/fsharp/CompilerOptions.fs

@@ -406,6 +406,23 @@ let SetTailcallSwitch (tcConfigB: TcConfigBuilder) switch =
 let SetDeterministicSwitch (tcConfigB: TcConfigBuilder) switch =
     tcConfigB.deterministic <- (switch = OptionSwitch.On)
 
+let SetReferenceAssemblyOnlySwitch (tcConfigB: TcConfigBuilder) switch =
+    match tcConfigB.emitMetadataAssembly with
+    | MetadataAssemblyGeneration.None ->
+        tcConfigB.emitMetadataAssembly <- if (switch = OptionSwitch.On) then MetadataAssemblyGeneration.ReferenceOnly else MetadataAssemblyGeneration.None
+    | _ ->
+        error(Error(FSComp.SR.optsInvalidRefAssembly(), rangeCmdArgs))
+
+let SetReferenceAssemblyOutSwitch (tcConfigB: TcConfigBuilder) outputPath =
+    match tcConfigB.emitMetadataAssembly with
+    | MetadataAssemblyGeneration.None ->      
+        if FileSystem.IsInvalidPathShim outputPath then
+            error(Error(FSComp.SR.optsInvalidRefOut(), rangeCmdArgs))
+        else
+            tcConfigB.emitMetadataAssembly <- MetadataAssemblyGeneration.ReferenceOut outputPath
+    | _ ->
+        error(Error(FSComp.SR.optsInvalidRefAssembly(), rangeCmdArgs))
+
 let AddPathMapping (tcConfigB: TcConfigBuilder) (pathPair: string) =
     match pathPair.Split([|'='|], 2) with
     | [| oldPrefix; newPrefix |] ->
@@ -723,6 +740,16 @@ let outputFileFlagsFsc (tcConfigB: TcConfigBuilder) =
            ("nocopyfsharpcore", tagNone,
             OptionUnit (fun () -> tcConfigB.copyFSharpCore <- CopyFSharpCoreFlag.No), None,
             Some (FSComp.SR.optsNoCopyFsharpCore()))
+
+        CompilerOption
+           ("refonly", tagNone,
+            OptionSwitch (SetReferenceAssemblyOnlySwitch tcConfigB), None,
+            Some (FSComp.SR.optsRefOnly()))
+
+        CompilerOption
+           ("refout", tagFile,
+            OptionString (SetReferenceAssemblyOutSwitch tcConfigB), None,
+            Some (FSComp.SR.optsRefOut()))
     ]
 
 

src/fsharp/FSComp.txt

@@ -874,6 +874,8 @@ 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"
+optsRefOut,"Produce a reference assembly with the specified file path."
 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"
@@ -1168,6 +1170,8 @@ fscTooManyErrors,"Exiting - too many errors"
 2026,fscDeterministicDebugRequiresPortablePdb,"Deterministic builds only support portable PDBs (--debug:portable or --debug:embedded)"
 2027,fscPathMapDebugRequiresPortablePdb,"--pathmap can only be used with portable PDBs (--debug:portable or --debug:embedded)"
 2028,optsInvalidPathMapFormat,"Invalid path map. Mappings must be comma separated and of the format 'path=sourcePath'"
+2029,optsInvalidRefOut,"Invalid reference assembly path'"
+2030,optsInvalidRefAssembly,"Invalid use of emitting a reference assembly, do not use '--staticlink', or '--refonly' and '--refout' together."
 3000,etIllegalCharactersInNamespaceName,"Character '%s' is not allowed in provided namespace name '%s'"
 3001,etNullOrEmptyMemberName,"The provided type '%s' returned a member with a null or empty member name"
 3002,etNullMember,"The provided type '%s' returned a null member"

src/fsharp/IlxGen.fs

@@ -4875,8 +4875,8 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel
                   ILFieldDef(name = templateFld.LogicalName, fieldType = fty, attributes = enum 0, data = None, literalValue = None, offset = None, marshal = None, customAttrs = mkILCustomAttrs [])
                       .WithAccess(access)
                       .WithStatic(false)
-              yield fdef 
-                
+              yield fdef
+
           // Fields for captured variables
           for ilCloFreeVar in ilCloFreeVars do
               let access = ComputeMemberAccess false
@@ -4901,6 +4901,7 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel
                   nestedTypes = emptyILTypeDefs,
                   implements = ilInterfaceTys,
                   extends = Some super,
+                  isKnownToBeAttribute = false,
                   securityDecls = emptyILSecurityDecls)
             .WithSealed(true)
             .WithSpecialName(true)
@@ -5137,6 +5138,7 @@ and GenClosureTypeDefs cenv (tref: ILTypeRef, ilGenParams, attrs, ilCloAllFreeVa
               nestedTypes=emptyILTypeDefs,
               implements = ilIntfTys,
               extends= Some ext,
+              isKnownToBeAttribute=false,
               securityDecls= emptyILSecurityDecls)
         .WithSealed(true)
         .WithSerializable(true)
@@ -8298,6 +8300,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
                    else
                        ILTypeInit.BeforeField
 
+               let isKnownToBeAttribute = ExistsSameHeadTypeInHierarchy g cenv.amap m super g.mk_Attribute_ty
+
                let tdef = mkILGenericClass (ilTypeName, access, ilGenParams, ilBaseTy, ilIntfTys,
                                             mkILMethods ilMethods, ilFields, emptyILTypeDefs, ilProperties, ilEvents, mkILCustomAttrs ilAttrs,
                                             typeDefTrigger)
@@ -8310,7 +8314,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
                        .WithSerializable(isSerializable)
                        .WithAbstract(isAbstract)
                        .WithImport(isComInteropTy g thisTy)
-                       .With(methodImpls=mkILMethodImpls methodImpls)
+                       .With(methodImpls=mkILMethodImpls methodImpls, isKnownToBeAttribute=isKnownToBeAttribute)
 
                let tdLayout, tdEncoding =
                     match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with
@@ -8423,6 +8427,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
                              nestedTypes=emptyILTypeDefs,
                              implements = ilIntfTys,
                              extends= Some (if tycon.IsStructOrEnumTycon then g.iltyp_ValueType else g.ilg.typ_Object),
+                             isKnownToBeAttribute=false,
                              securityDecls= emptyILSecurityDecls)
                          .WithLayout(layout)
                          .WithSerializable(isSerializable)
@@ -8847,4 +8852,4 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai
     member _.ForceSetGeneratedValue (ctxt, v, value: obj) = SetGeneratedValue ctxt tcGlobals ilxGenEnv true v value
 
     /// Invert the compilation of the given value and return its current dynamic value and its compiled System.Type
-    member _.LookupGeneratedValue (ctxt, v) = LookupGeneratedValue amap ctxt ilxGenEnv v
+    member _.LookupGeneratedValue (ctxt, v) = LookupGeneratedValue amap ctxt ilxGenEnv v

src/fsharp/ParseAndCheckInputs.fs

@@ -36,6 +36,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 =
@@ -827,6 +828,11 @@ let GetInitialTcState(m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcIm
       tcsImplicitOpenDeclarations = openDecls0
     }
 
+/// Dummy typed impl file that contains no definitions and is not used for emitting any kind of assembly.
+let CreateEmptyDummyTypedImplFile qualNameOfFile sigTy =
+    let dummyExpr = ModuleOrNamespaceExprWithSig.ModuleOrNamespaceExprWithSig(sigTy, ModuleOrNamespaceExpr.TMDefs [], range.Zero)
+    TypedImplFile.TImplFile(qualNameOfFile, [], dummyExpr, false, false, StampMap [], Map.empty)
+
 /// Typecheck a single file (or interactive entry into F# Interactive)
 let CheckOneInput
     (
@@ -906,10 +912,7 @@ let CheckOneInput
               // 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 [], Map.empty)
-
-                    (EmptyTopAttrs, dummyImplFile, Unchecked.defaultof<_>, tcImplEnv, false)
+                    (EmptyTopAttrs, CreateEmptyDummyTypedImplFile qualNameOfFile rootSigOpt.Value, Unchecked.defaultof<_>, tcImplEnv, false)
                     |> Cancellable.ret
                   else
                     CheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, tcState.tcsImplicitOpenDeclarations, checkForErrors, conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring, tcImplEnv, rootSigOpt, file)

src/fsharp/StaticLinking.fs

@@ -357,6 +357,11 @@ let StaticLink (ctok, tcConfig: TcConfig, tcImports: TcImports, ilGlobals: ILGlo
         id
     else
         (fun ilxMainModule  ->
+            match tcConfig.emitMetadataAssembly with
+            | MetadataAssemblyGeneration.None -> ()
+            | _ ->
+                error(Error(FSComp.SR.optsInvalidRefAssembly(), rangeCmdArgs))
+
             ReportTime tcConfig "Find assembly references"
 
             let dependentILModules = FindDependentILModulesForStaticLinking (ctok, tcConfig, tcImports, ilGlobals, ilxMainModule)

src/fsharp/TcGlobals.fs

@@ -170,6 +170,8 @@ let tname_RuntimeFieldHandle = "System.RuntimeFieldHandle"
 [<Literal>]
 let tname_CompilerGeneratedAttribute = "System.Runtime.CompilerServices.CompilerGeneratedAttribute"
 [<Literal>]
+let tname_ReferenceAssemblyAttribute = "System.Runtime.CompilerServices.ReferenceAssemblyAttribute"
+[<Literal>]
 let tname_DebuggableAttribute = "System.Diagnostics.DebuggableAttribute"
 [<Literal>]
 let tname_AsyncCallback = "System.AsyncCallback"
@@ -1197,7 +1199,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   member val system_Nullable_tcref = v_nullable_tcr
   member val system_GenericIComparable_tcref = findSysTyconRef sys "IComparable`1"
   member val system_GenericIEquatable_tcref = findSysTyconRef sys "IEquatable`1"
-  member val mk_IComparable_ty = mkSysNonGenericTy sys "IComparable"
+  member val mk_IComparable_ty    = mkSysNonGenericTy sys "IComparable"
+  member val mk_Attribute_ty = mkSysNonGenericTy sys "Attribute"
   member val system_LinqExpression_tcref = v_linqExpression_tcr
 
   member val mk_IStructuralComparable_ty = mkSysNonGenericTy sysCollections "IStructuralComparable"
@@ -1245,7 +1248,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   member val iltyp_ValueType = findSysILTypeRef tname_ValueType |> mkILNonGenericBoxedTy
   member val iltyp_RuntimeFieldHandle = findSysILTypeRef tname_RuntimeFieldHandle |> mkILNonGenericValueTy
   member val iltyp_RuntimeMethodHandle = findSysILTypeRef tname_RuntimeMethodHandle |> mkILNonGenericValueTy
-  member val iltyp_RuntimeTypeHandle = findSysILTypeRef tname_RuntimeTypeHandle |> mkILNonGenericValueTy
+  member val iltyp_RuntimeTypeHandle   = findSysILTypeRef tname_RuntimeTypeHandle |> mkILNonGenericValueTy
+  member val iltyp_ReferenceAssemblyAttributeOpt = tryFindSysILTypeRef tname_ReferenceAssemblyAttribute |> Option.map mkILNonGenericBoxedTy
 
 
   member val attrib_AttributeUsageAttribute = findSysAttrib "System.AttributeUsageAttribute"
@@ -1284,7 +1288,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   member val attrib_CallerLineNumberAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute"
   member val attrib_CallerFilePathAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute"
   member val attrib_CallerMemberNameAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute"
-  member val attrib_SkipLocalsInitAttribute = findSysAttrib "System.Runtime.CompilerServices.SkipLocalsInitAttribute"
+  member val attrib_ReferenceAssemblyAttribute = findSysAttrib "System.Runtime.CompilerServices.ReferenceAssemblyAttribute"
+  member val attrib_SkipLocalsInitAttribute  = findSysAttrib "System.Runtime.CompilerServices.SkipLocalsInitAttribute"
   member val attribs_Unsupported = v_attribs_Unsupported
 
   member val attrib_ProjectionParameterAttribute           = mk_MFCore_attrib "ProjectionParameterAttribute"

src/fsharp/TypedTreeOps.fs

@@ -1555,7 +1555,7 @@ let tryRescopeEntity viewedCcu (entity: Entity) : ValueOption<EntityRef> =
     | None -> ValueNone
 
 /// Try to create a ValRef suitable for accessing the given Val from another assembly 
-let tryRescopeVal viewedCcu (entityRemap: Remap) (vspec: Val) : ValueOption<ValRef> = 
+let tryRescopeVal viewedCcu (entityRemap: Remap) (vspec: Val) : ValueOption<ValRef> =
     match vspec.PublicPath with 
     | Some (ValPubPath(p, fullLinkageKey)) -> 
         // The type information in the val linkage doesn't need to keep any information to trait solutions.
@@ -2047,7 +2047,7 @@ let emptyFreeTyvars =
     { FreeTycons = emptyFreeTycons
       // The summary of values used as trait solutions
       FreeTraitSolutions = emptyFreeLocals
-      FreeTypars = emptyFreeTypars}
+      FreeTypars = emptyFreeTypars }
 
 let isEmptyFreeTyvars ftyvs = 
     Zset.isEmpty ftyvs.FreeTypars &&

src/fsharp/TypedTreeOps.fsi

@@ -766,7 +766,7 @@ val emptyFreeLocals: FreeLocals
 
 val unionFreeLocals: FreeLocals -> FreeLocals -> FreeLocals
 
-type FreeVarOptions 
+type FreeVarOptions
 
 val CollectLocalsNoCaching: FreeVarOptions