Allow modules to be used in type applications

src/Compiler/Checking/CheckExpressions.fs

@@ -4298,6 +4298,9 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn
     | SynType.LongIdent synLongId ->
         TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId
 
+    | SynType.LongIdentModule (synLongId, m) ->
+        TcLongIdentModule cenv checkConstraints occ env tpenv synLongId m
+
     | MultiDimensionArrayType (rank, elemTy, m) ->
         TcElementType cenv newOk checkConstraints occ env tpenv rank elemTy m
 
@@ -4366,6 +4369,22 @@ and CheckIWSAM (cenv: cenv) (env: TcEnv) checkConstraints iwsam m tcref =
         if meths |> List.exists (fun meth -> not meth.IsInstance && meth.IsDispatchSlot && not meth.IsExtensionMember) then
             warning(Error(FSComp.SR.tcUsingInterfaceWithStaticAbstractMethodAsType(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
 
+and TcLongIdentModule (cenv: cenv) checkConstraints occ (env: TcEnv) tpenv synLongId mAll =
+    if occ = ItemOccurence.UseInTypeAnnotation then
+        error(Error(FSComp.SR.tcModuleUsedInTypeAnnotation(), mAll))
+
+    let (SynLongIdent (tc, _, _)) = synLongId
+    let id, rest = List.headAndTail tc
+    let mIdent = synLongId.Range
+
+    let results =
+        ResolveLongIdentAsModule cenv.tcSink cenv.amap mIdent true OpenQualified env.NameEnv env.eAccessRights id rest
+        |> ForceRaise 
+
+    match results with
+    | [] -> failwith "unreachable" // handled in ResolveLongIdentAsModule above
+    | (_, tcref, _) :: _ -> TcTypeApp cenv NoNewTypars checkConstraints occ env tpenv mAll tcref [] []
+
 and TcLongIdentType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env tpenv synLongId =
     let (SynLongIdent(tc, _, _)) = synLongId
     let m = synLongId.Range
@@ -5722,7 +5741,7 @@ and TcExprMatchLambda (cenv: cenv) overallTy env tpenv (isExnMatch, mArg, clause
     overallExpr, tpenv
 
 and TcExprTypeAnnotated (cenv: cenv) overallTy env tpenv (synBodyExpr, synType, m) =
-    let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synType
+    let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInTypeAnnotation WarnOnIWSAM.Yes env tpenv synType
     UnifyOverallType cenv env m overallTy tgtTy
     let bodyExpr, tpenv = TcExpr cenv (MustConvertTo (false, tgtTy)) env tpenv synBodyExpr
     let bodyExpr2 = TcAdjustExprForTypeDirectedConversions cenv overallTy tgtTy env m bodyExpr
@@ -7992,7 +8011,7 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) =
 
         // expr : type" allowed with no subsequent qualifications
         | SynExpr.Typed (synBodyExpr, synType, _) when delayed.IsEmpty && overallTyOpt.IsNone ->
-            let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synType
+            let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInTypeAnnotation WarnOnIWSAM.Yes env tpenv synType
             check (Some (MustEqual tgtTy)) resultOpt synBodyExpr delayed
 
         | _ ->
@@ -11319,7 +11338,7 @@ and AnalyzeRecursiveDecl
         match pat with
         | SynPat.FromParseError(innerPat, _) -> analyzeRecursiveDeclPat tpenv innerPat
         | SynPat.Typed(innerPat, tgtTy, _) ->
-            let tgtTyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes envinner tpenv tgtTy
+            let tgtTyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInTypeAnnotation WarnOnIWSAM.Yes envinner tpenv tgtTy
             UnifyTypes cenv envinner mBinding ty tgtTyR
             analyzeRecursiveDeclPat tpenv innerPat
         | SynPat.Attrib(_innerPat, _attribs, m) ->

src/Compiler/Checking/CheckPatterns.fs

@@ -97,7 +97,7 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p =
             id.idText, patEnvR
 
     | SynSimplePat.Typed (p, cty, m) ->
-        let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK checkConstraints ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv cty
+        let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK checkConstraints ItemOccurence.UseInTypeAnnotation WarnOnIWSAM.Yes env tpenv cty
 
         match p with
         // Optional arguments on members
@@ -278,7 +278,7 @@ and TcPat warnOnUpper (cenv: cenv) env valReprInfo vFlags (patEnv: TcPatLinearEn
 
     | SynPat.Typed (p, cty, m) ->
         let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv
-        let ctyR, tpenvR = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv cty
+        let ctyR, tpenvR = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInTypeAnnotation WarnOnIWSAM.Yes env tpenv cty
         UnifyTypes cenv env m ty ctyR
         let patEnvR = TcPatLinearEnv(tpenvR, names, takenNames)
         TcPat warnOnUpper cenv env valReprInfo vFlags patEnvR ty p

src/Compiler/Checking/NameResolution.fs

@@ -1717,8 +1717,10 @@ type ItemOccurence =
     | Binding
     /// This is a usage of the item
     | Use
-    /// This is a usage of a type name in a type
+    /// This is a usage of a type name in a type, other than an annotation
     | UseInType
+    /// This is a usage of a type name in a type annotation
+    | UseInTypeAnnotation
     /// This is a usage of a type name in an attribute
     | UseInAttribute
     /// Inside pattern matching
@@ -2460,6 +2462,59 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet
         else
             raze (namespaceNotFound.Force())
 
+/// Perform name resolution for an identifier which must resolve to be a module.
+let rec ResolveLongIdentAsModule sink amap m first fullyQualified (nenv: NameResolutionEnv) ad (id: Ident) rest =
+    if first && id.idText = MangledGlobalName then
+        match rest with
+        | [] ->
+            error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange))
+        | id2 :: rest2 ->
+            ResolveLongIdentAsModule sink amap m false FullyQualified nenv ad id2 rest2
+    else
+        let notFound (id: Ident) (rest: Ident list) depth =
+            let message =
+                // "undefined module" when the last bit is not a known module - `typeof<module Unknown>`, `typeof<module Known.Unknown>`
+                if rest.IsEmpty then
+                    FSComp.SR.undefinedNameModule
+                // "undefined namespace or module" otherwise - `typeof<module Unknown.Blah>`
+                else
+                    FSComp.SR.undefinedNameNamespaceOrModule
+
+            UndefinedName (depth, message, id, NoSuggestions) |> Exception
+
+        let notifyNameResolution (modref: ModuleOrNamespaceRef) m =
+            let item = Item.ModuleOrNamespaces [modref]
+            CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, ItemOccurence.Use, ad)
+
+        match (nenv.ModulesAndNamespaces fullyQualified).TryGetValue id.idText with
+        | true, modrefs ->
+            // Look through the sub-namespaces and/or modules
+            let rec look depth (modref: ModuleOrNamespaceRef) (lid: Ident list) =
+                let mty = modref.ModuleOrNamespaceType
+                match lid with
+                | [] when modref.IsModule -> success [ (depth, modref, mty) ]
+                | [] -> notFound id rest depth
+                | id :: rest ->
+                    match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with
+                    | true, res ->
+                        let subref = modref.NestedTyconRef res
+                        if IsEntityAccessible amap m ad subref then
+                            notifyNameResolution subref id.idRange
+                            look (depth + 1) subref rest
+                        else
+                            notFound id rest depth
+                    | _ -> notFound id rest depth
+
+            modrefs
+            |> List.map (fun modref ->
+                if IsEntityAccessible amap m ad modref then
+                    notifyNameResolution modref id.idRange
+                    look 1 modref rest
+                else
+                    notFound id rest 0)
+            |> List.reduce AddResults
+        | _ -> notFound id rest 0
+
 // Note - 'rest' is annotated due to a bug currently in Unity (see: https://github.com/dotnet/fsharp/pull/7427)
 let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f =
     match ResolveLongIdentAsModuleOrNamespace sink ResultCollectionSettings.AllResults amap m true fullyQualified nenv ad id [] isOpenDecl with

src/Compiler/Checking/NameResolution.fsi

@@ -368,6 +368,7 @@ type internal ItemOccurence =
     | Binding
     | Use
     | UseInType
+    | UseInTypeAnnotation
     | UseInAttribute
     | Pattern
     | Implemented
@@ -675,6 +676,19 @@ val internal ResolveLongIdentAsModuleOrNamespace:
     isOpenDecl: bool ->
         ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list>
 
+/// Resolve a long identifier to a module.
+val internal ResolveLongIdentAsModule:
+    sink: TcResultsSink ->
+    amap: ImportMap ->
+    m: range ->
+    first: bool ->
+    fullyQualified: FullyQualifiedFlag ->
+    nenv: NameResolutionEnv ->
+    ad: AccessorDomain ->
+    id: Ident ->
+    rest: Ident list ->
+        ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list>
+
 /// Resolve a long identifier to an object constructor.
 val internal ResolveObjectConstructor:
     ncenv: NameResolver -> denv: DisplayEnv -> m: range -> ad: AccessorDomain -> ty: TType -> ResultOrException<Item>

src/Compiler/FSComp.txt

@@ -1,6 +1,7 @@
 # -------------------------------------------------------------------------------
 # use a completely new error number and keep messages in their surrounding groups
 # -------------------------------------------------------------------------------
+undefinedNameModule,"The module '%s' is not defined."
 undefinedNameNamespace,"The namespace '%s' is not defined."
 undefinedNameNamespaceOrModule,"The namespace or module '%s' is not defined."
 undefinedNameFieldConstructorOrMember,"The field, constructor or member '%s' is not defined."
@@ -1563,6 +1564,7 @@ featureArithmeticInLiterals,"Allow arithmetic and logical operations in literals
 featureErrorReportingOnStaticClasses,"Error reporting on static classes"
 featureTryWithInSeqExpressions,"Support for try-with in sequence expressions"
 featureWarningWhenCopyAndUpdateRecordChangesAllFields,"Raises warnings when an copy-and-update record expression changes all fields of a record."
+featureModulesInTypeApplication,"Allow modules to be used in type application"
 3353,fsiInvalidDirective,"Invalid directive '#%s %s'"
 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
@@ -1677,3 +1679,4 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form
 3558,chkExplicitFieldsDeclarationsOnStaticClasses,"If a type uses both [<Sealed>] and [<AbstractClass>] attributes, it means it is static. Explicit field declarations are not allowed."
 3559,typrelNeverRefinedAwayFromTop,"A type has been implicitly inferred as 'obj', which may be unintended. Consider adding explicit type annotations. You can disable this warning by using '#nowarn \"3559\"' or '--nowarn:3559'."
 3560,tcCopyAndUpdateRecordChangesAllFields,"This copy-and-update record expression changes all fields of record type '%s'. Consider using the record construction syntax instead."
+3561,tcModuleUsedInTypeAnnotation,"Module references are intended to be used in 'typeof'."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -63,6 +63,7 @@ type LanguageFeature =
     | ErrorReportingOnStaticClasses
     | TryWithInSeqExpression
     | WarningWhenCopyAndUpdateRecordChangesAllFields
+    | ModulesInTypeApplication
 
 /// LanguageVersion management
 type LanguageVersion(versionText) =
@@ -142,6 +143,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.ErrorReportingOnStaticClasses, previewVersion
                 LanguageFeature.TryWithInSeqExpression, previewVersion
                 LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields, previewVersion
+                LanguageFeature.ModulesInTypeApplication, previewVersion
 
             ]
 
@@ -258,6 +260,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.ErrorReportingOnStaticClasses -> FSComp.SR.featureErrorReportingOnStaticClasses ()
         | LanguageFeature.TryWithInSeqExpression -> FSComp.SR.featureTryWithInSeqExpressions ()
         | LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields -> FSComp.SR.featureWarningWhenCopyAndUpdateRecordChangesAllFields ()
+        | LanguageFeature.ModulesInTypeApplication -> FSComp.SR.featureModulesInTypeApplication ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -53,6 +53,7 @@ type LanguageFeature =
     | ErrorReportingOnStaticClasses
     | TryWithInSeqExpression
     | WarningWhenCopyAndUpdateRecordChangesAllFields
+    | ModulesInTypeApplication
 
 /// LanguageVersion management
 type LanguageVersion =

src/Compiler/Service/FSharpCheckerResults.fs

@@ -236,7 +236,11 @@ type FSharpSymbolUse(denv: DisplayEnv, symbol: FSharpSymbol, inst: TyparInstanti
 
     member _.IsFromPattern = itemOcc = ItemOccurence.Pattern
 
-    member _.IsFromType = itemOcc = ItemOccurence.UseInType
+    member _.IsFromType =
+        match itemOcc with
+        | ItemOccurence.UseInType
+        | ItemOccurence.UseInTypeAnnotation -> true
+        | _ -> false
 
     member _.IsFromAttribute = itemOcc = ItemOccurence.UseInAttribute
 
@@ -1329,7 +1333,13 @@ type internal TypeCheckInfo
                     denv,
                     m)
 
