Improve fsi printing/%A formatting (#7710)

* Improved printing

* Fix SynAccess ToString

* Fixup tests

* Disable tests that depend on updated fsharp.core

Co-authored-by: Kevin Ransom (msft) <codecutter.fsharp@hotmail.com>

Author: 2 people

fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj

@@ -636,7 +636,7 @@
     <Compile Include="$(FSharpSourcesRoot)\fsharp\service\ExternalSymbol.fs">
       <Link>Service/ExternalSymbol.fs</Link>
     </Compile>
-	<Compile Include="$(FSharpSourcesRoot)\fsharp\service\QuickParse.fsi">
+    <Compile Include="$(FSharpSourcesRoot)\fsharp\service\QuickParse.fsi">
       <Link>Service/QuickParse.fsi</Link>
     </Compile>
     <Compile Include="$(FSharpSourcesRoot)\fsharp\service\QuickParse.fs">

src/fsharp/FSharp.Core/printf.fs

@@ -1059,9 +1059,11 @@ module internal PrintfImpl =
 
         static member GenericToStringCore(v: 'T, opts: Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions, bindingFlags) = 
             // printfn %0A is considered to mean 'print width zero'
-            match box v with 
-            | null -> "<null>" 
-            | _ -> Microsoft.FSharp.Text.StructuredPrintfImpl.Display.anyToStringForPrintf opts bindingFlags (v, v.GetType())
+            match box v with
+            | null ->
+                Microsoft.FSharp.Text.StructuredPrintfImpl.Display.anyToStringForPrintf opts bindingFlags (v, typeof<'T>)
+            | _ ->
+                Microsoft.FSharp.Text.StructuredPrintfImpl.Display.anyToStringForPrintf opts bindingFlags (v, v.GetType())
 
         static member GenericToString<'T>(spec: FormatSpecifier) = 
             let bindingFlags = 

src/fsharp/ast.fs

@@ -330,6 +330,12 @@ type SynAccess =
     | Internal
     | Private
 
+    override this.ToString () =
+        match this with
+        | Public -> "Public"
+        | Internal -> "Internal"
+        | Private -> "Private"
+
 type SequencePointInfoForTarget =
     | SequencePointAtTarget
     | SuppressSequencePointAtTarget

src/utils/sformat.fs

@@ -366,17 +366,27 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
             (let cases = FSharpType.GetUnionCases ty 
              cases.Length > 0 && equivHeadTypes (typedefof<list<_>>) cases.[0].DeclaringType)
 
+        [<RequireQualifiedAccess; StructuralComparison; StructuralEquality>]
+        type TupleType =
+            | Value
+            | Reference
+
         [<NoEquality; NoComparison>]
         type ValueInfo =
-          | TupleValue of (obj * Type) list
+          | TupleValue of TupleType * (obj * Type) list
           | FunctionClosureValue of System.Type 
           | RecordValue of (string * obj * Type) list
-          | ConstructorValue of string * (string * (obj * Type)) list
+          | ConstructorValue of declaringType: Type option * string * (string * (obj * Type)) list
           | ExceptionValue of System.Type * (string * (obj * Type)) list
           | UnitValue
           | ObjectValue of obj
 
-        module Value = 
+        module Value =
+
+            // Returns true if a given type has the RequireQualifiedAccess attribute
+            let private requiresQualifiedAccess (declaringType:Type) =
+                let rqaAttr = declaringType.GetCustomAttribute(typeof<RequireQualifiedAccessAttribute>, false)
+                isNull rqaAttr |> not
 
             // Analyze an object to see if it the representation
             // of an F# value.
@@ -393,7 +403,11 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
 
                 if FSharpType.IsTuple reprty then 
                     let tyArgs = FSharpType.GetTupleElements(reprty)
-                    TupleValue (FSharpValue.GetTupleFields obj |> Array.mapi (fun i v -> (v, tyArgs.[i])) |> Array.toList)
+                    let fields = FSharpValue.GetTupleFields obj |> Array.mapi (fun i v -> (v, tyArgs.[i])) |> Array.toList
+                    let tupleType =
+                        if reprty.Name.StartsWith "ValueTuple" then TupleType.Value
+                        else TupleType.Reference
+                    TupleValue (tupleType, fields)
                 elif FSharpType.IsFunction reprty then 
                     FunctionClosureValue reprty
 
@@ -406,7 +420,10 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
                     let tag,vals = FSharpValue.GetUnionFields (obj,reprty,bindingFlags) 
                     let props = tag.GetFields()
                     let pvals = (props,vals) ||> Array.map2 (fun prop v -> prop.Name,(v, prop.PropertyType))
-                    ConstructorValue(tag.Name, Array.toList pvals)
+                    let declaringType =
+                        if requiresQualifiedAccess tag.DeclaringType then Some tag.DeclaringType
+                        else None
+                    ConstructorValue(declaringType, tag.Name, Array.toList pvals)
                 elif FSharpType.IsExceptionRepresentation(reprty,bindingFlags) then 
                     let props = FSharpType.GetExceptionFields(reprty,bindingFlags) 
                     let vals = FSharpValue.GetExceptionFields(obj,bindingFlags) 
@@ -426,16 +443,19 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
                 let obj = (box x)
                 match obj with 
                 | null ->
-                   let isNullaryUnion =
-                      match ty.GetCustomAttributes(typeof<CompilationRepresentationAttribute>, false) with
-                      | [|:? CompilationRepresentationAttribute as attr|] -> 
+                    let isNullaryUnion =
+                        match ty.GetCustomAttributes(typeof<CompilationRepresentationAttribute>, false) with
+                        | [|:? CompilationRepresentationAttribute as attr|] -> 
                           (attr.Flags &&& CompilationRepresentationFlags.UseNullAsTrueValue) = CompilationRepresentationFlags.UseNullAsTrueValue
-                      | _ -> false
-                   if isNullaryUnion then
-                     let nullaryCase = FSharpType.GetUnionCases ty |> Array.filter (fun uc -> uc.GetFields().Length = 0) |> Array.item 0
-                     ConstructorValue(nullaryCase.Name, [])
-                   elif isUnitType ty then UnitValue
-                   else ObjectValue(obj)
+                        | _ -> false
+                    if isNullaryUnion then
+                        let nullaryCase = FSharpType.GetUnionCases ty |> Array.filter (fun uc -> uc.GetFields().Length = 0) |> Array.item 0
+                        let declaringType =
+                            if requiresQualifiedAccess ty then Some ty
+                            else None
+                        ConstructorValue(declaringType, nullaryCase.Name, [])
+                    elif isUnitType ty then UnitValue
+                    else ObjectValue(obj)
                 | _ -> 
                   GetValueInfoOfObject bindingFlags (obj) 
 
@@ -700,11 +720,11 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
             | null -> None 
             | _ -> 
                 match getValueInfo bindingFlags (x, ty) with
-                | ConstructorValue ("Cons",recd) -> Some (unpackCons recd)
-                | ConstructorValue ("Empty",[]) -> None
+                | ConstructorValue (_,"Cons",recd) -> Some (unpackCons recd)
+                | ConstructorValue (_,"Empty",[]) -> None
                 | _ -> failwith "List value had unexpected ValueInfo"
 
-        let compactCommaListL xs = sepListL (sepL Literals.comma) xs // compact, no spaces around "," 
+        let structL = wordL (tagKeyword "struct")
         let nullL = wordL (tagKeyword "null")
         let measureL = wordL (tagPunctuation "()")
 
@@ -967,25 +987,28 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
                 // tuples up args to UnionConstruction or ExceptionConstructor. no node count.
                 match recd with 
                 | [(_,x)] -> objL depthLim Precedence.BracketIfTupleOrNotAtomic x 
-                | txs     -> leftL Literals.leftParen ^^ compactCommaListL (List.map (snd >> objL depthLim Precedence.BracketIfTuple) txs) ^^ rightL Literals.rightParen
+                | txs     -> leftL Literals.leftParen ^^ commaListL (List.map (snd >> objL depthLim Precedence.BracketIfTuple) txs) ^^ rightL Literals.rightParen
 
             and bracketIfL b basicL =
                 if b then (leftL Literals.leftParen) ^^ basicL ^^ (rightL Literals.rightParen) else basicL
 
             and reprL showMode depthLim prec repr x (* x could be null *) =
                 let showModeFilter lay = match showMode with ShowAll -> lay | ShowTopLevelBinding -> emptyL                                                             
-                match repr with 
-                | TupleValue vals -> 
+                match repr with
+                | TupleValue (tupleType, vals) ->
                     let basicL = sepListL (rightL Literals.comma) (List.map (objL depthLim Precedence.BracketIfTuple ) vals)
-                    bracketIfL (prec <= Precedence.BracketIfTuple) basicL 
+                    let fields = bracketIfL (prec <= Precedence.BracketIfTuple) basicL
+                    match tupleType with
+                    | TupleType.Value -> structL ^^ fields
+                    | TupleType.Reference -> fields
 
                 | RecordValue items -> 
                     let itemL (name,x,ty) =
                       countNodes 1 // record labels are counted as nodes. [REVIEW: discussion under 4090].
                       (tagRecordField name,objL depthLim Precedence.BracketIfTuple (x, ty))
                     makeRecordL (List.map itemL items)
 
-                | ConstructorValue (constr,recd) when // x is List<T>. Note: "null" is never a valid list value. 
+                | ConstructorValue (_,constr,recd) when // x is List<T>. Note: "null" is never a valid list value. 
                                                       x<>null && isListType (x.GetType()) ->
                     match constr with 
                     | "Cons" -> 
@@ -997,13 +1020,17 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
                         countNodes 1
                         wordL (tagPunctuation "[]")
 
-                | ConstructorValue(nm,[])   ->
+                | ConstructorValue(declaringType,nm,recd)   ->
                     countNodes 1
-                    (wordL (tagMethod nm))
-
-                | ConstructorValue(nm,recd) ->
-                    countNodes 1 // e.g. Some (Some (Some (Some 2))) should count for 5 
-                    (wordL (tagMethod nm) --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
+                    let caseName =
+                        match declaringType with
+                        | None ->
+                            wordL (tagMethod nm)
+                        | Some declaringType ->
+                            wordL (tagClass declaringType.Name) ^^ sepL (tagPunctuation ".") ^^ wordL (tagMethod nm)
+                    match recd with
+                    | [] -> caseName
+                    | recd -> (caseName --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
 
                 | ExceptionValue(ty,recd) ->
                     countNodes 1
@@ -1019,7 +1046,12 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
 
                 | ObjectValue(obj)  ->
                     match obj with 
-                    | null -> (countNodes 1; nullL)
+                    | null ->
+                        countNodes 1
+                        // If this is the root element, wrap the null with angle brackets
+                        if depthLim = opts.PrintDepth - 1 then
+                            wordL (tagText "<null>")
+                        else nullL
                     | _ -> 
                     let ty = obj.GetType()
                     match obj with 

tests/service/ExprTests.fs

@@ -637,8 +637,11 @@ let test{0}ToStringOperator   (e1:{1}) = string e1
 
 """
 
-//<@ let x = Some(3) in x.IsSome @>
 [<Test>]
+// FCS Has a problem with these tests because of FSharp Core versions.
+#if !COMPILER_SERVICE_AS_DLL
+[<Ignore("SKIPPED: FSharp.Core nuget package needs to be updated before this test can be re-enabled")>]
+#endif
 let ``Test Unoptimized Declarations Project1`` () =
     let wholeProjectResults = exprChecker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously
 
@@ -711,7 +714,7 @@ let ``Test Unoptimized Declarations Project1`` () =
         "member CurriedMethod(x) (a1,b1) (a2,b2) = 1 @ (107,63--107,64)";
         "let testFunctionThatCallsMultiArgMethods(unitVar0) = let m: M.MultiArgMethods = new MultiArgMethods(3,4) in Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (m.Method(7,8),fun tupledArg -> let arg00: Microsoft.FSharp.Core.int = tupledArg.Item0 in let arg01: Microsoft.FSharp.Core.int = tupledArg.Item1 in fun tupledArg -> let arg10: Microsoft.FSharp.Core.int = tupledArg.Item0 in let arg11: Microsoft.FSharp.Core.int = tupledArg.Item1 in m.CurriedMethod(arg00,arg01,arg10,arg11) (9,10) (11,12)) @ (110,8--110,9)";
         "let testFunctionThatUsesUnitsOfMeasure(x) (y) = Operators.op_Addition<Microsoft.FSharp.Core.float<'u>,Microsoft.FSharp.Core.float<'u>,Microsoft.FSharp.Core.float<'u>> (x,y) @ (122,70--122,75)";
-        "let testFunctionThatUsesAddressesAndByrefs(x) = let mutable w: Microsoft.FSharp.Core.int = 4 in let y1: Microsoft.FSharp.Core.byref<Microsoft.FSharp.Core.int> = x in let y2: Microsoft.FSharp.Core.byref<Microsoft.FSharp.Core.int> = &w in let arr: Microsoft.FSharp.Core.int Microsoft.FSharp.Core.[] = [|3; 4|] in let r: Microsoft.FSharp.Core.int Microsoft.FSharp.Core.ref = Operators.Ref<Microsoft.FSharp.Core.int> (3) in let y3: Microsoft.FSharp.Core.byref<Microsoft.FSharp.Core.int> = [I_ldelema (NormalAddress,false,ILArrayShapeFIX,!0)](arr,0) in let y4: Microsoft.FSharp.Core.byref<Microsoft.FSharp.Core.int> = &r.contents in let z: Microsoft.FSharp.Core.int = Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (x,y1),y2),y3) in (w <- 3; (x <- 4; (y2 <- 4; (y3 <- 5; Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (z,x),y1),y2),y3),y4),IntrinsicFunctions.GetArray<Microsoft.FSharp.Core.int> (arr,0)),r.contents))))) @ (125,16--125,17)";
+        "let testFunctionThatUsesAddressesAndByrefs(x) = let mutable w: Microsoft.FSharp.Core.int = 4 in let y1: Microsoft.FSharp.Core.byref<Microsoft.FSharp.Core.int> = x in let y2: Microsoft.FSharp.Core.byref<Microsoft.FSharp.Core.int> = &w in let arr: Microsoft.FSharp.Core.int Microsoft.FSharp.Core.[] = [|3; 4|] in let r: Microsoft.FSharp.Core.int Microsoft.FSharp.Core.ref = Operators.Ref<Microsoft.FSharp.Core.int> (3) in let y3: Microsoft.FSharp.Core.byref<Microsoft.FSharp.Core.int> = [I_ldelema (NormalAddress, false, ILArrayShapeFIX, !0)](arr,0) in let y4: Microsoft.FSharp.Core.byref<Microsoft.FSharp.Core.int> = &r.contents in let z: Microsoft.FSharp.Core.int = Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (x,y1),y2),y3) in (w <- 3; (x <- 4; (y2 <- 4; (y3 <- 5; Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (z,x),y1),y2),y3),y4),IntrinsicFunctions.GetArray<Microsoft.FSharp.Core.int> (arr,0)),r.contents))))) @ (125,16--125,17)";
         "let testFunctionThatUsesStructs1(dt) = dt.AddDays(3) @ (139,57--139,72)";
         "let testFunctionThatUsesStructs2(unitVar0) = let dt1: System.DateTime = DateTime.get_Now () in let mutable dt2: System.DateTime = DateTime.get_Now () in let dt3: System.TimeSpan = Operators.op_Subtraction<System.DateTime,System.DateTime,System.TimeSpan> (dt1,dt2) in let dt4: System.DateTime = dt1.AddDays(3) in let dt5: Microsoft.FSharp.Core.int = dt1.get_Millisecond() in let dt6: Microsoft.FSharp.Core.byref<System.DateTime> = &dt2 in let dt7: System.TimeSpan = Operators.op_Subtraction<System.DateTime,System.DateTime,System.TimeSpan> (dt6,dt4) in dt7 @ (142,7--142,10)";
         "let testFunctionThatUsesWhileLoop(unitVar0) = let mutable x: Microsoft.FSharp.Core.int = 1 in (while Operators.op_LessThan<Microsoft.FSharp.Core.int> (x,100) do x <- Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (x,1) done; x) @ (152,15--152,16)";
@@ -745,9 +748,9 @@ let ``Test Unoptimized Declarations Project1`` () =
         "type LetLambda";
         "let f = ((); fun a -> fun b -> Operators.op_Addition<Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (a,b)) @ (246,8--247,24)";
         "let letLambdaRes = Operators.op_PipeRight<(Microsoft.FSharp.Core.int * Microsoft.FSharp.Core.int) Microsoft.FSharp.Collections.list,Microsoft.FSharp.Core.int Microsoft.FSharp.Collections.list> (Cons((1,2),Empty()),let mapping: Microsoft.FSharp.Core.int * Microsoft.FSharp.Core.int -> Microsoft.FSharp.Core.int = fun tupledArg -> let a: Microsoft.FSharp.Core.int = tupledArg.Item0 in let b: Microsoft.FSharp.Core.int = tupledArg.Item1 in (LetLambda.f () a) b in fun list -> ListModule.Map<Microsoft.FSharp.Core.int * Microsoft.FSharp.Core.int,Microsoft.FSharp.Core.int> (mapping,list)) @ (249,19--249,71)";
-        "let anonRecd = {X = 1; Y = 2} @ (251,15--251,33)"
+        "let anonRecd = {X = 1; Y = 2} @ (251,15--251,33)";
         "let anonRecdGet = (M.anonRecd ().X,M.anonRecd ().Y) @ (252,19--252,41)"
-      ]
+        ]
 
     let expected2 = [
         "type N"; "type IntAbbrev"; "let bool2 = False @ (6,12--6,17)";
@@ -780,10 +783,10 @@ let ``Test Unoptimized Declarations Project1`` () =
 
 
 [<Test>]
-//#if NETCOREAPP
-//[<Ignore("SKIPPED: need to check if these tests can be enabled for .NET Core testing of FSharp.Compiler.Service")>]
-//#endif
+// FCS Has a problem with these tests because of FSharp Core versions
+#if !COMPILER_SERVICE_AS_DLL
 [<Ignore("SKIPPED: FSharp.Core nuget package needs to be updated before this test can be re-enabled")>]
+#endif
 let ``Test Optimized Declarations Project1`` () =
     let wholeProjectResults = exprChecker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously