fix 10472 (#11349)

* fix 10472

* fix generated signature

* simplify local type functions to use only an implementation class

* fix comment

* fix tests

* simplify initial display environment code

* fix test

* simplify initial display environment code

* fix fsi display  code
Co-authored-by: NDon Syme <donsyme@fastmail.com>

src/fsharp/NicePrint.fs

@@ -946,6 +946,12 @@ module private PrintTypes =
 module private PrintTastMemberOrVals =
     open PrintTypes 
 
+    let mkInlineL denv (v: Val) nameL = 
+        if v.MustInline && not denv.suppressInlineKeyword then 
+            wordL (tagKeyword "inline") ++ nameL 
+        else 
+            nameL
+
     let private prettyLayoutOfMemberShortOption denv typarInst (v:Val) short =
         let v = mkLocalValRef v
         let membInfo = Option.get v.MemberInfo
@@ -978,6 +984,7 @@ module private PrintTastMemberOrVals =
                     if short then tauL
                     else
                         let nameL = mkNameL niceMethodTypars tagMember v.LogicalName
+                        let nameL = if short then nameL else mkInlineL denv v.Deref nameL
                         stat --- (nameL ^^ WordL.colon ^^ tauL)
                 prettyTyparInst, resL
 
@@ -1096,11 +1103,7 @@ module private PrintTastMemberOrVals =
                 wordL (tagKeyword "mutable") ++ nameL 
               else 
                   nameL
-        let nameL = 
-            if v.MustInline && not denv.suppressInlineKeyword then 
-                wordL (tagKeyword "inline") ++ nameL 
-            else 
-                nameL
+        let nameL = mkInlineL denv v nameL
 
         let isOverGeneric = List.length (Zset.elements (freeInType CollectTyparsNoCaching tau).FreeTypars) < List.length tps // Bug: 1143 
         let isTyFunction = v.IsTypeFunction // Bug: 1143, and innerpoly tests 

src/fsharp/TypedTreeOps.fs

@@ -2782,7 +2782,7 @@ type DisplayEnv =
         showHiddenMembers = false
         showTyparBinding = false
         showImperativeTyparAnnotations = false
-        suppressInlineKeyword = false
+        suppressInlineKeyword = true
         suppressMutableKeyword = false
         showMemberContainers = false
         showAttributes = false
@@ -2813,6 +2813,24 @@ type DisplayEnv =
     member denv.UseGenericParameterStyle style =
         { denv with genericParameterStyle = style }
 
+    static member InitialForSigFileGeneration g =
+        let denv =
+            { DisplayEnv.Empty g with
+               showImperativeTyparAnnotations = true
+               showHiddenMembers = true
+               showObsoleteMembers = true
+               showAttributes = true
+               suppressInlineKeyword = false
+               showDocumentation = true
+               shrinkOverloads = false
+               }
+        denv.SetOpenPaths
+            [ FSharpLib.RootPath
+              FSharpLib.CorePath
+              FSharpLib.CollectionsPath
+              FSharpLib.ControlPath
+              (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName) ]
+
 let (+.+) s1 s2 = if s1 = "" then s2 else s1+"."+s2
 
 let layoutOfPath p =
@@ -8794,7 +8812,7 @@ and remapValToNonLocal g tmenv inp =
 let ApplyExportRemappingToEntity g tmenv x = remapTyconToNonLocal g tmenv x
 
 (* Which constraints actually get compiled to .NET constraints? *)
-let isCompiledConstraint cx = 
+let isCompiledOrWitnessPassingConstraint (g: TcGlobals) cx = 
     match cx with 
       | TyparConstraint.SupportsNull _ // this implies the 'class' constraint
       | TyparConstraint.IsReferenceType _  // this is the 'class' constraint
@@ -8802,13 +8820,15 @@ let isCompiledConstraint cx =
       | TyparConstraint.IsReferenceType _
       | TyparConstraint.RequiresDefaultConstructor _
       | TyparConstraint.CoercesTo _ -> true
+      | TyparConstraint.MayResolveMember _ when g.langVersion.SupportsFeature LanguageFeature.WitnessPassing -> true
       | _ -> false
     
-// Is a value a first-class polymorphic value with .NET constraints? 
-// Used to turn off TLR and method splitting
+// Is a value a first-class polymorphic value with .NET constraints, or witness-passing constraints? 
+// Used to turn off TLR and method splitting and do not compile to
+// FSharpTypeFunc, but rather bake a "local type function" for each TyLambda abstraction.
 let IsGenericValWithGenericConstraints g (v: Val) = 
     isForallTy g v.Type && 
-    v.Type |> destForallTy g |> fst |> List.exists (fun tp -> List.exists isCompiledConstraint tp.Constraints)
+    v.Type |> destForallTy g |> fst |> List.exists (fun tp -> List.exists (isCompiledOrWitnessPassingConstraint g) tp.Constraints)
 
 // Does a type support a given interface? 
 type Entity with 

src/fsharp/TypedTreeOps.fsi

@@ -1008,6 +1008,8 @@ type DisplayEnv =
 
     member UseGenericParameterStyle: GenericParameterStyle -> DisplayEnv
 
+    static member InitialForSigFileGeneration: TcGlobals -> DisplayEnv
+
 val tagEntityRefName: xref: EntityRef -> name: string -> TaggedText
 
 /// Return the full text for an item as we want it displayed to the user as a fully qualified entity
@@ -1563,6 +1565,8 @@ val normalizeEnumTy: TcGlobals -> TType -> TType
 /// Determine if a type is a struct type
 val isStructTy: TcGlobals -> TType -> bool
 
+val isStructOrEnumTyconTy: TcGlobals -> TType -> bool
+
 /// Determine if a type is a variable type with the ': struct' constraint.
 ///
 /// Note, isStructTy does not include type parameters with the ': struct' constraint

src/fsharp/fsc.fs

@@ -309,21 +309,6 @@ let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder, lcidFromCodePage, argv)
 /// Write a .fsi file for the --sig option
 module InterfaceFileWriter =
 
-    let BuildInitialDisplayEnvForSigFileGeneration tcGlobals =
-        let denv =
-            { DisplayEnv.Empty tcGlobals with
-               showImperativeTyparAnnotations = true
-               showHiddenMembers = true
-               showObsoleteMembers = true
-               showAttributes = true
-               showDocumentation = true }
-        denv.SetOpenPaths
-            [ FSharpLib.RootPath
-              FSharpLib.CorePath
-              FSharpLib.CollectionsPath
-              FSharpLib.ControlPath
-              (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName) ]
-
     let WriteInterfaceFile (tcGlobals, tcConfig: TcConfig, infoReader, declaredImpls) =
 
         /// Use a UTF-8 Encoding with no Byte Order Mark
@@ -336,9 +321,9 @@ module InterfaceFileWriter =
             fprintfn os "" 
 
         for (TImplFile (_, _, mexpr, _, _, _)) in declaredImpls do
-            let denv = BuildInitialDisplayEnvForSigFileGeneration tcGlobals
+            let denv = DisplayEnv.InitialForSigFileGeneration tcGlobals
             writeViaBuffer os (fun os s -> Printf.bprintf os "%s\n\n" s)
-              (NicePrint.layoutInferredSigOfModuleExpr true { denv with shrinkOverloads = false; printVerboseSignatures = true } infoReader AccessibleFromSomewhere range0 mexpr |> Display.squashTo 80 |> LayoutRender.showL)
+              (NicePrint.layoutInferredSigOfModuleExpr true { denv with printVerboseSignatures = true } infoReader AccessibleFromSomewhere range0 mexpr |> Display.squashTo 80 |> LayoutRender.showL)
        
         if tcConfig.printSignatureFile <> "" then os.Dispose()
 

src/fsharp/fsi/fsi.fs