-            | Some (CompletionContext.OpenDeclaration isOpenType) ->
+            | Some CompletionContext.ModuleAsType
+            | Some (CompletionContext.OpenDeclaration _) ->
+                let isOpenType =
+                    match completionContext with
+                    | Some (CompletionContext.OpenDeclaration true) -> true
+                    | _ -> false
+
                 GetDeclaredItems(
                     parseResultsOpt,
                     lineStr,

src/Compiler/Service/SemanticClassification.fs

@@ -148,6 +148,7 @@ module TcResolutionsExtensions =
                     let (|LegitTypeOccurence|_|) occ =
                         match occ with
                         | ItemOccurence.UseInType
+                        | ItemOccurence.UseInTypeAnnotation
                         | ItemOccurence.UseInAttribute
                         | ItemOccurence.Use
                         | ItemOccurence.Binding

src/Compiler/Service/ServiceInterfaceStubGenerator.fs

@@ -116,6 +116,9 @@ type InterfaceData =
                     | TyparStaticReq.None -> Some("'" + s.idText)
                     | TyparStaticReq.HeadType -> Some("^" + s.idText)
                 | SynType.LongIdent (SynLongIdent (xs, _, _)) -> xs |> Seq.map (fun x -> x.idText) |> String.concat "." |> Some
+                | SynType.LongIdentModule (SynLongIdent (xs, _, _), _) ->
+                    let ident = xs |> Seq.map (fun x -> x.idText) |> String.concat "."
+                    Some(sprintf "module %s" ident)
                 | SynType.App (t, _, ts, _, _, isPostfix, _) ->
                     match t, ts with
                     | TypeIdent typeName, [] -> Some typeName

src/Compiler/Service/ServiceParseTreeWalk.fs

@@ -826,6 +826,7 @@ module SyntaxTraversal =
                 | SynType.Anon _
                 | SynType.AnonRecd _
                 | SynType.LongIdent _
+                | SynType.LongIdentModule _
                 | SynType.Var _
                 | SynType.StaticConstant _ -> None
 

src/Compiler/Service/ServiceParsedInputOps.fs

@@ -80,6 +80,9 @@ type CompletionContext =
     /// or a single case union without a bar (type SomeUnion = Abc|)
     | TypeAbbreviationOrSingleCaseUnion
 
+    /// Completing module in generic type application (e.g. typeof<module M|>)
+    | ModuleAsType
+
 type ShortIdent = string
 
 type ShortIdents = ShortIdent[]
@@ -660,7 +663,8 @@ module ParsedInput =
 
         and walkType ty =
             match ty with
-            | SynType.LongIdent ident ->
+            | SynType.LongIdent ident
+            | SynType.LongIdentModule (ident, _) ->
                 // we protect it with try..with because System.Exception : rangeOfLidwd may raise
                 // at FSharp.Compiler.Syntax.LongIdentWithDots.get_Range() in D:\j\workspace\release_ci_pa---3f142ccc\src\ast.fs: line 156
                 try
@@ -1306,7 +1310,17 @@ module ParsedInput =
                             | SynExpr.Record (None, None, [], _) -> Some(CompletionContext.RecordField RecordContext.Empty)
 
                             // Unchecked.defaultof<str$>
-                            | SynExpr.TypeApp (typeArgsRange = range) when rangeContainsPos range pos -> Some CompletionContext.PatternType
+                            // typeof<module M$>
+                            | SynExpr.TypeApp (typeArgs = typeArgs; typeArgsRange = range) when rangeContainsPos range pos ->
+                                typeArgs
+                                |> List.tryPick (fun arg ->
+                                    match arg with
+                                    | SynType.LongIdent lid when rangeContainsPos lid.Range pos -> Some CompletionContext.PatternType
+                                    | SynType.LongIdentModule (lid, _) when rangeContainsPos lid.Range pos ->
+                                        Some CompletionContext.ModuleAsType
+                                    | _ -> None)
+                                |> Option.orElse (Some CompletionContext.PatternType)
+
                             | _ -> defaultTraverse expr
 
                     member _.VisitRecordField(path, copyOpt, field) =
@@ -1677,7 +1691,8 @@ module ParsedInput =
             | SynType.Or (t1, t2, _, _) ->
                 walkType t1
                 walkType t2
-            | SynType.LongIdent ident -> addLongIdentWithDots ident
+            | SynType.LongIdent ident
+            | SynType.LongIdentModule (ident, _) -> addLongIdentWithDots ident
             | SynType.App (ty, _, types, _, _, _, _) ->
                 walkType ty
                 List.iter walkType types

src/Compiler/Service/ServiceParsedInputOps.fsi

@@ -53,6 +53,9 @@ type public CompletionContext =
     /// or a single case union without a bar (type SomeUnion = Abc|)
     | TypeAbbreviationOrSingleCaseUnion
 
+    /// Completing module in generic type application (e.g. typeof<module M|>)
+    | ModuleAsType
+
 type public ModuleKind =
     { IsAutoOpen: bool
       HasModuleSuffix: bool }