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

@@ -325,6 +325,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 =
     {
@@ -437,6 +443,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
@@ -642,6 +649,7 @@ type TcConfigBuilder =
           emitTailcalls = true
           deterministic = false
           concurrentBuild = true
+          emitMetadataAssembly = MetadataAssemblyGeneration.None
           preferredUiLang = None
           lcid = None
           productNameForBannerText = FSharpProductName
@@ -1022,6 +1030,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
@@ -249,6 +259,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
@@ -439,6 +450,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. Check the compiler options to not specify static linking, or using '--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

@@ -4951,6 +4951,7 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel
                   nestedTypes = emptyILTypeDefs,
                   implements = ilInterfaceTys,
                   extends = Some super,
+                  isAttribute = false,
                   securityDecls = emptyILSecurityDecls)
             .WithSealed(true)
             .WithSpecialName(true)
@@ -5192,6 +5193,7 @@ and GenClosureTypeDefs cenv (tref: ILTypeRef, ilGenParams, attrs, ilCloAllFreeVa
               nestedTypes=emptyILTypeDefs,
               implements = ilIntfTys,
               extends= Some ext,
+              isAttribute=false,
               securityDecls= emptyILSecurityDecls)
         .WithSealed(true)
         .WithSerializable(true)
@@ -8371,6 +8373,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
                    else
                        ILTypeInit.BeforeField
 
+               let isAttribute = 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)
@@ -8383,7 +8387,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, isAttribute=isAttribute)
 
                let tdLayout, tdEncoding =
                     match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with
@@ -8496,6 +8500,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),
+                             isAttribute=false,
                              securityDecls= emptyILSecurityDecls)
                          .WithLayout(layout)
                          .WithSerializable(isSerializable)
@@ -8901,4 +8906,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

@@ -35,6 +35,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 =
@@ -814,6 +815,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 [], range0)
+    TypedImplFile.TImplFile(qualNameOfFile, [], dummyExpr, false, false, StampMap.Empty)
+
 /// Typecheck a single file (or interactive entry into F# Interactive)
 let TypeCheckOneInput(checkForErrors,
                       tcConfig: TcConfig,
@@ -890,10 +896,7 @@ let TypeCheckOneInput(checkForErrors,
               // 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)
                     |> Cancellable.ret
                   else
                     TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, tcState.tcsImplicitOpenDeclarations, checkForErrors, conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring, tcImplEnv, rootSigOpt, file)

src/fsharp/StaticLinking.fs

@@ -354,6 +354,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

@@ -165,6 +165,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"
@@ -1144,6 +1146,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   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_Attribute_ty = mkSysNonGenericTy sys "Attribute"
   member val system_LinqExpression_tcref = v_linqExpression_tcr
 
   member val mk_IStructuralComparable_ty = mkSysNonGenericTy sysCollections "IStructuralComparable"
@@ -1192,6 +1195,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   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_ReferenceAssemblyAttributeOpt = tryFindSysILTypeRef tname_ReferenceAssemblyAttribute |> Option.map mkILNonGenericBoxedTy
 
 
   member val attrib_AttributeUsageAttribute = findSysAttrib "System.AttributeUsageAttribute"
@@ -1230,6 +1234,7 @@ 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_ReferenceAssemblyAttribute = findSysAttrib "System.Runtime.CompilerServices.ReferenceAssemblyAttribute"
   member val attrib_SkipLocalsInitAttribute  = findSysAttrib "System.Runtime.CompilerServices.SkipLocalsInitAttribute"
   member val attribs_Unsupported = v_attribs_Unsupported
 

src/fsharp/TypedTreeOps.fs

@@ -1499,7 +1499,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.
@@ -1982,7 +1982,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

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

src/fsharp/absil/il.fs

@@ -2102,12 +2102,12 @@ let convertInitSemantics (init: ILTypeInit) =
 [<NoComparison; NoEquality>]
 type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout, implements: ILTypes, genericParams: ILGenericParameterDefs,
                extends: ILType option, methods: ILMethodDefs, nestedTypes: ILTypeDefs, fields: ILFieldDefs, methodImpls: ILMethodImplDefs,
-               events: ILEventDefs, properties: ILPropertyDefs, securityDeclsStored: ILSecurityDeclsStored, customAttrsStored: ILAttributesStored, metadataIndex: int32) =
+               events: ILEventDefs, properties: ILPropertyDefs, isAttribute: bool, securityDeclsStored: ILSecurityDeclsStored, customAttrsStored: ILAttributesStored, metadataIndex: int32) =
 
     let mutable customAttrsStored = customAttrsStored
 
-    new (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, securityDecls, customAttrs) =
-       ILTypeDef (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, storeILSecurityDecls securityDecls, storeILCustomAttrs customAttrs, NoMetadataIdx)
+    new (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, isAttribute, securityDecls, customAttrs) =
+       ILTypeDef (name, attributes, layout, implements, genericParams, extends, methods, nestedTypes, fields, methodImpls, events, properties, isAttribute, storeILSecurityDecls securityDecls, storeILCustomAttrs customAttrs, NoMetadataIdx)
 
     member _.Name = name
     member _.Attributes = attributes
@@ -2122,10 +2122,11 @@ type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout
     member _.MethodImpls = methodImpls
     member _.Events = events
     member _.Properties = properties
+    member _.IsAttribute = isAttribute
     member _.CustomAttrsStored = customAttrsStored
     member _.MetadataIndex = metadataIndex
 
-    member x.With(?name, ?attributes, ?layout, ?implements, ?genericParams, ?extends, ?methods, ?nestedTypes, ?fields, ?methodImpls, ?events, ?properties, ?customAttrs, ?securityDecls) =
+    member x.With(?name, ?attributes, ?layout, ?implements, ?genericParams, ?extends, ?methods, ?nestedTypes, ?fields, ?methodImpls, ?events, ?properties, ?isAttribute, ?customAttrs, ?securityDecls) =
         ILTypeDef(name=defaultArg name x.Name,
                   attributes=defaultArg attributes x.Attributes,
                   layout=defaultArg layout x.Layout,
@@ -2139,6 +2140,7 @@ type ILTypeDef(name: string, attributes: TypeAttributes, layout: ILTypeDefLayout
                   methodImpls = defaultArg methodImpls x.MethodImpls,
                   events = defaultArg events x.Events,
                   properties = defaultArg properties x.Properties,
+                  isAttribute = defaultArg isAttribute x.IsAttribute,
                   customAttrs = defaultArg customAttrs x.CustomAttrs)
 
     member x.CustomAttrs =
@@ -3345,6 +3347,7 @@ let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nes
         methodImpls=emptyILMethodImpls,
         properties=props,
         events=events,
+        isAttribute=false,
         securityDecls=emptyILSecurityDecls)
 
 let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm, size, pack) =
@@ -3362,6 +3365,7 @@ let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm, size, pack) =
               methodImpls=emptyILMethodImpls,
               properties=emptyILProperties,
               events=emptyILEvents,
+              isAttribute=false,
               securityDecls=emptyILSecurityDecls)