@@ -480,6 +480,7 @@ type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, tcConfigB: Tc
                     let lay = valuePrinter.PrintValue (FsiValuePrinterMode.PrintExpr, opts, obj, objTy)
                     if isEmptyL lay then None else Some lay // suppress empty layout 
         let denv = { denv with suppressMutableKeyword = true } // suppress 'mutable' in 'val mutable it = ...'
+        let denv = { denv with suppressInlineKeyword = false } // dont' suppress 'inline' in 'val inline f = ...'
         let fullL = 
             if Option.isNone rhsL || isEmptyL rhsL.Value then
                 NicePrint.prettyLayoutOfValOrMemberNoInst denv vref (* the rhs was suppressed by the printer, so no value to print *)
@@ -1200,6 +1201,7 @@ type internal FsiDynamicCompiler
                 else
                   // With #load items, the vals in the inferred signature do not tie up with those generated. Disable printing.
                   denv 
+            let denv = { denv with suppressInlineKeyword = false } // dont' suppress 'inline' in 'val inline f = ...'
 
             // 'Open' the path for the fragment we just compiled for any future printing.
             let denv = denv.AddOpenPath (pathOfLid prefixPath) 

src/fsharp/service/FSharpCheckerResults.fs

@@ -1974,22 +1974,7 @@ type FSharpCheckFileResults
         threadSafeOp (fun () -> None) (fun scope ->
             scope.ImplementationFile
             |> Option.map (fun implFile ->
-                // this logic copied from fsc's InterfaceFileWriter.BuildInitialDisplayEnvForSigFileGeneration,
-                // should/can it be consolidated?
-                let denv =
-                    { DisplayEnv.Empty scope.TcGlobals with
-                       showImperativeTyparAnnotations = true
-                       showHiddenMembers = true
-                       showObsoleteMembers = true
-                       showAttributes = true
-                       showDocumentation = true }
-                let denv =
-                    denv.SetOpenPaths
-                        [ FSharpLib.RootPath
-                          FSharpLib.CorePath
-                          FSharpLib.CollectionsPath
-                          FSharpLib.ControlPath
-                          (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName) ]
+                let denv = DisplayEnv.InitialForSigFileGeneration scope.TcGlobals
                 let infoReader = InfoReader(scope.TcGlobals, scope.TcImports.GetImportMap())
                 let (TImplFile (_, _, mexpr, _, _, _)) = implFile
                 let layout = NicePrint.layoutInferredSigOfModuleExpr true denv infoReader AccessibleFromSomewhere range0 mexpr

src/fsharp/symbols/SymbolHelpers.fs

@@ -763,8 +763,7 @@ module internal SymbolHelpers =
         items |> List.filter (fun item -> not (IsExplicitlySuppressed g item.Item))
 
     let SimplerDisplayEnv denv = 
-        { denv with suppressInlineKeyword=true
-                    shortConstraints=true
+        { denv with shortConstraints=true
                     showConstraintTyparAnnotations=false
                     abbreviateAdditionalConstraints=false
                     suppressNestedTypes=true

src/fsharp/symbols/Symbols.fs

@@ -814,16 +814,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) =
             if entity.IsNamespace then None
             else
 
-            let denv = DisplayEnv.Empty cenv.g
-            let denv = 
-                { denv with 
-                    showImperativeTyparAnnotations=true
-                    showHiddenMembers=true
-                    showObsoleteMembers=true
-                    showAttributes=true
-                    shrinkOverloads=false
-                    printVerboseSignatures=false
-                    showDocumentation=true }
+            let denv = DisplayEnv.InitialForSigFileGeneration cenv.g
 
             let extraOpenPath =
                 match entity.CompilationPathOpt with
@@ -855,15 +846,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) =
                 | _ ->
                     false
 
-            let denv =
-                denv.SetOpenPaths 
-                    ([ FSharpLib.RootPath 
-                       FSharpLib.CorePath 
-                       FSharpLib.CollectionsPath 
-                       FSharpLib.ControlPath 
-                       (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName)
-                       extraOpenPath
-                     ])
+            let denv = denv.AddOpenPath extraOpenPath
 
             let infoReader = cenv.infoReader
 

tests/fsharp/Compiler/Service/SignatureGenerationTests.fs

@@ -40,11 +40,11 @@ exception MyEx of reason: string
 /// module-level docs
 module Inner =
     /// type-level docs
-    type Farts
+    type Facts
         /// primary ctor docs
         (name: string) =
         /// constructor-level docs
-        new() = Farts("default name")
+        new() = Facts("default name")
         /// member-level docs
         member x.blah() = [1;2;3]
         /// auto-property-level docs
@@ -77,9 +77,11 @@ module Inner =
   /// module-level docs
   module Inner = begin
     /// type-level docs
-    type Farts =
+    type Facts =
       /// constructor-level docs
-      new : unit -> Farts + 1 overload
+      new : unit -> Facts
+      /// primary ctor docs
+      new : name:string -> Facts
       /// member-level docs
       member blah : unit -> int list
       /// auto-property-level docs

tests/fsharp/core/innerpoly/test.fsx

@@ -389,6 +389,56 @@ module InnerGenericBindingsInComputationExpressions = begin
     f()
 end
 
+module LocalTypeFunctionRequiredForWitnessPassingOfGenericInnerFunctionsConstrainedByMemberConstraints = 
+    let inline clamp16 v = uint16 (max 0. (min 65535. v))
+    let inline clamp8  v = uint8  (max 0. (min   255. v))
+
+    type Clampage =
+        static member inline FromFloat (_ : byte,   _ : Clampage) = fun (x : float) -> clamp8  x
+        static member inline FromFloat (_ : uint16, _ : Clampage) = fun (x : float) -> clamp16 x
+
+        static member inline Invoke (x: float) : 'Num =
+            let inline call2 (a: ^a, b: ^b) = ((^a or ^b) : (static member FromFloat : _*_ -> _) (b, a))
+            let inline call (a: 'a) = fun (x: 'x) -> call2 (a, Unchecked.defaultof<'r>) x : 'r
+            call Unchecked.defaultof<Clampage> x
+
+    let inline clamp x = Clampage.Invoke x
+    let x1 : byte = clamp 3.0 
+    let x2 : uint16 = clamp 3.0 
+    let x3 : byte = clamp 257.0 
+    check "clecqwe1" x1 3uy
+    check "clecqwe2" x2 3us
+    check "clecqwe3" x3 255uy
+
+// Same as the above but capturing an extra constrained free type variable 'Free
+module LocalTypeFunctionRequiredForWitnessPassingOfGenericInnerFunctionsConstrainedByMemberConstraints2 = 
+    let inline clamp16 v = uint16 (max 0. (min 65535. v))
+    let inline clamp8  v = uint8  (max 0. (min   255. v))
+
+    type Clampage =
+        static member inline FromFloat (_ : byte,   _ : Clampage) = fun (x : float) -> clamp8  x
+        static member inline FromFloat (_ : uint16, _ : Clampage) = fun (x : float) -> clamp16 x
+
+        static member inline Invoke (x: float) (free: 'Free) : 'Num * 'Free =
+            let inline call2 (a: ^a, b: ^b) = ((^a or ^b) : (static member FromFloat : _*_ -> _) (b, a))
+            let inline call (a: 'a) = (fun (x: 'x) -> call2 (a, Unchecked.defaultof<'r>) x : 'r), free + free
+            let f, info = call Unchecked.defaultof<Clampage>
+            f x, info
+
+    let inline clamp x free = Clampage.Invoke x free
+    let (x1a1: byte, x1a2: int64) = clamp 3.0 1L
+    let (x1b1: uint16, x1b2: string) = clamp 3.0 "abc"
+    check "clecqwea1" x1a1 3uy
+    check "clecqwea2" x1a2 2L
+    check "clecqwea3" x1b1 3us
+    check "clecqwea4" x1b2 "abcabc"
+
+module Bug10408 = 
+    let test x =
+        match x with
+        | [| |] -> x
+        | _ -> x
+
 #if TESTS_AS_APP
 let RUN() = !failures
 #else