From 2eef99386ffa2081aa054add4e653e011ff1f3b0 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 19 Aug 2020 15:05:22 +0100 Subject: [PATCH 01/10] cleanup old formatting code --- src/fsharp/CompileOptions.fs | 11 +- src/fsharp/NicePrint.fs | 4 +- src/fsharp/Optimizer.fs | 7 +- src/fsharp/fsc.fs | 3 +- src/fsharp/layout.fs | 118 +- src/fsharp/layout.fsi | 2 - src/utils/sformat.fs | 2439 +++++++++++++++++----------------- src/utils/sformat.fsi | 214 ++- 8 files changed, 1378 insertions(+), 1420 deletions(-) diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index a06169304f4..5e9959f5dfb 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.CompileOptions open Internal.Utilities +open Internal.Utilities.StructuredFormat open System open System.IO open FSharp.Compiler @@ -1608,10 +1609,10 @@ let PrintWholeAssemblyImplementation g (tcConfig:TcConfig) outfile header expr = let filename = outfile + ".terms" use f = System.IO.File.CreateText (filename + "-" + string showTermFileCount + "-" + header) showTermFileCount <- showTermFileCount + 1 - Layout.outL f (Layout.squashTo 192 (DebugPrint.implFilesL g expr)) + Layout.outL f (Display.squashTo 192 (DebugPrint.implFilesL g expr)) else dprintf "\n------------------\nshowTerm: %s:\n" header - Layout.outL stderr (Layout.squashTo 192 (DebugPrint.implFilesL g expr)) + Layout.outL stderr (Display.squashTo 192 (DebugPrint.implFilesL g expr)) dprintf "\n------------------\n" //---------------------------------------------------------------------------- @@ -1706,10 +1707,10 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM PrintWholeAssemblyImplementation tcGlobals tcConfig outfile "pass-start" implFiles #if DEBUG if tcConfig.showOptimizationData then - dprintf "Expression prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.implFilesL tcGlobals implFiles))) + dprintf "Expression prior to optimization:\n%s\n" (Layout.showL (Display.squashTo 192 (DebugPrint.implFilesL tcGlobals implFiles))) if tcConfig.showOptimizationData then - dprintf "CCU prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.entityL tcGlobals ccu.Contents))) + dprintf "CCU prior to optimization:\n%s\n" (Layout.showL (Display.squashTo 192 (DebugPrint.entityL tcGlobals ccu.Contents))) #endif let optEnv0 = optEnv @@ -1738,7 +1739,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let optSettings = { optSettings with abstractBigTargets = false; reportingPhase = false } #if DEBUG if tcConfig.showOptimizationData then - dprintf "Optimization implFileOptData:\n%s\n" (Layout.showL (Layout.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData))) + dprintf "Optimization implFileOptData:\n%s\n" (Layout.showL (Display.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData))) #endif let implFile, optEnvExtraLoop = diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index e84a5ebcd2b..cdfbf1ee89a 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -2182,9 +2182,9 @@ let layoutExnDef denv x = x |> TastDefinitionPrinting.layoutExnDefn denv let stringOfTyparConstraints denv x = x |> PrintTypes.layoutConstraintsWithInfo denv SimplifyTypes.typeSimplificationInfo0 |> showL -let outputTycon denv infoReader ad m (* width *) os x = TastDefinitionPrinting.layoutTycon denv infoReader ad m true WordL.keywordType x (* |> Layout.squashTo width *) |> bufferL os +let outputTycon denv infoReader ad m (* width *) os x = TastDefinitionPrinting.layoutTycon denv infoReader ad m true WordL.keywordType x (* |> Display.squashTo width *) |> bufferL os -let layoutTycon denv infoReader ad m (* width *) x = TastDefinitionPrinting.layoutTycon denv infoReader ad m true WordL.keywordType x (* |> Layout.squashTo width *) +let layoutTycon denv infoReader ad m (* width *) x = TastDefinitionPrinting.layoutTycon denv infoReader ad m true WordL.keywordType x (* |> Display.squashTo width *) let layoutUnionCases denv x = x |> TastDefinitionPrinting.layoutUnionCaseFields denv true diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 1c8e4928b0d..1d25344b0fc 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -6,6 +6,7 @@ module internal FSharp.Compiler.Optimizer open Internal.Utilities +open Internal.Utilities.StructuredFormat open FSharp.Compiler open FSharp.Compiler.AbstractIL.Diagnostics @@ -1250,17 +1251,17 @@ let RemapOptimizationInfo g tmenv = let AbstractAndRemapModulInfo msg g m (repackage, hidden) info = let mrpi = mkRepackageRemapping repackage #if DEBUG - if verboseOptimizationInfo then dprintf "%s - %a - Optimization data prior to trim: \n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))) + if verboseOptimizationInfo then dprintf "%s - %a - Optimization data prior to trim: \n%s\n" msg outputRange m (Layout.showL (Display.squashTo 192 (moduleInfoL g info))) #else ignore (msg, m) #endif let info = info |> AbstractLazyModulInfoByHiding false hidden #if DEBUG - if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after trim:\n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))) + if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after trim:\n%s\n" msg outputRange m (Layout.showL (Display.squashTo 192 (moduleInfoL g info))) #endif let info = info |> RemapOptimizationInfo g mrpi #if DEBUG - if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after remap:\n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))) + if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after remap:\n%s\n" msg outputRange m (Layout.showL (Display.squashTo 192 (moduleInfoL g info))) #endif info diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index d4fc5019e6f..68e768acbf6 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -24,6 +24,7 @@ open System.Threading open Internal.Utilities open Internal.Utilities.Collections open Internal.Utilities.Filename +open Internal.Utilities.StructuredFormat open FSharp.Compiler open FSharp.Compiler.AbstractIL @@ -321,7 +322,7 @@ module InterfaceFileWriter = for (TImplFile (_, _, mexpr, _, _, _)) in declaredImpls do let denv = BuildInitialDisplayEnvForSigFileGeneration tcGlobals writeViaBuffer os (fun os s -> Printf.bprintf os "%s\n\n" s) - (NicePrint.layoutInferredSigOfModuleExpr true denv infoReader AccessibleFromSomewhere range0 mexpr |> Layout.squashTo 80 |> Layout.showL) + (NicePrint.layoutInferredSigOfModuleExpr true denv infoReader AccessibleFromSomewhere range0 mexpr |> Display.squashTo 80 |> Layout.showL) if tcConfig.printSignatureFile <> "" then os.Dispose() diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs index 04ec4989256..6debd24b2b6 100644 --- a/src/fsharp/layout.fs +++ b/src/fsharp/layout.fs @@ -245,12 +245,17 @@ let tagListL tagger = function process' x xs let commaListL x = tagListL (fun prefixL -> prefixL ^^ rightL Literals.comma) x + let semiListL x = tagListL (fun prefixL -> prefixL ^^ rightL Literals.semicolon) x + let spaceListL x = tagListL (fun prefixL -> prefixL) x + let sepListL x y = tagListL (fun prefixL -> prefixL ^^ x) y let bracketL l = leftL Literals.leftParen ^^ l ^^ rightL Literals.rightParen + let tupleL xs = bracketL (sepListL (sepL Literals.comma) xs) + let aboveListL = function | [] -> emptyL | [x] -> x @@ -262,119 +267,6 @@ let optionL xL = function let listL xL xs = leftL Literals.leftBracket ^^ sepListL (sepL Literals.semicolon) (List.map xL xs) ^^ rightL Literals.rightBracket - -//-------------------------------------------------------------------------- -//INDEX: breaks v2 -//-------------------------------------------------------------------------- - -// A very quick implementation of break stack. -type breaks = Breaks of - /// pos of next free slot - int * - /// pos of next possible "outer" break - OR - outer=next if none possible - int * - /// stack of savings, -ve means it has been broken - int array - -// next is next slot to push into - aka size of current occupied stack. -// outer counts up from 0, and is next slot to break if break forced. -// - if all breaks forced, then outer=next. -// - popping under these conditions needs to reduce outer and next. -let chunkN = 400 -let breaks0 () = Breaks(0, 0, Array.create chunkN 0) -let pushBreak saving (Breaks(next, outer, stack)) = - let stack = if next = stack.Length then - Array.append stack (Array.create chunkN 0) (* expand if full *) - else - stack - stack.[next] <- saving - Breaks(next+1, outer, stack) - -let popBreak (Breaks(next, outer, stack)) = - if next=0 then raise (Failure "popBreak: underflow") - let topBroke = stack.[next-1] < 0 - let outer = if outer=next then outer-1 else outer (* if all broken, unwind *) - let next = next - 1 - Breaks(next, outer, stack), topBroke - -let forceBreak (Breaks(next, outer, stack)) = - if outer=next then - (* all broken *) - None - else - let saving = stack.[outer] - stack.[outer] <- -stack.[outer] - let outer = outer+1 - Some (Breaks(next, outer, stack), saving) - -let squashTo maxWidth layout = - // breaks = break context, can force to get indentation savings. - // pos = current position in line - // layout = to fit - //------ - // returns: - // breaks - // layout - with breaks put in to fit it. - // pos - current pos in line = rightmost position of last line of block. - // offset - width of last line of block - // NOTE: offset <= pos -- depending on tabbing of last block - let rec fit breaks (pos, layout) = - (*printf "\n\nCalling pos=%d layout=[%s]\n" pos (showL layout)*) - let breaks, layout, pos, offset = - match layout with - | ObjLeaf _ -> failwith "ObjLeaf should not appear here" - | Attr (tag, attrs, l) -> - let breaks, layout, pos, offset = fit breaks (pos, l) - let layout = Attr (tag, attrs, layout) - breaks, layout, pos, offset - | Leaf (_jl, taggedText, _jr) -> - let textWidth = taggedText.Text.Length - let rec fitLeaf breaks pos = - if pos + textWidth <= maxWidth then - breaks, layout, pos + textWidth, textWidth (* great, it fits *) - else - match forceBreak breaks with - None -> (breaks, layout, pos + textWidth, textWidth (* tough, no more breaks *)) - | Some (breaks, saving) -> (let pos = pos - saving in fitLeaf breaks pos) - fitLeaf breaks pos - - | Node (jl, l, jm, r, jr, joint) -> - let mid = if jm then 0 else 1 - match joint with - | Unbreakable -> - let breaks, l, pos, offsetl = fit breaks (pos, l) (* fit left *) - let pos = pos + mid (* fit space if juxt says so *) - let breaks, r, pos, offsetr = fit breaks (pos, r) (* fit right *) - breaks, Node (jl, l, jm, r, jr, Unbreakable), pos, offsetl + mid + offsetr - | Broken indent -> - let breaks, l, pos, offsetl = fit breaks (pos, l) (* fit left *) - let pos = pos - offsetl + indent (* broken so - offset left + indent *) - let breaks, r, pos, offsetr = fit breaks (pos, r) (* fit right *) - breaks, Node (jl, l, jm, r, jr, Broken indent), pos, indent + offsetr - | Breakable indent -> - let breaks, l, pos, offsetl = fit breaks (pos, l) (* fit left *) - (* have a break possibility, with saving *) - let saving = offsetl + mid - indent - let pos = pos + mid - if saving>0 then - let breaks = pushBreak saving breaks - let breaks, r, pos, offsetr = fit breaks (pos, r) - let breaks, broken = popBreak breaks - if broken then - breaks, Node (jl, l, jm, r, jr, Broken indent), pos, indent + offsetr - else - breaks, Node (jl, l, jm, r, jr, Breakable indent), pos, offsetl + mid + offsetr - else - (* actually no saving so no break *) - let breaks, r, pos, offsetr = fit breaks (pos, r) - breaks, Node (jl, l, jm, r, jr, Breakable indent), pos, offsetl + mid + offsetr - (*printf "\nDone: pos=%d offset=%d" pos offset*) - breaks, layout, pos, offset - let breaks = breaks0 () - let pos = 0 - let _breaks, layout, _pos, _offset = fit breaks (pos, layout) - layout - //-------------------------------------------------------------------------- //INDEX: LayoutRenderer //-------------------------------------------------------------------------- diff --git a/src/fsharp/layout.fsi b/src/fsharp/layout.fsi index 88aa8eb35c2..95f81f6cf83 100644 --- a/src/fsharp/layout.fsi +++ b/src/fsharp/layout.fsi @@ -77,8 +77,6 @@ val optionL : ('a -> Layout) -> 'a option -> Layout val listL : ('a -> Layout) -> 'a list -> Layout -val squashTo : int -> Layout -> Layout - val showL : Layout -> string val outL : TextWriter -> Layout -> unit diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs index 2c40158c370..77ce086190c 100644 --- a/src/utils/sformat.fs +++ b/src/utils/sformat.fs @@ -1,16 +1,12 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -// This file is compiled 3(!) times in the codebase +// This file is compiled twice in the codebase // - as the internal implementation of printf '%A' formatting in FSharp.Core -// - as the internal implementation of structured formatting in the compiler and F# Interactive -// defines: COMPILER +// - as the implementation of structured formatting in the compiler, F# Interactive and FSharp.Compiler.Service. // -// The one implementation file is used because we very much want to keep the implementations of -// structured formatting the same for fsi.exe and '%A' printing. However fsi.exe may have +// The one implementation file is used because we keep the implementations of +// structured formatting the same for fsi.exe and '%A' printing. However F# Interactive has // a richer feature set. -// -// Note no layout objects are ever transferred between the above implementations, and in -// all 4 cases the layout types are really different types. #nowarn "52" // The value has been copied to ensure the original is not mutated by this operation @@ -21,1266 +17,1341 @@ namespace Internal.Utilities.StructuredFormat namespace Microsoft.FSharp.Text.StructuredPrintfImpl #endif - // Breakable block layout implementation. - // This is a fresh implementation of pre-existing ideas. +// Breakable block layout implementation. +// This is a fresh implementation of pre-existing ideas. + +open System +open System.IO +open System.Reflection +open System.Globalization +open System.Collections.Generic +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Reflection +open Microsoft.FSharp.Collections + +[] +type LayoutTag = + | ActivePatternCase + | ActivePatternResult + | Alias + | Class + | Union + | UnionCase + | Delegate + | Enum + | Event + | Field + | Interface + | Keyword + | LineBreak + | Local + | Record + | RecordField + | Method + | Member + | ModuleBinding + | Module + | Namespace + | NumericLiteral + | Operator + | Parameter + | Property + | Space + | StringLiteral + | Struct + | TypeParameter + | Text + | Punctuation + | UnknownType + | UnknownEntity + +type TaggedText = + abstract Tag: LayoutTag + abstract Text: string + +type TaggedTextWriter = + abstract Write: t: TaggedText -> unit + abstract WriteLine: unit -> unit + +/// A joint, between 2 layouts, is either: +/// - unbreakable, or +/// - breakable, and if broken the second block has a given indentation. +[] +type Joint = + | Unbreakable + | Breakable of int + | Broken of int + +/// Leaf juxt,data,juxt +/// Node juxt,left,juxt,right,juxt and joint +/// +/// If either juxt flag is true, then no space between words. +[] +type Layout = + | ObjLeaf of bool * obj * bool + | Leaf of bool * TaggedText * bool + | Node of bool * layout * bool * layout * bool * joint + | Attr of string * (string * string) list * layout + +and layout = Layout + +and joint = Joint + +[] +type IEnvironment = + abstract GetLayout: obj -> layout + abstract MaxColumns: int + abstract MaxRows: int + +module TaggedTextOps = + let tag tag text = + { new TaggedText with + member x.Tag = tag + member x.Text = text } + + let length (tt: TaggedText) = tt.Text.Length + let toText (tt: TaggedText) = tt.Text + + let tagAlias t = tag LayoutTag.Alias t + let keywordFunctions = Set ["raise"; "reraise"; "typeof"; "typedefof"; "sizeof"; "nameof"] + let keywordTypes = + [ + "array" + "bigint" + "bool" + "byref" + "byte" + "char" + "decimal" + "double" + "float" + "float32" + "int" + "int8" + "int16" + "int32" + "int64" + "list" + "nativeint" + "obj" + "sbyte" + "seq" + "single" + "string" + "unit" + "uint" + "uint8" + "uint16" + "uint32" + "uint64" + "unativeint" + ] |> Set.ofList + let tagClass name = if Set.contains name keywordTypes then tag LayoutTag.Keyword name else tag LayoutTag.Class name + let tagUnionCase t = tag LayoutTag.UnionCase t + let tagDelegate t = tag LayoutTag.Delegate t + let tagEnum t = tag LayoutTag.Enum t + let tagEvent t = tag LayoutTag.Event t + let tagField t = tag LayoutTag.Field t + let tagInterface t = tag LayoutTag.Interface t + let tagKeyword t = tag LayoutTag.Keyword t + let tagLineBreak t = tag LayoutTag.LineBreak t + let tagLocal t = tag LayoutTag.Local t + let tagRecord t = tag LayoutTag.Record t + let tagRecordField t = tag LayoutTag.RecordField t + let tagMethod t = tag LayoutTag.Method t + let tagModule t = tag LayoutTag.Module t + let tagModuleBinding name = if keywordFunctions.Contains name then tag LayoutTag.Keyword name else tag LayoutTag.ModuleBinding name + let tagNamespace t = tag LayoutTag.Namespace t + let tagNumericLiteral t = tag LayoutTag.NumericLiteral t + let tagOperator t = tag LayoutTag.Operator t + let tagParameter t = tag LayoutTag.Parameter t + let tagProperty t = tag LayoutTag.Property t + let tagSpace t = tag LayoutTag.Space t + let tagStringLiteral t = tag LayoutTag.StringLiteral t + let tagStruct t = tag LayoutTag.Struct t + let tagTypeParameter t = tag LayoutTag.TypeParameter t + let tagText t = tag LayoutTag.Text t + let tagPunctuation t = tag LayoutTag.Punctuation t + + module Literals = + // common tagged literals + let lineBreak = tagLineBreak "\n" + let space = tagSpace " " + let comma = tagPunctuation "," + let semicolon = tagPunctuation ";" + let leftParen = tagPunctuation "(" + let rightParen = tagPunctuation ")" + let leftBracket = tagPunctuation "[" + let rightBracket = tagPunctuation "]" + let leftBrace= tagPunctuation "{" + let rightBrace = tagPunctuation "}" + let leftBraceBar = tagPunctuation "{|" + let rightBraceBar = tagPunctuation "|}" + let equals = tagOperator "=" + let arrow = tagPunctuation "->" + let questionMark = tagPunctuation "?" + +module LayoutOps = + open TaggedTextOps - open System - open System.IO - open System.Reflection - open System.Globalization - open System.Collections.Generic - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Reflection - open Microsoft.FSharp.Collections + let rec juxtLeft lf = + match lf with + | ObjLeaf (jl,_,_) -> jl + | Leaf (jl,_,_) -> jl + | Node (jl,_,_,_,_,_) -> jl + | Attr (_,_,l) -> juxtLeft l - [] - type LayoutTag = - | ActivePatternCase - | ActivePatternResult - | Alias - | Class - | Union - | UnionCase - | Delegate - | Enum - | Event - | Field - | Interface - | Keyword - | LineBreak - | Local - | Record - | RecordField - | Method - | Member - | ModuleBinding - | Module - | Namespace - | NumericLiteral - | Operator - | Parameter - | Property - | Space - | StringLiteral - | Struct - | TypeParameter - | Text - | Punctuation - | UnknownType - | UnknownEntity - - type TaggedText = - abstract Tag: LayoutTag - abstract Text: string - - type TaggedTextWriter = - abstract Write: t: TaggedText -> unit - abstract WriteLine: unit -> unit - - /// A joint, between 2 layouts, is either: - /// - unbreakable, or - /// - breakable, and if broken the second block has a given indentation. - [] - type Joint = - | Unbreakable - | Breakable of int - | Broken of int - - /// Leaf juxt,data,juxt - /// Node juxt,left,juxt,right,juxt and joint - /// - /// If either juxt flag is true, then no space between words. - [] - type Layout = - | ObjLeaf of bool * obj * bool - | Leaf of bool * TaggedText * bool - | Node of bool * layout * bool * layout * bool * joint - | Attr of string * (string * string) list * layout + let rec juxtRight lf = + match lf with + | ObjLeaf (_,_,jr) -> jr + | Leaf (_,_,jr) -> jr + | Node (_,_,_,_,jr,_) -> jr + | Attr (_,_,l) -> juxtRight l - and layout = Layout + let mkNode l r joint = + let jl = juxtLeft l + let jm = juxtRight l || juxtLeft r + let jr = juxtRight r + Node(jl,l,jm,r,jr,joint) - and joint = Joint + // constructors + let objL (value:obj) = + match value with + | :? string as s -> Leaf (false, tag LayoutTag.Text s, false) + | o -> ObjLeaf (false, o, false) - [] - type IEnvironment = - abstract GetLayout : obj -> layout - abstract MaxColumns : int - abstract MaxRows : int - - module TaggedTextOps = - let tag tag text = - { new TaggedText with - member x.Tag = tag - member x.Text = text } - - let length (tt: TaggedText) = tt.Text.Length - let toText (tt: TaggedText) = tt.Text - - let tagAlias t = tag LayoutTag.Alias t - let keywordFunctions = Set ["raise"; "reraise"; "typeof"; "typedefof"; "sizeof"; "nameof"] - let keywordTypes = - [ - "array" - "bigint" - "bool" - "byref" - "byte" - "char" - "decimal" - "double" - "float" - "float32" - "int" - "int8" - "int16" - "int32" - "int64" - "list" - "nativeint" - "obj" - "sbyte" - "seq" - "single" - "string" - "unit" - "uint" - "uint8" - "uint16" - "uint32" - "uint64" - "unativeint" - ] |> Set.ofList - let tagClass name = if Set.contains name keywordTypes then tag LayoutTag.Keyword name else tag LayoutTag.Class name - let tagUnionCase t = tag LayoutTag.UnionCase t - let tagDelegate t = tag LayoutTag.Delegate t - let tagEnum t = tag LayoutTag.Enum t - let tagEvent t = tag LayoutTag.Event t - let tagField t = tag LayoutTag.Field t - let tagInterface t = tag LayoutTag.Interface t - let tagKeyword t = tag LayoutTag.Keyword t - let tagLineBreak t = tag LayoutTag.LineBreak t - let tagLocal t = tag LayoutTag.Local t - let tagRecord t = tag LayoutTag.Record t - let tagRecordField t = tag LayoutTag.RecordField t - let tagMethod t = tag LayoutTag.Method t - let tagModule t = tag LayoutTag.Module t - let tagModuleBinding name = if keywordFunctions.Contains name then tag LayoutTag.Keyword name else tag LayoutTag.ModuleBinding name - let tagNamespace t = tag LayoutTag.Namespace t - let tagNumericLiteral t = tag LayoutTag.NumericLiteral t - let tagOperator t = tag LayoutTag.Operator t - let tagParameter t = tag LayoutTag.Parameter t - let tagProperty t = tag LayoutTag.Property t - let tagSpace t = tag LayoutTag.Space t - let tagStringLiteral t = tag LayoutTag.StringLiteral t - let tagStruct t = tag LayoutTag.Struct t - let tagTypeParameter t = tag LayoutTag.TypeParameter t - let tagText t = tag LayoutTag.Text t - let tagPunctuation t = tag LayoutTag.Punctuation t - - module Literals = - // common tagged literals - let lineBreak = tagLineBreak "\n" - let space = tagSpace " " - let comma = tagPunctuation "," - let semicolon = tagPunctuation ";" - let leftParen = tagPunctuation "(" - let rightParen = tagPunctuation ")" - let leftBracket = tagPunctuation "[" - let rightBracket = tagPunctuation "]" - let leftBrace= tagPunctuation "{" - let rightBrace = tagPunctuation "}" - let leftBraceBar = tagPunctuation "{|" - let rightBraceBar = tagPunctuation "|}" - let equals = tagOperator "=" - let arrow = tagPunctuation "->" - let questionMark = tagPunctuation "?" - - module LayoutOps = - open TaggedTextOps + let sLeaf (l, t, r) = Leaf (l, t, r) - let rec juxtLeft = function - | ObjLeaf (jl,_,_) -> jl - | Leaf (jl,_,_) -> jl - | Node (jl,_,_,_,_,_) -> jl - | Attr (_,_,l) -> juxtLeft l + let wordL text = sLeaf (false,text,false) - let rec juxtRight = function - | ObjLeaf (_,_,jr) -> jr - | Leaf (_,_,jr) -> jr - | Node (_,_,_,_,jr,_) -> jr - | Attr (_,_,l) -> juxtRight l + let sepL text = sLeaf (true ,text,true) - let mkNode l r joint = - let jl = juxtLeft l - let jm = juxtRight l || juxtLeft r - let jr = juxtRight r - Node(jl,l,jm,r,jr,joint) + let rightL text = sLeaf (true ,text,false) + let leftL text = sLeaf (false,text,true) - // constructors + let emptyL = sLeaf (true, tag LayoutTag.Text "",true) + let isEmptyL layout = + match layout with + | Leaf(true, s, true) -> s.Text = "" + | _ -> false - let objL (value:obj) = - match value with - | :? string as s -> Leaf (false, tag LayoutTag.Text s, false) - | o -> ObjLeaf (false, o, false) + let aboveL layout1 layout2 = mkNode layout1 layout2 (Broken 0) - let sLeaf (l, t, r) = Leaf (l, t, r) + let tagAttrL text maps layout = Attr(text,maps,layout) - let wordL text = sLeaf (false,text,false) - let sepL text = sLeaf (true ,text,true) - let rightL text = sLeaf (true ,text,false) - let leftL text = sLeaf (false,text,true) + let apply2 f l r = + if isEmptyL l then r + elif isEmptyL r then l + else f l r - let emptyL = sLeaf (true, tag LayoutTag.Text "",true) + let (^^) layout1 layout2 = mkNode layout1 layout2 (Unbreakable) - let isEmptyL layout = - match layout with - | Leaf(true, s, true) -> s.Text = "" - | _ -> false - - let aboveL layout1 layout2 = mkNode layout1 layout2 (Broken 0) - - let tagAttrL text maps layout = Attr(text,maps,layout) - - let apply2 f l r = if isEmptyL l then r else - if isEmptyL r then l else f l r - - let (^^) layout1 layout2 = mkNode layout1 layout2 (Unbreakable) - let (++) layout1 layout2 = mkNode layout1 layout2 (Breakable 0) - let (--) layout1 layout2 = mkNode layout1 layout2 (Breakable 1) - let (---) layout1 layout2 = mkNode layout1 layout2 (Breakable 2) - let (@@) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 0)) layout1 layout2 - let (@@-) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 1)) layout1 layout2 - let (@@--) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 2)) layout1 layout2 - let tagListL tagger = function - | [] -> emptyL - | [x] -> x - | x :: xs -> - let rec process' prefixL = function - | [] -> prefixL - | y :: ys -> process' ((tagger prefixL) ++ y) ys - process' x xs + let (++) layout1 layout2 = mkNode layout1 layout2 (Breakable 0) + + let (--) layout1 layout2 = mkNode layout1 layout2 (Breakable 1) + + let (---) layout1 layout2 = mkNode layout1 layout2 (Breakable 2) + + let (@@) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 0)) layout1 layout2 + + let (@@-) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 1)) layout1 layout2 + + let (@@--) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 2)) layout1 layout2 + + let tagListL tagger els = + match els with + | [] -> emptyL + | [x] -> x + | x :: xs -> + let rec process' prefixL yl = + match yl with + | [] -> prefixL + | y :: ys -> process' ((tagger prefixL) ++ y) ys + process' x xs - let commaListL layouts = tagListL (fun prefixL -> prefixL ^^ rightL (Literals.comma)) layouts - let semiListL layouts = tagListL (fun prefixL -> prefixL ^^ rightL (Literals.semicolon)) layouts - let spaceListL layouts = tagListL (fun prefixL -> prefixL) layouts - let sepListL layout1 layouts = tagListL (fun prefixL -> prefixL ^^ layout1) layouts - let bracketL layout = leftL Literals.leftParen ^^ layout ^^ rightL Literals.rightParen - let tupleL layouts = bracketL (sepListL (sepL Literals.comma) layouts) - let aboveListL layouts = - match layouts with - | [] -> emptyL - | [x] -> x - | x :: ys -> List.fold (fun pre y -> pre @@ y) x ys - - let optionL selector value = - match value with - | None -> wordL (tagUnionCase "None") - | Some x -> wordL (tagUnionCase "Some") -- (selector x) - - let listL selector value = leftL Literals.leftBracket ^^ sepListL (sepL Literals.semicolon) (List.map selector value) ^^ rightL Literals.rightBracket - - let squareBracketL layout = leftL Literals.leftBracket ^^ layout ^^ rightL Literals.rightBracket - - let braceL layout = leftL Literals.leftBrace ^^ layout ^^ rightL Literals.rightBrace - - let boundedUnfoldL - (itemL : 'a -> layout) - (project : 'z -> ('a * 'z) option) - (stopShort : 'z -> bool) - (z : 'z) - maxLength = - let rec consume n z = + let commaListL layouts = tagListL (fun prefixL -> prefixL ^^ rightL (Literals.comma)) layouts + + let semiListL layouts = tagListL (fun prefixL -> prefixL ^^ rightL (Literals.semicolon)) layouts + + let spaceListL layouts = tagListL (fun prefixL -> prefixL) layouts + + let sepListL layout1 layouts = tagListL (fun prefixL -> prefixL ^^ layout1) layouts + + let bracketL layout = leftL Literals.leftParen ^^ layout ^^ rightL Literals.rightParen + + let tupleL layouts = bracketL (sepListL (sepL Literals.comma) layouts) + + let aboveListL layouts = + match layouts with + | [] -> emptyL + | [x] -> x + | x :: ys -> List.fold (fun pre y -> pre @@ y) x ys + + let optionL selector value = + match value with + | None -> wordL (tagUnionCase "None") + | Some x -> wordL (tagUnionCase "Some") -- (selector x) + + let listL selector value = + leftL Literals.leftBracket ^^ sepListL (sepL Literals.semicolon) (List.map selector value) ^^ rightL Literals.rightBracket + + let squareBracketL layout = + leftL Literals.leftBracket ^^ layout ^^ rightL Literals.rightBracket + + let braceL layout = + leftL Literals.leftBrace ^^ layout ^^ rightL Literals.rightBrace + + let boundedUnfoldL + (itemL: 'a -> layout) + (project: 'z -> ('a * 'z) option) + (stopShort: 'z -> bool) + (z: 'z) + maxLength = + + let rec consume n z = if stopShort z then [wordL (tagPunctuation "...")] else match project z with - | None -> [] // exhausted input - | Some (x,z) -> if n<=0 then [wordL (tagPunctuation "...")] // hit print_length limit - else itemL x :: consume (n-1) z // cons recursive... - consume maxLength z + | None -> [] // exhausted input + | Some (x,z) -> if n<=0 then [wordL (tagPunctuation "...")] // hit print_length limit + else itemL x :: consume (n-1) z // cons recursive... + consume maxLength z - let unfoldL selector folder state count = boundedUnfoldL selector folder (fun _ -> false) state count + let unfoldL selector folder state count = + boundedUnfoldL selector folder (fun _ -> false) state count - /// These are a typical set of options used to control structured formatting. - [] - type FormatOptions = - { FloatingPointFormat: string; - AttributeProcessor: (string -> (string * string) list -> bool -> unit); +/// These are a typical set of options used to control structured formatting. +[] +type FormatOptions = + { FloatingPointFormat: string + AttributeProcessor: (string -> (string * string) list -> bool -> unit) #if COMPILER // This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter - PrintIntercepts: (IEnvironment -> obj -> Layout option) list; - StringLimit : int; + PrintIntercepts: (IEnvironment -> obj -> Layout option) list + StringLimit: int #endif - FormatProvider: System.IFormatProvider; - BindingFlags: System.Reflection.BindingFlags - PrintWidth : int; - PrintDepth : int; - PrintLength : int; - PrintSize : int; - ShowProperties : bool; - ShowIEnumerable: bool; } - static member Default = - { FormatProvider = (System.Globalization.CultureInfo.InvariantCulture :> System.IFormatProvider); + FormatProvider: IFormatProvider + BindingFlags: BindingFlags + PrintWidth: int + PrintDepth: int + PrintLength: int + PrintSize: int + ShowProperties: bool + ShowIEnumerable: bool + } + + static member Default = + { FormatProvider = (CultureInfo.InvariantCulture :> IFormatProvider) #if COMPILER // This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter - PrintIntercepts = []; - StringLimit = System.Int32.MaxValue; + PrintIntercepts = [] + StringLimit = Int32.MaxValue #endif - AttributeProcessor= (fun _ _ _ -> ()); - BindingFlags = System.Reflection.BindingFlags.Public; - FloatingPointFormat = "g10"; - PrintWidth = 80 ; - PrintDepth = 100 ; - PrintLength = 100; - PrintSize = 10000; - ShowProperties = false; - ShowIEnumerable = true; } - - - - module ReflectUtils = - - [] - type TypeInfo = - | TupleType of Type list - | FunctionType of Type * Type - | RecordType of (string * Type) list - | SumType of (string * (string * Type) list) list - | UnitType - | ObjectType of Type - - let isNamedType (ty:Type) = not (ty.IsArray || ty.IsByRef || ty.IsPointer) - let equivHeadTypes (ty1:Type) (ty2:Type) = - isNamedType(ty1) && - if ty1.IsGenericType then - ty2.IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(ty2.GetGenericTypeDefinition()) - else - ty1.Equals(ty2) - - let option = typedefof - let func = typedefof<(obj -> obj)> - - let isOptionTy ty = equivHeadTypes ty (typeof) - let isUnitType ty = equivHeadTypes ty (typeof) - let isListType ty = - FSharpType.IsUnion ty && - (let cases = FSharpType.GetUnionCases ty - cases.Length > 0 && equivHeadTypes (typedefof>) cases.[0].DeclaringType) - - [] - type TupleType = - | Value - | Reference - - [] - type ValueInfo = - | TupleValue of TupleType * (obj * Type) list - | FunctionClosureValue of System.Type - | RecordValue of (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 = - - // Returns true if a given type has the RequireQualifiedAccess attribute - let private requiresQualifiedAccess (declaringType:Type) = - let rqaAttr = declaringType.GetCustomAttribute(typeof, false) - isNull rqaAttr |> not - - // Analyze an object to see if it the representation - // of an F# value. - let GetValueInfoOfObject (bindingFlags:BindingFlags) (obj : obj) = - match obj with - | null -> ObjectValue(obj) - | _ -> - let reprty = obj.GetType() - - // First a bunch of special rules for tuples - // Because of the way F# currently compiles tuple values - // of size > 7 we can only reliably reflect on sizes up - // to 7. - - if FSharpType.IsTuple reprty then - let tyArgs = FSharpType.GetTupleElements(reprty) - 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 + AttributeProcessor= (fun _ _ _ -> ()) + BindingFlags = BindingFlags.Public + FloatingPointFormat = "g10" + PrintWidth = 80 + PrintDepth = 100 + PrintLength = 100 + PrintSize = 10000 + ShowProperties = false + ShowIEnumerable = true + } + +module ReflectUtils = + + [] + type TypeInfo = + | TupleType of Type list + | FunctionType of Type * Type + | RecordType of (string * Type) list + | SumType of (string * (string * Type) list) list + | UnitType + | ObjectType of Type + + let isNamedType (ty:Type) = not (ty.IsArray || ty.IsByRef || ty.IsPointer) + + let equivHeadTypes (ty1:Type) (ty2:Type) = + isNamedType(ty1) && + if ty1.IsGenericType then + ty2.IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(ty2.GetGenericTypeDefinition()) + else + ty1.Equals(ty2) + + let option = typedefof + + let func = typedefof<(obj -> obj)> + + let isOptionTy ty = equivHeadTypes ty (typeof) + + let isUnitType ty = equivHeadTypes ty (typeof) + + let isListType ty = + FSharpType.IsUnion ty && + (let cases = FSharpType.GetUnionCases ty + cases.Length > 0 && equivHeadTypes (typedefof>) cases.[0].DeclaringType) + + [] + type TupleType = + | Value + | Reference + + [] + type ValueInfo = + | TupleValue of TupleType * (obj * Type)[] + | FunctionClosureValue of Type + | RecordValue of (string * obj * Type)[] + | UnionCaseValue of declaringType: Type option * string * (string * (obj * Type))[] + | ExceptionValue of Type * (string * (obj * Type))[] + | NullValue + | UnitValue + | ObjectValue of obj + + module Value = + + // Returns true if a given type has the RequireQualifiedAccess attribute + let private requiresQualifiedAccess (declaringType: Type) = + let rqaAttr = declaringType.GetCustomAttribute(typeof, false) + isNull rqaAttr |> not + + // Analyze an object to see if it the representation + // of an F# value. + let GetValueInfoOfObject (bindingFlags: BindingFlags) (obj: obj) = + match obj with + | null -> NullValue + | _ -> + let reprty = obj.GetType() + + // First a bunch of special rules for tuples + // Because of the way F# currently compiles tuple values + // of size > 7 we can only reliably reflect on sizes up + // to 7. + + if FSharpType.IsTuple reprty then + let tyArgs = FSharpType.GetTupleElements(reprty) + let fields = FSharpValue.GetTupleFields obj |> Array.mapi (fun i v -> (v, tyArgs.[i])) + let tupleType = + if reprty.Name.StartsWith "ValueTuple" then TupleType.Value + else TupleType.Reference + TupleValue (tupleType, fields) + + elif FSharpType.IsFunction reprty then + FunctionClosureValue reprty - // It must be exception, abstract, record or union. - // Either way we assume the only properties defined on - // the type are the actual fields of the type. Again, - // we should be reading attributes here that indicate the - // true structure of the type, e.g. the order of the fields. - elif FSharpType.IsUnion(reprty,bindingFlags) then - 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)) + // It must be exception, abstract, record or union. + // Either way we assume the only properties defined on + // the type are the actual fields of the type. Again, + // we should be reading attributes here that indicate the + // true structure of the type, e.g. the order of the fields. + elif FSharpType.IsUnion(reprty,bindingFlags) then + 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)) + let declaringType = + if requiresQualifiedAccess tag.DeclaringType then Some tag.DeclaringType + else None + UnionCaseValue(declaringType, tag.Name, pvals) + + elif FSharpType.IsExceptionRepresentation(reprty,bindingFlags) then + let props = FSharpType.GetExceptionFields(reprty,bindingFlags) + let vals = FSharpValue.GetExceptionFields(obj,bindingFlags) + let pvals = (props, vals) ||> Array.map2 (fun prop v -> prop.Name, (v, prop.PropertyType)) + ExceptionValue(reprty, pvals) + + elif FSharpType.IsRecord(reprty,bindingFlags) then + let props = FSharpType.GetRecordFields(reprty, bindingFlags) + RecordValue(props |> Array.map (fun prop -> prop.Name, prop.GetValue (obj, null), prop.PropertyType)) + else + ObjectValue(obj) + + // This one is like the above but can make use of additional + // statically-known type information to aid in the + // analysis of null values. + + let GetValueInfo bindingFlags (x: 'a, ty: Type) (* x could be null *) = + let obj = (box x) + match obj with + | null -> + let isNullaryUnion = + match ty.GetCustomAttributes(typeof, 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 let declaringType = - if requiresQualifiedAccess tag.DeclaringType then Some tag.DeclaringType + if requiresQualifiedAccess ty then Some ty 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) - let pvals = (props,vals) ||> Array.map2 (fun prop v -> prop.Name,(v, prop.PropertyType)) - ExceptionValue(reprty, pvals |> Array.toList) - elif FSharpType.IsRecord(reprty,bindingFlags) then - let props = FSharpType.GetRecordFields(reprty,bindingFlags) - RecordValue(props |> Array.map (fun prop -> prop.Name, prop.GetValue(obj,null), prop.PropertyType) |> Array.toList) - else - ObjectValue(obj) + UnionCaseValue(declaringType, nullaryCase.Name, [| |]) + elif isUnitType ty then UnitValue + else NullValue + | _ -> + GetValueInfoOfObject bindingFlags (obj) - // This one is like the above but can make use of additional - // statically-known type information to aid in the - // analysis of null values. +module Display = - let GetValueInfo bindingFlags (x : 'a, ty : Type) (* x could be null *) = - let obj = (box x) - match obj with - | null -> - let isNullaryUnion = - match ty.GetCustomAttributes(typeof, 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 - 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) - - module Display = - - open ReflectUtils - open LayoutOps - open TaggedTextOps - - let string_of_int (i:int) = i.ToString() - - let typeUsesSystemObjectToString (ty:System.Type) = - try - let methInfo = ty.GetMethod("ToString",BindingFlags.Public ||| BindingFlags.Instance,null,[| |],null) - methInfo.DeclaringType = typeof - with e -> false - /// If "str" ends with "ending" then remove it from "str", otherwise no change. - let trimEnding (ending:string) (str:string) = - if str.EndsWith(ending,StringComparison.Ordinal) then - str.Substring(0,str.Length - ending.Length) - else str - - let catchExn f = try Choice1Of2 (f ()) with e -> Choice2Of2 e - - // An implementation of break stack. - // Uses mutable state, relying on linear threading of the state. - - [] - type Breaks = - Breaks of - int * // pos of next free slot - int * // pos of next possible "outer" break - OR - outer=next if none possible - int array // stack of savings, -ve means it has been broken - - // next is next slot to push into - aka size of current occupied stack. - // outer counts up from 0, and is next slot to break if break forced. - // - if all breaks forced, then outer=next. - // - popping under these conditions needs to reduce outer and next. + open ReflectUtils + open LayoutOps + open TaggedTextOps + + let string_of_int (i:int) = i.ToString() + + let typeUsesSystemObjectToString (ty:System.Type) = + try + let methInfo = ty.GetMethod("ToString",BindingFlags.Public ||| BindingFlags.Instance,null,[| |],null) + methInfo.DeclaringType = typeof + with _e -> false + + /// If "str" ends with "ending" then remove it from "str", otherwise no change. + let trimEnding (ending:string) (str:string) = + if str.EndsWith(ending,StringComparison.Ordinal) then + str.Substring(0,str.Length - ending.Length) + else str + + let catchExn f = try Choice1Of2 (f ()) with e -> Choice2Of2 e + + // An implementation of break stack. + // Uses mutable state, relying on linear threading of the state. + + [] + type Breaks = + Breaks of + /// pos of next free slot + nextFreeSlot: int * + /// pos of next possible "outer" break - OR - outer=next if none possible + nextOuterBreak: int * + /// stack of savings, -ve means it has been broken + savingsStack: int[] + + // next is next slot to push into - aka size of current occupied stack. + // outer counts up from 0, and is next slot to break if break forced. + // - if all breaks forced, then outer=next. + // - popping under these conditions needs to reduce outer and next. - //let dumpBreaks prefix (Breaks(next,outer,stack)) = () - // printf "%s: next=%d outer=%d stack.Length=%d\n" prefix next outer stack.Length; - // stdout.Flush() + //let dumpBreaks prefix (Breaks(next,outer,stack)) = () + // printf "%s: next=%d outer=%d stack.Length=%d\n" prefix next outer stack.Length; + // stdout.Flush() - let chunkN = 400 - let breaks0 () = Breaks(0,0,Array.create chunkN 0) - - let pushBreak saving (Breaks(next,outer,stack)) = - //dumpBreaks "pushBreak" (next,outer,stack); - let stack = - if next = stack.Length then - Array.init (next + chunkN) (fun i -> if i < next then stack.[i] else 0) // expand if full - else - stack - - stack.[next] <- saving; - Breaks(next+1,outer,stack) - - let popBreak (Breaks(next,outer,stack)) = - //dumpBreaks "popBreak" (next,outer,stack); - if next=0 then raise (Failure "popBreak: underflow"); - let topBroke = stack.[next-1] < 0 - let outer = if outer=next then outer-1 else outer // if all broken, unwind - let next = next - 1 - Breaks(next,outer,stack),topBroke - - let forceBreak (Breaks(next,outer,stack)) = - //dumpBreaks "forceBreak" (next,outer,stack); - if outer=next then - // all broken - None + let chunkN = 400 + let breaks0 () = Breaks(0,0,Array.create chunkN 0) + + let pushBreak saving (Breaks(next,outer,stack)) = + //dumpBreaks "pushBreak" (next,outer,stack); + let stack = + if next = stack.Length then + Array.init (next + chunkN) (fun i -> if i < next then stack.[i] else 0) // expand if full else - let saving = stack.[outer] - stack.[outer] <- -stack.[outer]; - let outer = outer+1 - Some (Breaks(next,outer,stack),saving) - - // ------------------------------------------------------------------------- - // fitting - // ------------------------------------------------------------------------ - - let squashTo (maxWidth,leafFormatter : _ -> TaggedText) layout = - let (|ObjToTaggedText|) = leafFormatter - if maxWidth <= 0 then layout else - let rec fit breaks (pos,layout) = - // breaks = break context, can force to get indentation savings. - // pos = current position in line - // layout = to fit - //------ - // returns: - // breaks - // layout - with breaks put in to fit it. - // pos - current pos in line = rightmost position of last line of block. - // offset - width of last line of block - // NOTE: offset <= pos -- depending on tabbing of last block + stack + + stack.[next] <- saving; + Breaks(next+1,outer,stack) + + let popBreak (Breaks(next,outer,stack)) = + //dumpBreaks "popBreak" (next,outer,stack); + if next=0 then raise (Failure "popBreak: underflow"); + let topBroke = stack.[next-1] < 0 + let outer = if outer=next then outer-1 else outer // if all broken, unwind + let next = next - 1 + Breaks(next,outer,stack),topBroke + + let forceBreak (Breaks(next,outer,stack)) = + //dumpBreaks "forceBreak" (next,outer,stack); + if outer=next then + // all broken + None + else + let saving = stack.[outer] + stack.[outer] <- -stack.[outer]; + let outer = outer+1 + Some (Breaks(next,outer,stack),saving) + + /// fitting + let squashToAux (maxWidth,leafFormatter: _ -> TaggedText) layout = + let (|ObjToTaggedText|) = leafFormatter + if maxWidth <= 0 then layout else + let rec fit breaks (pos,layout) = + // breaks = break context, can force to get indentation savings. + // pos = current position in line + // layout = to fit + //------ + // returns: + // breaks + // layout - with breaks put in to fit it. + // pos - current pos in line = rightmost position of last line of block. + // offset - width of last line of block + // NOTE: offset <= pos -- depending on tabbing of last block - let breaks,layout,pos,offset = - match layout with - | Attr (tag,attrs,l) -> - let breaks,layout,pos,offset = fit breaks (pos,l) - let layout = Attr (tag,attrs,layout) - breaks,layout,pos,offset - | Leaf (jl, text, jr) - | ObjLeaf (jl, ObjToTaggedText text, jr) -> - // save the formatted text from the squash - let layout = Leaf(jl, text, jr) - let textWidth = length text - let rec fitLeaf breaks pos = - if pos + textWidth <= maxWidth then - breaks,layout,pos + textWidth,textWidth // great, it fits - else - match forceBreak breaks with - | None -> - breaks,layout,pos + textWidth,textWidth // tough, no more breaks - | Some (breaks,saving) -> - let pos = pos - saving - fitLeaf breaks pos + let breaks,layout,pos,offset = + match layout with + | Attr (tag,attrs,l) -> + let breaks,layout,pos,offset = fit breaks (pos,l) + let layout = Attr (tag,attrs,layout) + breaks,layout,pos,offset + | Leaf (jl, text, jr) + | ObjLeaf (jl, ObjToTaggedText text, jr) -> + // save the formatted text from the squash + let layout = Leaf(jl, text, jr) + let textWidth = length text + let rec fitLeaf breaks pos = + if pos + textWidth <= maxWidth then + breaks,layout,pos + textWidth,textWidth // great, it fits + else + match forceBreak breaks with + | None -> + breaks,layout,pos + textWidth,textWidth // tough, no more breaks + | Some (breaks,saving) -> + let pos = pos - saving + fitLeaf breaks pos - fitLeaf breaks pos - | Node (jl,l,jm,r,jr,joint) -> - let mid = if jm then 0 else 1 - match joint with - | Unbreakable -> - let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left - let pos = pos + mid // fit space if juxt says so - let breaks,r,pos,offsetr = fit breaks (pos,r) // fit right - breaks,Node (jl,l,jm,r,jr,Unbreakable),pos,offsetl + mid + offsetr - | Broken indent -> - let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left - let pos = pos - offsetl + indent // broken so - offset left + ident - let breaks,r,pos,offsetr = fit breaks (pos,r) // fit right - breaks,Node (jl,l,jm,r,jr,Broken indent),pos,indent + offsetr - | Breakable indent -> - let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left - // have a break possibility, with saving - let saving = offsetl + mid - indent - let pos = pos + mid - if saving>0 then - let breaks = pushBreak saving breaks - let breaks,r,pos,offsetr = fit breaks (pos,r) - let breaks,broken = popBreak breaks - if broken then - breaks,Node (jl,l,jm,r,jr,Broken indent) ,pos,indent + offsetr - else - breaks,Node (jl,l,jm,r,jr,Breakable indent),pos,offsetl + mid + offsetr + fitLeaf breaks pos + | Node (jl,l,jm,r,jr,joint) -> + let mid = if jm then 0 else 1 + match joint with + | Unbreakable -> + let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left + let pos = pos + mid // fit space if juxt says so + let breaks,r,pos,offsetr = fit breaks (pos,r) // fit right + breaks,Node (jl,l,jm,r,jr,Unbreakable),pos,offsetl + mid + offsetr + | Broken indent -> + let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left + let pos = pos - offsetl + indent // broken so - offset left + ident + let breaks,r,pos,offsetr = fit breaks (pos,r) // fit right + breaks,Node (jl,l,jm,r,jr,Broken indent),pos,indent + offsetr + | Breakable indent -> + let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left + // have a break possibility, with saving + let saving = offsetl + mid - indent + let pos = pos + mid + if saving>0 then + let breaks = pushBreak saving breaks + let breaks,r,pos,offsetr = fit breaks (pos,r) + let breaks,broken = popBreak breaks + if broken then + breaks,Node (jl,l,jm,r,jr,Broken indent) ,pos,indent + offsetr else - // actually no saving so no break - let breaks,r,pos,offsetr = fit breaks (pos,r) - breaks,Node (jl,l,jm,r,jr,Breakable indent) ,pos,offsetl + mid + offsetr + breaks,Node (jl,l,jm,r,jr,Breakable indent),pos,offsetl + mid + offsetr + else + // actually no saving so no break + let breaks,r,pos,offsetr = fit breaks (pos,r) + breaks,Node (jl,l,jm,r,jr,Breakable indent) ,pos,offsetl + mid + offsetr - //printf "\nDone: pos=%d offset=%d" pos offset; - breaks,layout,pos,offset + //printf "\nDone: pos=%d offset=%d" pos offset; + breaks,layout,pos,offset - let breaks = breaks0 () - let pos = 0 - let _,layout,_,_ = fit breaks (pos,layout) - layout - - // ------------------------------------------------------------------------- - // showL - // ------------------------------------------------------------------------ - - let combine (strs: string list) = System.String.Concat strs - let showL opts leafFormatter layout = - let push x rstrs = x :: rstrs - let z0 = [],0 - let addText (rstrs,i) (text:string) = push text rstrs,i + text.Length - let index (_,i) = i - let extract rstrs = combine(List.rev rstrs) - let newLine (rstrs,_) n = // \n then spaces... - let indent = new System.String(' ', n) - let rstrs = push "\n" rstrs - let rstrs = push indent rstrs - rstrs,n - - // addL: pos is tab level - let rec addL z pos layout = - match layout with - | ObjLeaf (_,obj,_) -> - let text = leafFormatter obj - addText z text - | Leaf (_,obj,_) -> - addText z obj.Text - | Node (_,l,_,r,_,Broken indent) - // Print width = 0 implies 1D layout, no squash - when not (opts.PrintWidth = 0) -> - let z = addL z pos l - let z = newLine z (pos+indent) - let z = addL z (pos+indent) r - z - | Node (_,l,jm,r,_,_) -> - let z = addL z pos l - let z = if jm then z else addText z " " - let pos = index z - let z = addL z pos r - z - | Attr (_,_,l) -> - addL z pos l + let breaks = breaks0 () + let pos = 0 + let _,layout,_,_ = fit breaks (pos,layout) + layout + + let combine (strs: string list) = String.Concat strs + + let showL opts leafFormatter layout = + let push x rstrs = x :: rstrs + let z0 = [],0 + let addText (rstrs,i) (text:string) = push text rstrs,i + text.Length + let index (_,i) = i + let extract rstrs = combine(List.rev rstrs) + let newLine (rstrs,_) n = // \n then spaces... + let indent = new System.String(' ', n) + let rstrs = push "\n" rstrs + let rstrs = push indent rstrs + rstrs,n + + // addL: pos is tab level + let rec addL z pos layout = + match layout with + | ObjLeaf (_,obj,_) -> + let text = leafFormatter obj + addText z text + | Leaf (_,obj,_) -> + addText z obj.Text + | Node (_,l,_,r,_,Broken indent) + // Print width = 0 implies 1D layout, no squash + when not (opts.PrintWidth = 0) -> + let z = addL z pos l + let z = newLine z (pos+indent) + let z = addL z (pos+indent) r + z + | Node (_,l,jm,r,_,_) -> + let z = addL z pos l + let z = if jm then z else addText z " " + let pos = index z + let z = addL z pos r + z + | Attr (_,_,l) -> + addL z pos l - let rstrs,_ = addL z0 0 layout - extract rstrs - - - // ------------------------------------------------------------------------- - // outL - // ------------------------------------------------------------------------ - - let outL outAttribute leafFormatter (chan : TaggedTextWriter) layout = - // write layout to output chan directly - let write s = chan.Write(s) - // z is just current indent - let z0 = 0 - let index i = i - let addText z text = write text; (z + length text) - let newLine _ n = // \n then spaces... - let indent = new System.String(' ',n) - chan.WriteLine(); - write (tagText indent); - n + let rstrs,_ = addL z0 0 layout + extract rstrs + + let outL outAttribute leafFormatter (chan: TaggedTextWriter) layout = + // write layout to output chan directly + let write s = chan.Write(s) + // z is just current indent + let z0 = 0 + let index i = i + let addText z text = write text; (z + length text) + let newLine _ n = // \n then spaces... + let indent = new System.String(' ',n) + chan.WriteLine(); + write (tagText indent); + n - // addL: pos is tab level - let rec addL z pos layout = - match layout with - | ObjLeaf (_,obj,_) -> - let text = leafFormatter obj - addText z text - | Leaf (_,obj,_) -> - addText z obj - | Node (_,l,_,r,_,Broken indent) -> - let z = addL z pos l - let z = newLine z (pos+indent) - let z = addL z (pos+indent) r - z - | Node (_,l,jm,r,_,_) -> - let z = addL z pos l - let z = if jm then z else addText z Literals.space - let pos = index z - let z = addL z pos r - z - | Attr (tag,attrs,l) -> - let _ = outAttribute tag attrs true + // addL: pos is tab level + let rec addL z pos layout = + match layout with + | ObjLeaf (_,obj,_) -> + let text = leafFormatter obj + addText z text + | Leaf (_,obj,_) -> + addText z obj + | Node (_,l,_,r,_,Broken indent) -> let z = addL z pos l - let _ = outAttribute tag attrs false + let z = newLine z (pos+indent) + let z = addL z (pos+indent) r z + | Node (_,l,jm,r,_,_) -> + let z = addL z pos l + let z = if jm then z else addText z Literals.space + let pos = index z + let z = addL z pos r + z + | Attr (tag,attrs,l) -> + let _ = outAttribute tag attrs true + let z = addL z pos l + let _ = outAttribute tag attrs false + z - let _ = addL z0 0 layout - () + let _ = addL z0 0 layout + () - // -------------------------------------------------------------------- - // pprinter: using general-purpose reflection... - // -------------------------------------------------------------------- - - let getValueInfo bindingFlags (x:'a, ty:Type) = Value.GetValueInfo bindingFlags (x, ty) + let unpackCons recd = + match recd with + | [|(_,h);(_,t)|] -> (h,t) + | _ -> failwith "unpackCons" - let unpackCons recd = - match recd with - | [(_,h);(_,t)] -> (h,t) - | _ -> failwith "unpackCons" + let getListValueInfo bindingFlags (x:obj, ty:Type) = + match x with + | null -> None + | _ -> + match Value.GetValueInfo bindingFlags (x, ty) with + | UnionCaseValue (_,"Cons",recd) -> Some (unpackCons recd) + | UnionCaseValue (_,"Empty",[| |]) -> None + | _ -> failwith "List value had unexpected ValueInfo" - let getListValueInfo bindingFlags (x:obj, ty:Type) = - match x with - | null -> None - | _ -> - match getValueInfo bindingFlags (x, ty) with - | ConstructorValue (_,"Cons",recd) -> Some (unpackCons recd) - | ConstructorValue (_,"Empty",[]) -> None - | _ -> failwith "List value had unexpected ValueInfo" - - let structL = wordL (tagKeyword "struct") - let nullL = wordL (tagKeyword "null") - let measureL = wordL (tagPunctuation "()") - - // -------------------------------------------------------------------- - // pprinter: attributes - // -------------------------------------------------------------------- + let structL = wordL (tagKeyword "struct") - let makeRecordL nameXs = - let itemL (name,xL) = wordL name ^^ wordL Literals.equals -- xL - let braceL xs = (wordL Literals.leftBrace) ^^ xs ^^ (wordL Literals.rightBrace) + let nullL = wordL (tagKeyword "null") + + let unitL = wordL (tagPunctuation "()") + + let makeRecordL nameXs = + let itemL (name,xL) = wordL name ^^ wordL Literals.equals -- xL + let braceL xs = (wordL Literals.leftBrace) ^^ xs ^^ (wordL Literals.rightBrace) - nameXs - |> List.map itemL - |> aboveListL - |> braceL - - let makePropertiesL nameXs = - let itemL (name,v) = - let labelL = wordL name - (labelL ^^ wordL Literals.equals) - ^^ (match v with - | None -> wordL Literals.questionMark - | Some xL -> xL) - ^^ (rightL Literals.semicolon) - let braceL xs = (leftL Literals.leftBrace) ^^ xs ^^ (rightL Literals.rightBrace) - braceL (aboveListL (List.map itemL nameXs)) - - let makeListL itemLs = - (leftL Literals.leftBracket) - ^^ sepListL (rightL Literals.semicolon) itemLs - ^^ (rightL Literals.rightBracket) - - let makeArrayL xs = - (leftL (tagPunctuation "[|")) - ^^ sepListL (rightL Literals.semicolon) xs - ^^ (rightL (tagPunctuation "|]")) - - let makeArray2L xs = leftL Literals.leftBracket ^^ aboveListL xs ^^ rightL Literals.rightBracket - - // -------------------------------------------------------------------- - // pprinter: anyL - support functions - // -------------------------------------------------------------------- - - let getProperty (ty: Type) (obj: obj) name = - ty.InvokeMember(name, (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic), null, obj, [| |],CultureInfo.InvariantCulture) - - let getField obj (fieldInfo: FieldInfo) = - fieldInfo.GetValue(obj) - - let formatChar isChar c = - match c with - | '\'' when isChar -> "\\\'" - | '\"' when not isChar -> "\\\"" - //| '\n' -> "\\n" - //| '\r' -> "\\r" - //| '\t' -> "\\t" - | '\\' -> "\\\\" - | '\b' -> "\\b" - | _ when System.Char.IsControl(c) -> - let d1 = (int c / 100) % 10 - let d2 = (int c / 10) % 10 - let d3 = int c % 10 - "\\" + d1.ToString() + d2.ToString() + d3.ToString() - | _ -> c.ToString() + nameXs + |> List.map itemL + |> aboveListL + |> braceL + + let makePropertiesL nameXs = + let itemL (name,v) = + let labelL = wordL name + (labelL ^^ wordL Literals.equals) + ^^ (match v with + | None -> wordL Literals.questionMark + | Some xL -> xL) + ^^ (rightL Literals.semicolon) + let braceL xs = (leftL Literals.leftBrace) ^^ xs ^^ (rightL Literals.rightBrace) + braceL (aboveListL (List.map itemL nameXs)) + + let makeListL itemLs = + (leftL Literals.leftBracket) + ^^ sepListL (rightL Literals.semicolon) itemLs + ^^ (rightL Literals.rightBracket) + + let makeArrayL xs = + (leftL (tagPunctuation "[|")) + ^^ sepListL (rightL Literals.semicolon) xs + ^^ (rightL (tagPunctuation "|]")) + + let makeArray2L xs = leftL Literals.leftBracket ^^ aboveListL xs ^^ rightL Literals.rightBracket + + let getProperty (ty: Type) (obj: obj) name = + ty.InvokeMember(name, (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic), null, obj, [| |],CultureInfo.InvariantCulture) + + let getField obj (fieldInfo: FieldInfo) = + fieldInfo.GetValue(obj) + + let formatChar isChar c = + match c with + | '\'' when isChar -> "\\\'" + | '\"' when not isChar -> "\\\"" + //| '\n' -> "\\n" + //| '\r' -> "\\r" + //| '\t' -> "\\t" + | '\\' -> "\\\\" + | '\b' -> "\\b" + | _ when System.Char.IsControl(c) -> + let d1 = (int c / 100) % 10 + let d2 = (int c / 10) % 10 + let d3 = int c % 10 + "\\" + d1.ToString() + d2.ToString() + d3.ToString() + | _ -> c.ToString() - let formatString (s:string) = - let rec check i = i < s.Length && not (System.Char.IsControl(s,i)) && s.[i] <> '\"' && check (i+1) - let rec conv i acc = if i = s.Length then combine (List.rev acc) else conv (i+1) (formatChar false s.[i] :: acc) - "\"" + s + "\"" - // REVIEW: should we check for the common case of no control characters? Reinstate the following? - //"\"" + (if check 0 then s else conv 0 []) + "\"" - - let formatStringInWidth (width:int) (str:string) = - // Return a truncated version of the string, e.g. - // "This is the initial text, which has been truncated"+[12 chars] - // - // Note: The layout code forces breaks based on leaf size and possible break points. - // It does not force leaf size based on width. - // So long leaf-string width can not depend on their printing context... - // - // The suffix like "+[dd chars]" is 11 chars. - // 12345678901 - let suffixLength = 11 // turning point suffix length - let prefixMinLength = 12 // arbitrary. If print width is reduced, want to print a minimum of information on strings... - let prefixLength = max (width - 2 (*quotes*) - suffixLength) prefixMinLength - "\"" + (str.Substring(0,prefixLength)) + "\"" + "+[" + (str.Length - prefixLength).ToString() + " chars]" - - // -------------------------------------------------------------------- - // pprinter: anyL - // -------------------------------------------------------------------- + let formatString (s:string) = + let rec check i = i < s.Length && not (System.Char.IsControl(s,i)) && s.[i] <> '\"' && check (i+1) + let rec conv i acc = if i = s.Length then combine (List.rev acc) else conv (i+1) (formatChar false s.[i] :: acc) + "\"" + s + "\"" + // REVIEW: should we check for the common case of no control characters? Reinstate the following? + //"\"" + (if check 0 then s else conv 0 []) + "\"" + + let formatStringInWidth (width:int) (str:string) = + // Return a truncated version of the string, e.g. + // "This is the initial text, which has been truncated"+[12 chars] + // + // Note: The layout code forces breaks based on leaf size and possible break points. + // It does not force leaf size based on width. + // So long leaf-string width can not depend on their printing context... + // + // The suffix like "+[dd chars]" is 11 chars. + // 12345678901 + let suffixLength = 11 // turning point suffix length + let prefixMinLength = 12 // arbitrary. If print width is reduced, want to print a minimum of information on strings... + let prefixLength = max (width - 2 (*quotes*) - suffixLength) prefixMinLength + "\"" + (str.Substring(0,prefixLength)) + "\"" + "+[" + (str.Length - prefixLength).ToString() + " chars]" + - type Precedence = - | BracketIfTupleOrNotAtomic = 2 - | BracketIfTuple = 3 - | NeverBracket = 4 - - // In fsi.exe, certain objects are not printed for top-level bindings. - [] - type ShowMode = - | ShowAll - | ShowTopLevelBinding - - // polymorphic and inner recursion limitations prevent us defining polyL in the recursive loop - let polyL bindingFlags (objL: ShowMode -> int -> Precedence -> ValueInfo -> obj -> Layout) showMode i prec (x:'a ,ty : Type) (* x could be null *) = - objL showMode i prec (getValueInfo bindingFlags (x, ty)) (box x) - - let anyL showMode bindingFlags (opts:FormatOptions) (x:'a, ty:Type) = - // showMode = ShowTopLevelBinding on the outermost expression when called from fsi.exe, - // This allows certain outputs, e.g. objects that would print as to be suppressed, etc. See 4343. - // Calls to layout proper sub-objects should pass showMode = ShowAll. - - // Precedences to ensure we add brackets in the right places + type Precedence = + | BracketIfTupleOrNotAtomic = 2 + | BracketIfTuple = 3 + | NeverBracket = 4 + + // In fsi.exe, certain objects are not printed for top-level bindings. + [] + type ShowMode = + | ShowAll + | ShowTopLevelBinding + + let isSetOrMapType (ty:Type) = + ty.IsGenericType && + (ty.GetGenericTypeDefinition() = typedefof> + || ty.GetGenericTypeDefinition() = typedefof>) + + type ObjectGraphFormatter(opts: FormatOptions, bindingFlags) = + // showMode = ShowTopLevelBinding on the outermost expression when called from fsi.exe, + // This allows certain outputs, e.g. objects that would print as to be suppressed, etc. See 4343. + // Calls to layout proper sub-objects should pass showMode = ShowAll. + + // Precedences to ensure we add brackets in the right places - // Keep a record of objects encountered along the way - let path = Dictionary(10,HashIdentity.Reference) - - // Roughly count the "nodes" printed, e.g. leaf items and inner nodes, but not every bracket and comma. - let mutable size = opts.PrintSize - let exceededPrintSize() = size<=0 - let countNodes n = if size > 0 then size <- size - n else () // no need to keep decrementing (and avoid wrap around) - let stopShort _ = exceededPrintSize() // for unfoldL - - // Recursive descent - let rec objL depthLim prec (x:obj, ty:Type) = polyL bindingFlags objWithReprL ShowAll depthLim prec (x, ty) // showMode for inner expr - and sameObjL depthLim prec (x:obj, ty:Type) = polyL bindingFlags objWithReprL showMode depthLim prec (x, ty) // showMode preserved - - and objWithReprL showMode depthLim prec (info:ValueInfo) (x:obj) (* x could be null *) = - try - if depthLim<=0 || exceededPrintSize() then wordL (tagPunctuation "...") else - match x with - | null -> + // Keep a record of objects encountered along the way + let path = Dictionary(10,HashIdentity.Reference) + + // Roughly count the "nodes" printed, e.g. leaf items and inner nodes, but not every bracket and comma. + let mutable size = opts.PrintSize + let exceededPrintSize() = size<=0 + let countNodes n = if size > 0 then size <- size - n else () // no need to keep decrementing (and avoid wrap around) + let stopShort _ = exceededPrintSize() // for unfoldL + + // Recursive descent + let rec nestedObjL depthLim prec (x:obj, ty:Type) = + objL ShowAll depthLim prec (x, ty) + + and objL showMode depthLim prec (x:obj, ty:Type) = + let info = Value.GetValueInfo bindingFlags (x, ty) + try + if depthLim<=0 || exceededPrintSize() then wordL (tagPunctuation "...") else + match x with + | null -> reprL showMode (depthLim-1) prec info x - | _ -> + | _ -> if (path.ContainsKey(x)) then - wordL (tagPunctuation "...") + wordL (tagPunctuation "...") else - path.Add(x,0); + path.Add(x,0) + let res = - // Lazy values. VS2008 used StructuredFormatDisplayAttribute to show via ToString. Dev10 (no attr) needs a special case. - let ty = x.GetType() - if ty.IsGenericType && ty.GetGenericTypeDefinition() = typedefof> then - Some (wordL (tagText(x.ToString()))) - else - // Try the StructuredFormatDisplayAttribute extensibility attribute - match ty.GetCustomAttributes (typeof, true) with - | null | [| |] -> None - | res -> - let attr = (res.[0] :?> StructuredFormatDisplayAttribute) - let txt = attr.Value - if isNull txt || txt.Length <= 1 then - None - else - let messageRegexPattern = @"^(?
.*?)(?.*?)(?.*)$"
-                                  let illFormedBracketPattern = @"(?  
-                                        // there isn't a match on the regex looking for a property, so now let's make sure we don't have an ill-formed format string (i.e. mismatched/stray brackets)
-                                        let illFormedMatch = System.Text.RegularExpressions.Regex.IsMatch(txt, illFormedBracketPattern)
-                                        match illFormedMatch with
-                                        | true -> None // there are mismatched brackets, bail out
-                                        | false when layouts.Length > 1 -> Some (spaceListL (List.rev ((wordL (tagText(replaceEscapedBrackets(txt))) :: layouts))))
-                                        | false -> Some (wordL (tagText(replaceEscapedBrackets(txt))))
-                                      | true ->
-                                        // we have a hit on a property reference
-                                        let preText = replaceEscapedBrackets(m.Groups.["pre"].Value) // everything before the first opening bracket
-                                        let postText = m.Groups.["post"].Value // Everything after the closing bracket
-                                        let prop = replaceEscapedBrackets(m.Groups.["prop"].Value) // Unescape everything between the opening and closing brackets
-
-                                        match catchExn (fun () -> getProperty ty x prop) with
-                                          | Choice2Of2 e -> Some (wordL (tagText("")))
-                                          | Choice1Of2 alternativeObj ->
-                                              try 
-                                                  let alternativeObjL = 
-                                                    match alternativeObj with 
-                                                        // A particular rule is that if the alternative property
-                                                        // returns a string, we turn off auto-quoting and escaping of
-                                                        // the string, i.e. just treat the string as display text.
-                                                        // This allows simple implementations of 
-                                                        // such as
-                                                        //
-                                                        //    []
-                                                        //    type BigInt(signInt:int, v : BigNat) =
-                                                        //        member x.StructuredDisplayString = x.ToString()
-                                                        //
-                                                        | :? string as s -> sepL (tagText s)
-                                                        | _ -> 
-                                                          // recursing like this can be expensive, so let's throttle it severely
-                                                          sameObjL (depthLim/10) Precedence.BracketIfTuple (alternativeObj, alternativeObj.GetType())
-                                                  countNodes 0 // 0 means we do not count the preText and postText 
-
-                                                  let postTextMatch = System.Text.RegularExpressions.Regex.Match(postText, messageRegexPattern)
-                                                  // the postText for this node will be everything up to the next occurrence of an opening brace, if one exists
-                                                  let currentPostText =
-                                                    match postTextMatch.Success with
-                                                      | false -> postText 
-                                                      | true -> postTextMatch.Groups.["pre"].Value
-
-                                                  let newLayouts = (sepL (tagText preText) ^^ alternativeObjL ^^ sepL (tagText currentPostText)) :: layouts
-                                                  match postText with
-                                                    | "" ->
-                                                      //We are done, build a space-delimited layout from the collection of layouts we've accumulated
-                                                      Some (spaceListL (List.rev newLayouts))
-                                                    | remainingPropertyText when postTextMatch.Success ->
-                                                      
-                                                      // look for stray brackets in the text before the next opening bracket
-                                                      let strayClosingMatch = System.Text.RegularExpressions.Regex.IsMatch(postTextMatch.Groups.["pre"].Value, illFormedBracketPattern)
-                                                      match strayClosingMatch with
-                                                      | true -> None
-                                                      | false -> 
-                                                        // More to process, keep going, using the postText starting at the next instance of a '{'
-                                                        let openingBracketIndex = postTextMatch.Groups.["prop"].Index-1
-                                                        buildObjMessageL remainingPropertyText.[openingBracketIndex..] newLayouts
-                                                    | remaingPropertyText ->
-                                                      // make sure we don't have any stray brackets
-                                                      let strayClosingMatch = System.Text.RegularExpressions.Regex.IsMatch(remaingPropertyText, illFormedBracketPattern)
-                                                      match strayClosingMatch with
-                                                      | true -> None
-                                                      | false ->
-                                                        // We are done, there's more text but it doesn't contain any more properties, we need to remove escaped brackets now though
-                                                        // since that wasn't done when creating currentPostText
-                                                        Some (spaceListL (List.rev ((sepL (tagText preText) ^^ alternativeObjL ^^ sepL (tagText(replaceEscapedBrackets(remaingPropertyText)))) :: layouts)))
-                                              with _ -> 
-                                                None
-                                  // Seed with an empty layout with a space to the left for formatting purposes
-                                  buildObjMessageL txt [leftL (tagText "")] 
-#if COMPILER    // This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter
+                            // Lazy values. VS2008 used StructuredFormatDisplayAttribute to show via ToString. Dev10 (no attr) needs a special case.
+                            let ty = x.GetType()
+                            if ty.IsGenericType && ty.GetGenericTypeDefinition() = typedefof> then
+                                Some (wordL (tagText(x.ToString())))
+                            else
+                                // Try the StructuredFormatDisplayAttribute extensibility attribute
+                                match ty.GetCustomAttributes (typeof, true) with
+                                | null | [| |] -> None
+                                | res -> 
+                                structuredFormatObjectL showMode ty depthLim (res.[0] :?> StructuredFormatDisplayAttribute) x
+
+#if COMPILER
+                        // This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter
                         let res = 
                             match res with 
                             | Some _ -> res
                             | None -> 
-                                let env = { new IEnvironment with
-                                                member env.GetLayout(y) = objL (depthLim-1) Precedence.BracketIfTuple (y, y.GetType()) 
-                                                member env.MaxColumns = opts.PrintLength
-                                                member env.MaxRows = opts.PrintLength }
+                                let env = 
+                                    { new IEnvironment with
+                                        member _.GetLayout(y) = nestedObjL (depthLim-1) Precedence.BracketIfTuple (y, y.GetType()) 
+                                        member _.MaxColumns = opts.PrintLength
+                                        member _.MaxRows = opts.PrintLength }
                                 opts.PrintIntercepts |> List.tryPick (fun intercept -> intercept env x)
 #endif
                         let res = 
                             match res with 
                             | Some res -> res
                             | None     -> reprL showMode (depthLim-1) prec info x
-                        path .Remove(x) |> ignore;
+
+                        path.Remove(x) |> ignore
                         res
-                with
-                  e ->
-                    countNodes 1
-                    wordL (tagText("Error: " + e.Message))
-
-            and recdAtomicTupleL depthLim recd =
-                // tuples up args to UnionConstruction or ExceptionConstructor. no node count.
-                match recd with 
-                | [(_,x)] -> objL depthLim Precedence.BracketIfTupleOrNotAtomic x 
-                | 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 (tupleType, vals) ->
-                    let basicL = sepListL (rightL Literals.comma) (List.map (objL depthLim Precedence.BracketIfTuple ) vals)
-                    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. Note: "null" is never a valid list value. 
-                                                      x<>null && isListType (x.GetType()) ->
-                    match constr with 
-                    | "Cons" -> 
-                        let (x,xs) = unpackCons recd
-                        let project xs = getListValueInfo bindingFlags xs
-                        let itemLs = objL depthLim Precedence.BracketIfTuple x :: boundedUnfoldL (objL depthLim Precedence.BracketIfTuple) project stopShort xs (opts.PrintLength - 1)
-                        makeListL itemLs
-                    | _ ->
-                        countNodes 1
-                        wordL (tagPunctuation "[]")
-
-                | ConstructorValue(declaringType,nm,recd)   ->
-                    countNodes 1
-                    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
-                    let name = ty.Name 
-                    match recd with
-                      | []   -> (wordL (tagClass name))
-                      | recd -> (wordL (tagClass name) --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
+            with
+                e ->
+                countNodes 1
+                wordL (tagText("Error: " + e.Message))
+
+        // Format an object that has a layout specified by StructuredFormatAttribute
+        and structuredFormatObjectL showMode ty depthLim (attr: StructuredFormatDisplayAttribute) (obj: obj) =
+            let txt = attr.Value
+            if isNull txt || txt.Length <= 1 then  
+                None
+            else
+            let messageRegexPattern = @"^(?
.*?)(?.*?)(?.*)$"
+            let illFormedBracketPattern = @"(?
-                    // Q: should function printing include the ty.Name? It does not convey much useful info to most users, e.g. "clo@0_123".    
-                    countNodes 1
-                    wordL (tagText("")) |> showModeFilter
-
-                | ObjectValue(obj)  ->
-                    match obj with 
-                    | null ->
-                        countNodes 1
-                        // If this is the root element, wrap the null with angle brackets
-                        if depthLim = opts.PrintDepth - 1 then
-                            wordL (tagText "")
-                        else nullL
-                    | _ -> 
-                    let ty = obj.GetType()
-                    match obj with 
-                    | :? string as s ->
-                        countNodes 1
+            let rec buildObjMessageL (txt:string) (layouts:Layout list) =
+                                    
+                let replaceEscapedBrackets (txt:string) =
+                    txt.Replace("\{", "{").Replace("\}", "}")
+                                      
+                // to simplify support for escaped brackets, switch to using a Regex to simply parse the text as the following regex groups:
+                //  1) Everything up to the first opening bracket not preceded by a "\", lazily
+                //  2) Everything between that opening bracket and a closing bracket not preceded by a "\", lazily
+                //  3) Everything after that closing bracket
+                let m = System.Text.RegularExpressions.Regex.Match(txt, messageRegexPattern)
+                if not m.Success then 
+                    // there isn't a match on the regex looking for a property, so now let's make sure we don't have an ill-formed format string (i.e. mismatched/stray brackets)
+                    let illFormedMatch = System.Text.RegularExpressions.Regex.IsMatch(txt, illFormedBracketPattern)
+                    if illFormedMatch then 
+                        None // there are mismatched brackets, bail out
+                    elif layouts.Length > 1 then Some (spaceListL (List.rev ((wordL (tagText(replaceEscapedBrackets(txt))) :: layouts))))
+                    else Some (wordL (tagText(replaceEscapedBrackets(txt))))
+                else
+                    // we have a hit on a property reference
+                    let preText = replaceEscapedBrackets(m.Groups.["pre"].Value) // everything before the first opening bracket
+                    let postText = m.Groups.["post"].Value // Everything after the closing bracket
+                    let prop = replaceEscapedBrackets(m.Groups.["prop"].Value) // Unescape everything between the opening and closing brackets
+
+                    match catchExn (fun () -> getProperty ty obj prop) with
+                    | Choice2Of2 e -> Some (wordL (tagText("")))
+                    | Choice1Of2 alternativeObj ->
+                        try 
+                            let alternativeObjL = 
+                                match alternativeObj with 
+                                // A particular rule is that if the alternative property
+                                // returns a string, we turn off auto-quoting and escaping of
+                                // the string, i.e. just treat the string as display text.
+                                // This allows simple implementations of 
+                                // such as
+                                //
+                                //    []
+                                //    type BigInt(signInt:int, v: BigNat) =
+                                //        member x.StructuredDisplayString = x.ToString()
+                                //
+                                | :? string as s -> sepL (tagText s)
+                                | _ -> 
+                                    // recursing like this can be expensive, so let's throttle it severely
+                                    objL showMode (depthLim/10) Precedence.BracketIfTuple (alternativeObj, alternativeObj.GetType())
+                            countNodes 0 // 0 means we do not count the preText and postText 
+
+                            let postTextMatch = System.Text.RegularExpressions.Regex.Match(postText, messageRegexPattern)
+                            // the postText for this node will be everything up to the next occurrence of an opening brace, if one exists
+                            let currentPostText =
+                                match postTextMatch.Success with
+                                | false -> postText 
+                                | true -> postTextMatch.Groups.["pre"].Value
+
+                            let newLayouts = (sepL (tagText preText) ^^ alternativeObjL ^^ sepL (tagText currentPostText)) :: layouts
+                            match postText with
+                            | "" ->
+                                //We are done, build a space-delimited layout from the collection of layouts we've accumulated
+                                Some (spaceListL (List.rev newLayouts))
+
+                            | remainingPropertyText when postTextMatch.Success ->
+                                                      
+                                // look for stray brackets in the text before the next opening bracket
+                                let strayClosingMatch = System.Text.RegularExpressions.Regex.IsMatch(postTextMatch.Groups.["pre"].Value, illFormedBracketPattern)
+                                if strayClosingMatch then
+                                    None
+                                else 
+                                    // More to process, keep going, using the postText starting at the next instance of a '{'
+                                    let openingBracketIndex = postTextMatch.Groups.["prop"].Index-1
+                                    buildObjMessageL remainingPropertyText.[openingBracketIndex..] newLayouts
+
+                            | remaingPropertyText ->
+                                // make sure we don't have any stray brackets
+                                let strayClosingMatch = System.Text.RegularExpressions.Regex.IsMatch(remaingPropertyText, illFormedBracketPattern)
+                                if strayClosingMatch then
+                                    None
+                                else
+                                    // We are done, there's more text but it doesn't contain any more properties, we need to remove escaped brackets now though
+                                    // since that wasn't done when creating currentPostText
+                                    Some (spaceListL (List.rev ((sepL (tagText preText) ^^ alternativeObjL ^^ sepL (tagText(replaceEscapedBrackets(remaingPropertyText)))) :: layouts)))
+                        with _ -> 
+                            None
+
+            // Seed with an empty layout with a space to the left for formatting purposes
+            buildObjMessageL txt [leftL (tagText "")] 
+
+        and recdAtomicTupleL depthLim recd =
+            // tuples up args to UnionConstruction or ExceptionConstructor. no node count.
+            match recd with 
+            | [(_,x)] -> nestedObjL depthLim Precedence.BracketIfTupleOrNotAtomic x 
+            | txs -> leftL Literals.leftParen ^^ commaListL (List.map (snd >> nestedObjL depthLim Precedence.BracketIfTuple) txs) ^^ rightL Literals.rightParen
+
+        and bracketIfL flag basicL =
+            if flag then (leftL Literals.leftParen) ^^ basicL ^^ (rightL Literals.rightParen) else basicL
+
+        and tupleValueL depthLim prec vals tupleType =
+            let basicL = sepListL (rightL Literals.comma) (List.map (nestedObjL depthLim Precedence.BracketIfTuple ) (Array.toList vals))
+            let fields = bracketIfL (prec <= Precedence.BracketIfTuple) basicL
+            match tupleType with
+            | TupleType.Value -> structL ^^ fields
+            | TupleType.Reference -> fields
+
+        and recordValueL depthLim items =
+            let itemL (name, x, ty) =
+                countNodes 1
+                tagRecordField name,nestedObjL depthLim Precedence.BracketIfTuple (x, ty)
+            makeRecordL (List.map itemL items)
+
+        and listValueL depthLim constr recd =
+            match constr with 
+            | "Cons" -> 
+                let (x,xs) = unpackCons recd
+                let project xs = getListValueInfo bindingFlags xs
+                let itemLs = nestedObjL depthLim Precedence.BracketIfTuple x :: boundedUnfoldL (nestedObjL depthLim Precedence.BracketIfTuple) project stopShort xs (opts.PrintLength - 1)
+                makeListL itemLs
+            | _ ->
+                countNodes 1
+                wordL (tagPunctuation "[]")
+
+        and unionCaseValueL depthLim prec (declaringType: Type option) unionCaseName recd  =
+            countNodes 1
+            let caseName =
+                match declaringType with
+                | None ->
+                    wordL (tagMethod unionCaseName)
+                | Some declaringType ->
+                    wordL (tagClass declaringType.Name) ^^ sepL (tagPunctuation ".") ^^ wordL (tagMethod unionCaseName)
+            match recd with
+            | [] -> caseName
+            | recd -> (caseName --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
+
+        and fsharpExceptionL depthLim prec (exceptionType: Type) recd =
+            countNodes 1
+            let name = exceptionType.Name 
+            match recd with
+            | []   -> (wordL (tagClass name))
+            | recd -> (wordL (tagClass name) --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
+
+        and showModeFilter showMode layout =
+            match showMode with
+            | ShowAll -> layout
+            | ShowTopLevelBinding -> emptyL                                                             
+
+        and functionClosureL showMode (closureType: Type) =
+            // Q: should function printing include the ty.Name? It does not convey much useful info to most users, e.g. "clo@0_123".    
+            countNodes 1
+            wordL (tagText("")) |> showModeFilter showMode
+
+        and stringValueL (s: string) =
+            countNodes 1
 #if COMPILER  
-                        if s.Length + 2(*quotes*) <= opts.StringLimit then
-                           // With the quotes, it fits within the limit.
-                           wordL (tagStringLiteral(formatString s))
-                        else
-                           // When a string is considered too long to print, there is a choice: what to print?
-                           // a)             -- follows 
-                           // b)      -- follows  and gives just the length
-                           // c) "abcdefg"+[n chars] -- gives a prefix and the remaining chars
-                           wordL (tagStringLiteral(formatStringInWidth opts.StringLimit s))
+            if s.Length + 2(*quotes*) <= opts.StringLimit then
+                // With the quotes, it fits within the limit.
+                wordL (tagStringLiteral(formatString s))
+            else
+                // When a string is considered too long to print, there is a choice: what to print?
+                // a)             -- follows 
+                // b)      -- follows  and gives just the length
+                // c) "abcdefg"+[n chars] -- gives a prefix and the remaining chars
+                wordL (tagStringLiteral(formatStringInWidth opts.StringLimit s))
 #else
-                        wordL (tagStringLiteral (formatString s))  
-#endif                        
-                    | :? Array as arr -> 
-                        let ty = arr.GetType().GetElementType()
-                        match arr.Rank with
-                        | 1 -> 
-                             let n = arr.Length
-                             let b1 = arr.GetLowerBound(0) 
-                             let project depthLim = if depthLim=(b1+n) then None else Some ((box (arr.GetValue(depthLim)), ty),depthLim+1)
-                             let itemLs = boundedUnfoldL (objL depthLim Precedence.BracketIfTuple) project stopShort b1 opts.PrintLength
-                             makeArrayL (if b1 = 0 then itemLs else wordL (tagText("bound1="+string_of_int b1)) :: itemLs)
-                        | 2 -> 
-                             let n1 = arr.GetLength(0)
-                             let n2 = arr.GetLength(1)
-                             let b1 = arr.GetLowerBound(0) 
-                             let b2 = arr.GetLowerBound(1) 
-                             let project2 x y =
-                               if x>=(b1+n1) || y>=(b2+n2) then None
-                               else Some ((box (arr.GetValue(x,y)), ty),y+1)
-                             let rowL x = boundedUnfoldL (objL depthLim Precedence.BracketIfTuple) (project2 x) stopShort b2 opts.PrintLength |> makeListL
-                             let project1 x = if x>=(b1+n1) then None else Some (x,x+1)
-                             let rowsL  = boundedUnfoldL rowL project1 stopShort b1 opts.PrintLength
-                             makeArray2L (if b1=0 && b2 = 0 then rowsL else wordL (tagText("bound1=" + string_of_int b1)) :: wordL(tagText("bound2=" + string_of_int b2)) :: rowsL)
-                          | n -> 
-                             makeArrayL [wordL (tagText("rank=" + string_of_int n))]
+            wordL (tagStringLiteral (formatString s))  
+#endif                   
+
+        and arrayValueL depthLim (arr: Array) =
+            let ty = arr.GetType().GetElementType()
+            match arr.Rank with
+            | 1 -> 
+                let n = arr.Length
+                let b1 = arr.GetLowerBound(0) 
+                let project depthLim = if depthLim=(b1+n) then None else Some ((box (arr.GetValue(depthLim)), ty),depthLim+1)
+                let itemLs = boundedUnfoldL (nestedObjL depthLim Precedence.BracketIfTuple) project stopShort b1 opts.PrintLength
+                makeArrayL (if b1 = 0 then itemLs else wordL (tagText("bound1="+string_of_int b1)) :: itemLs)
+            | 2 -> 
+                let n1 = arr.GetLength(0)
+                let n2 = arr.GetLength(1)
+                let b1 = arr.GetLowerBound(0) 
+                let b2 = arr.GetLowerBound(1) 
+                let project2 x y =
+                    if x>=(b1+n1) || y>=(b2+n2) then None
+                    else Some ((box (arr.GetValue(x,y)), ty),y+1)
+                let rowL x = boundedUnfoldL (nestedObjL depthLim Precedence.BracketIfTuple) (project2 x) stopShort b2 opts.PrintLength |> makeListL
+                let project1 x = if x>=(b1+n1) then None else Some (x,x+1)
+                let rowsL  = boundedUnfoldL rowL project1 stopShort b1 opts.PrintLength
+                makeArray2L (if b1=0 && b2 = 0 then rowsL else wordL (tagText("bound1=" + string_of_int b1)) :: wordL(tagText("bound2=" + string_of_int b2)) :: rowsL)
+            | n -> 
+                makeArrayL [wordL (tagText("rank=" + string_of_int n))]
                         
-                    // Format 'set' and 'map' nicely
-                    | _ when  
-                          (ty.IsGenericType && (ty.GetGenericTypeDefinition() = typedefof> 
-                                                || ty.GetGenericTypeDefinition() = typedefof>) ) ->
-                         let word = if ty.GetGenericTypeDefinition() = typedefof> then "map" else "set"
-                         let possibleKeyValueL v = 
-                             let tyv = v.GetType()
-                             if word = "map" &&
-                                (match v with null -> false | _ -> true) && 
-                                tyv.IsGenericType && 
-                                tyv.GetGenericTypeDefinition() = typedefof> then
-                                  objL depthLim Precedence.BracketIfTuple ((tyv.GetProperty("Key").GetValue(v, [| |]), 
-                                                                            tyv.GetProperty("Value").GetValue(v, [| |])), tyv)
-                             else
-                                  objL depthLim Precedence.BracketIfTuple (v, tyv)
-                         let it = (obj :?>  System.Collections.IEnumerable).GetEnumerator() 
-                         try 
-                           let itemLs = boundedUnfoldL possibleKeyValueL (fun () -> if it.MoveNext() then Some(it.Current,()) else None) stopShort () (1+opts.PrintLength/12)
-                           (wordL (tagClass word) --- makeListL itemLs) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
-                         finally 
-                            match it with 
-                            | :? System.IDisposable as e -> e.Dispose()
-                            | _ -> ()
-
-                    | :? System.Collections.IEnumerable as ie ->
-                         let showContent = 
-                            // do not display content of IQueryable since its execution may take significant time
-                            opts.ShowIEnumerable && (ie.GetType().GetInterfaces() |> Array.exists(fun ty -> ty.FullName = "System.Linq.IQueryable") |> not)
-
-                         if showContent then
-                           let word = "seq"
-                           let it = ie.GetEnumerator() 
-                           let ty = ie.GetType().GetInterfaces() |> Array.filter (fun ty -> ty.IsGenericType && ty.Name = "IEnumerable`1") |> Array.tryItem 0
-                           let ty = Option.map (fun (ty:Type) -> ty.GetGenericArguments().[0]) ty
-                           try 
-                             let itemLs = boundedUnfoldL (objL depthLim Precedence.BracketIfTuple) (fun () -> if it.MoveNext() then Some((it.Current, match ty with | None -> it.Current.GetType() | Some ty -> ty),()) else None) stopShort () (1+opts.PrintLength/30)
-                             (wordL (tagClass word) --- makeListL itemLs) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
-                           finally 
-                              match it with 
-                              | :? System.IDisposable as e -> e.Dispose()
-                              | _ -> ()
+        and mapSetValueL depthLim prec (ty: Type) (obj: obj) =
+            let word = if ty.GetGenericTypeDefinition() = typedefof> then "map" else "set"
+            let possibleKeyValueL v = 
+                let tyv = v.GetType()
+                if word = "map" &&
+                    (match v with null -> false | _ -> true) && 
+                    tyv.IsGenericType && 
+                    tyv.GetGenericTypeDefinition() = typedefof> then
+                    nestedObjL depthLim Precedence.BracketIfTuple ((tyv.GetProperty("Key").GetValue(v, [| |]), 
+                                                                    tyv.GetProperty("Value").GetValue(v, [| |])), tyv)
+                else
+                    nestedObjL depthLim Precedence.BracketIfTuple (v, tyv)
+            let it = (obj :?>  System.Collections.IEnumerable).GetEnumerator() 
+            try 
+                let itemLs = boundedUnfoldL possibleKeyValueL (fun () -> if it.MoveNext() then Some(it.Current,()) else None) stopShort () (1+opts.PrintLength/12)
+                (wordL (tagClass word) --- makeListL itemLs) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
+            finally 
+                match it with 
+                | :? System.IDisposable as e -> e.Dispose()
+                | _ -> ()
+
+        and sequenceValueL showMode depthLim prec (ie: System.Collections.IEnumerable) =
+            let showContent = 
+                // do not display content of IQueryable since its execution may take significant time
+                opts.ShowIEnumerable && (ie.GetType().GetInterfaces() |> Array.exists(fun ty -> ty.FullName = "System.Linq.IQueryable") |> not)
+
+            if showContent then
+                let word = "seq"
+                let it = ie.GetEnumerator() 
+                let ty = ie.GetType().GetInterfaces() |> Array.filter (fun ty -> ty.IsGenericType && ty.Name = "IEnumerable`1") |> Array.tryItem 0
+                let ty = Option.map (fun (ty:Type) -> ty.GetGenericArguments().[0]) ty
+                try 
+                    let itemLs = boundedUnfoldL (nestedObjL depthLim Precedence.BracketIfTuple) (fun () -> if it.MoveNext() then Some((it.Current, match ty with | None -> it.Current.GetType() | Some ty -> ty),()) else None) stopShort () (1+opts.PrintLength/30)
+                    (wordL (tagClass word) --- makeListL itemLs) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
+                finally 
+                    match it with 
+                    | :? System.IDisposable as e -> e.Dispose()
+                    | _ -> ()
                              
-                         else
-                           // Sequence printing is turned off for declared-values, and maybe be disabled to users.
-                           // There is choice here, what to print?  or ... or ?
-                           // Also, in the declared values case, if the sequence is actually a known non-lazy type (list, array etc etc) we could print it.  
-                           wordL (tagText "") |> showModeFilter
-                    | _ ->
-                         if showMode = ShowTopLevelBinding && typeUsesSystemObjectToString ty then
-                           emptyL
-                         else
-                           countNodes 1
-                           let basicL = LayoutOps.objL obj  // This buries an obj in the layout, rendered at squash time via a leafFormatter.
-                                                            // If the leafFormatter was directly here, then layout leaves could store strings.
-                           match obj with 
-                           | _ when opts.ShowProperties ->
-                              let props = ty.GetProperties(BindingFlags.GetField ||| BindingFlags.Instance ||| BindingFlags.Public)
-                              let fields = ty.GetFields(BindingFlags.Instance ||| BindingFlags.Public) |> Array.map (fun i -> i :> MemberInfo)
-                              let propsAndFields = 
-                                props |> Array.map (fun i -> i :> MemberInfo)
-                                      |> Array.append fields
-                                      |> Array.filter (fun pi ->
-                                    // check if property is annotated with System.Diagnostics.DebuggerBrowsable(Never). 
-                                    // Its evaluation may have unexpected side effects and\or block printing.
-                                    match Seq.toArray (pi.GetCustomAttributes(typeof, false)) with
-                                    | [|:? System.Diagnostics.DebuggerBrowsableAttribute as attr |] -> attr.State <> System.Diagnostics.DebuggerBrowsableState.Never
-                                    | _ -> true
-                                )
-
-                              // massively reign in deep printing of properties 
-                              let nDepth = depthLim/10
+            else
+                // Sequence printing is turned off for declared-values, and maybe be disabled to users.
+                // There is choice here, what to print?  or ... or ?
+                // Also, in the declared values case, if the sequence is actually a known non-lazy type (list, array etc etc) we could print it.  
+                wordL (tagText "") |> showModeFilter showMode
+
+        and objectValueWithPropertiesL depthLim (ty: Type) (obj: obj) =
+
+            // This buries an obj in the layout, rendered at squash time via a leafFormatter.
+            let basicL = LayoutOps.objL obj
+            let props = ty.GetProperties(BindingFlags.GetField ||| BindingFlags.Instance ||| BindingFlags.Public)
+            let fields = ty.GetFields(BindingFlags.Instance ||| BindingFlags.Public) |> Array.map (fun i -> i :> MemberInfo)
+            let propsAndFields = 
+                props |> Array.map (fun i -> i :> MemberInfo)
+                        |> Array.append fields
+                        |> Array.filter (fun pi ->
+                    // check if property is annotated with System.Diagnostics.DebuggerBrowsable(Never). 
+                    // Its evaluation may have unexpected side effects and\or block printing.
+                    match Seq.toArray (pi.GetCustomAttributes(typeof, false)) with
+                    | [|:? System.Diagnostics.DebuggerBrowsableAttribute as attr |] -> attr.State <> System.Diagnostics.DebuggerBrowsableState.Never
+                    | _ -> true
+                )
+
+            // massively reign in deep printing of properties 
+            let nDepth = depthLim/10
 #if NETSTANDARD
-                              Array.Sort((propsAndFields),{ new IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } )
+            Array.Sort((propsAndFields),{ new IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } )
 #else
-                              Array.Sort((propsAndFields :> Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } )
+            Array.Sort((propsAndFields :> Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } )
 #endif
 
-                              if propsAndFields.Length = 0 || (nDepth <= 0) then basicL 
-                              else basicL --- 
-                                     (propsAndFields 
-                                      |> Array.map 
-                                        (fun m -> 
-                                            ((if m :? FieldInfo then tagField m.Name else tagProperty m.Name),
-                                                (try Some (objL nDepth Precedence.BracketIfTuple ((getProperty ty obj m.Name), ty)) 
-                                                 with _ -> try Some (objL nDepth Precedence.BracketIfTuple ((getField obj (m :?> FieldInfo)), ty)) 
-                                                           with _ -> None)))
-                                      |> Array.toList 
-                                      |> makePropertiesL)
-                           | _ -> basicL 
-                | UnitValue -> countNodes 1; measureL
-
-            polyL bindingFlags objWithReprL showMode opts.PrintDepth Precedence.BracketIfTuple (x, ty)
-
-        // --------------------------------------------------------------------
-        // pprinter: leafFormatter
-        // --------------------------------------------------------------------
-
-        let leafFormatter (opts:FormatOptions) (obj :obj) =
-            match obj with 
-            | null -> tagKeyword "null"
-            | :? double as d -> 
-                let s = d.ToString(opts.FloatingPointFormat,opts.FormatProvider)
-                let t = 
-                    if System.Double.IsNaN(d) then "nan"
-                    elif System.Double.IsNegativeInfinity(d) then "-infinity"
-                    elif System.Double.IsPositiveInfinity(d) then "infinity"
-                    elif opts.FloatingPointFormat.[0] = 'g'  && String.forall(fun c -> System.Char.IsDigit(c) || c = '-')  s
-                    then s + ".0" 
-                    else s
-                tagNumericLiteral t
-            | :? single as d -> 
-                let t =
-                    (if System.Single.IsNaN(d) then "nan"
-                     elif System.Single.IsNegativeInfinity(d) then "-infinity"
-                     elif System.Single.IsPositiveInfinity(d) then "infinity"
-                     elif opts.FloatingPointFormat.Length >= 1 && opts.FloatingPointFormat.[0] = 'g' 
-                      && float32(System.Int32.MinValue) < d && d < float32(System.Int32.MaxValue) 
-                      && float32(int32(d)) = d 
-                     then (System.Convert.ToInt32 d).ToString(opts.FormatProvider) + ".0"
-                     else d.ToString(opts.FloatingPointFormat,opts.FormatProvider)) 
-                    + "f"
-                tagNumericLiteral t
-            | :? System.Decimal as d -> d.ToString("g",opts.FormatProvider) + "M" |> tagNumericLiteral
-            | :? uint64 as d -> d.ToString(opts.FormatProvider) + "UL" |> tagNumericLiteral
-            | :? int64  as d -> d.ToString(opts.FormatProvider) + "L" |> tagNumericLiteral
-            | :? int32  as d -> d.ToString(opts.FormatProvider) |> tagNumericLiteral
-            | :? uint32 as d -> d.ToString(opts.FormatProvider) + "u" |> tagNumericLiteral
-            | :? int16  as d -> d.ToString(opts.FormatProvider) + "s" |> tagNumericLiteral
-            | :? uint16 as d -> d.ToString(opts.FormatProvider) + "us" |> tagNumericLiteral
-            | :? sbyte  as d -> d.ToString(opts.FormatProvider) + "y" |> tagNumericLiteral
-            | :? byte   as d -> d.ToString(opts.FormatProvider) + "uy" |> tagNumericLiteral
-            | :? nativeint as d -> d.ToString() + "n" |> tagNumericLiteral
-            | :? unativeint  as d -> d.ToString() + "un" |> tagNumericLiteral
-            | :? bool   as b -> (if b then "true" else "false") |> tagKeyword
-            | :? char   as c -> "\'" + formatChar true c + "\'" |> tagStringLiteral
-            | _ -> 
-                let t = 
-                    try 
-                        let text = obj.ToString()
-                        match text with
-                        | null -> ""
-                        | _ -> text
-                    with e ->
-                     // If a .ToString() call throws an exception, catch it and use the message as the result.
-                     // This may be informative, e.g. division by zero etc...
-                     "" 
-                tagText t
-
-        let any_to_layout opts x = anyL ShowAll BindingFlags.Public opts x
-
-        let squash_layout opts l = 
-            // Print width = 0 implies 1D layout, no squash
-            if opts.PrintWidth = 0 then 
-                l 
-            else 
-                l |> squashTo (opts.PrintWidth,leafFormatter opts)
-
-        let asTaggedTextWriter (tw: TextWriter) =
-            { new TaggedTextWriter with
-                member __.Write(t) = tw.Write t.Text
-                member __.WriteLine() = tw.WriteLine() }
-
-        let output_layout_tagged opts oc l = 
-            l |> squash_layout opts 
-              |> outL opts.AttributeProcessor (leafFormatter opts) oc
+            if propsAndFields.Length = 0 || (nDepth <= 0) then basicL 
+            else basicL --- 
+                    (propsAndFields 
+                    |> Array.map 
+                    (fun m -> 
+                        ((if m :? FieldInfo then tagField m.Name else tagProperty m.Name),
+                            (try Some (nestedObjL nDepth Precedence.BracketIfTuple ((getProperty ty obj m.Name), ty)) 
+                                with _ -> 
+                                try Some (nestedObjL nDepth Precedence.BracketIfTuple ((getField obj (m :?> FieldInfo)), ty)) 
+                                with _ -> None)))
+                    |> Array.toList 
+                    |> makePropertiesL)
+
+        and reprL showMode depthLim prec repr x (* x could be null *) =
+            match repr with
+            | TupleValue (tupleType, vals) ->
+                tupleValueL depthLim prec vals tupleType
+
+            | RecordValue items -> 
+                recordValueL depthLim (Array.toList items)
+
+            | UnionCaseValue (_,constr,recd) when // x is List. Note: "null" is never a valid list value. 
+                                                    x<>null && isListType (x.GetType()) ->
+                listValueL depthLim constr recd
+
+            | UnionCaseValue(declaringType, unionCaseName, recd)   ->
+                unionCaseValueL depthLim prec declaringType unionCaseName (Array.toList recd)
+
+            | ExceptionValue(exceptionType, recd) ->
+                fsharpExceptionL depthLim prec exceptionType (Array.toList recd)
+
+            | FunctionClosureValue closureType ->
+                functionClosureL showMode closureType
+
+            | UnitValue ->
+                countNodes 1
+                unitL
+
+            | NullValue ->
+                countNodes 1
+                // If this is the root element, wrap the null with angle brackets
+                if depthLim = opts.PrintDepth - 1 then
+                    wordL (tagText "")
+                else nullL
+
+            | ObjectValue obj  ->
+                let ty = obj.GetType()
+                match obj with 
+                | :? string as s ->
+                    stringValueL s
 
-        let output_layout opts oc l = 
-            output_layout_tagged opts (asTaggedTextWriter oc) l
+                | :? Array as arr ->
+                    arrayValueL depthLim arr
 
-        let layout_to_string options layout = 
-            layout |> squash_layout options 
-              |> showL options ((leafFormatter options) >> toText)
+                | _ when isSetOrMapType ty ->
+                    mapSetValueL depthLim prec ty obj
 
-        let output_any_ex opts oc x = x |> any_to_layout opts |> output_layout opts oc
+                | :? System.Collections.IEnumerable as ie ->
+                    sequenceValueL showMode depthLim prec ie
 
-        let output_any writer x = output_any_ex FormatOptions.Default writer x
+                | _ when showMode = ShowTopLevelBinding && typeUsesSystemObjectToString ty ->
+                    emptyL 
 
-        let layout_as_string opts x = x |> any_to_layout opts |> layout_to_string opts
+                | _ when opts.ShowProperties -> 
+                    countNodes 1
+                    objectValueWithPropertiesL depthLim (ty: Type) (obj: obj)
 
-        let any_to_string x = layout_as_string FormatOptions.Default x
+                | _ ->
+                    countNodes 1
+                    // This buries an obj in the layout, rendered at squash time via a leafFormatter.
+                    LayoutOps.objL obj
+
+        member _.Format(showMode, x:'a, xty:Type) =
+            objL showMode opts.PrintDepth  Precedence.BracketIfTuple (x, xty)
+
+    // --------------------------------------------------------------------
+    // pprinter: leafFormatter
+    // --------------------------------------------------------------------
+
+    let leafFormatter (opts:FormatOptions) (obj :obj) =
+        match obj with 
+        | null -> tagKeyword "null"
+        | :? double as d -> 
+            let s = d.ToString(opts.FloatingPointFormat,opts.FormatProvider)
+            let t = 
+                if System.Double.IsNaN(d) then "nan"
+                elif System.Double.IsNegativeInfinity(d) then "-infinity"
+                elif System.Double.IsPositiveInfinity(d) then "infinity"
+                elif opts.FloatingPointFormat.[0] = 'g'  && String.forall(fun c -> System.Char.IsDigit(c) || c = '-')  s
+                then s + ".0" 
+                else s
+            tagNumericLiteral t
+
+        | :? single as d -> 
+            let t =
+                (if System.Single.IsNaN(d) then "nan"
+                    elif System.Single.IsNegativeInfinity(d) then "-infinity"
+                    elif System.Single.IsPositiveInfinity(d) then "infinity"
+                    elif opts.FloatingPointFormat.Length >= 1 && opts.FloatingPointFormat.[0] = 'g' 
+                    && float32(System.Int32.MinValue) < d && d < float32(System.Int32.MaxValue) 
+                    && float32(int32(d)) = d 
+                    then (System.Convert.ToInt32 d).ToString(opts.FormatProvider) + ".0"
+                    else d.ToString(opts.FloatingPointFormat,opts.FormatProvider)) 
+                + "f"
+            tagNumericLiteral t
+
+        | :? decimal as d -> d.ToString("g",opts.FormatProvider) + "M" |> tagNumericLiteral
+        | :? uint64 as d -> d.ToString(opts.FormatProvider) + "UL" |> tagNumericLiteral
+        | :? int64  as d -> d.ToString(opts.FormatProvider) + "L" |> tagNumericLiteral
+        | :? int32  as d -> d.ToString(opts.FormatProvider) |> tagNumericLiteral
+        | :? uint32 as d -> d.ToString(opts.FormatProvider) + "u" |> tagNumericLiteral
+        | :? int16  as d -> d.ToString(opts.FormatProvider) + "s" |> tagNumericLiteral
+        | :? uint16 as d -> d.ToString(opts.FormatProvider) + "us" |> tagNumericLiteral
+        | :? sbyte  as d -> d.ToString(opts.FormatProvider) + "y" |> tagNumericLiteral
+        | :? byte   as d -> d.ToString(opts.FormatProvider) + "uy" |> tagNumericLiteral
+        | :? nativeint as d -> d.ToString() + "n" |> tagNumericLiteral
+        | :? unativeint  as d -> d.ToString() + "un" |> tagNumericLiteral
+        | :? bool   as b -> (if b then "true" else "false") |> tagKeyword
+        | :? char   as c -> "\'" + formatChar true c + "\'" |> tagStringLiteral
+
+        | _ -> 
+            let t = 
+                try 
+                    let text = obj.ToString()
+                    match text with
+                    | null -> ""
+                    | _ -> text
+                with e ->
+                    // If a .ToString() call throws an exception, catch it and use the message as the result.
+                    // This may be informative, e.g. division by zero etc...
+                    "" 
+            tagText t
+
+    let any_to_layout opts (x, xty) =
+        let formatter = ObjectGraphFormatter(opts, BindingFlags.Public) 
+        formatter.Format(ShowAll, x, xty)
+
+    let squashTo maxWidth layout = 
+       layout |> squashToAux (maxWidth, leafFormatter FormatOptions.Default)
+
+    let squash_layout opts l = 
+        // Print width = 0 implies 1D layout, no squash
+        if opts.PrintWidth = 0 then 
+            l 
+        else 
+            l |> squashToAux (opts.PrintWidth,leafFormatter opts)
+
+    let asTaggedTextWriter (tw: TextWriter) =
+        { new TaggedTextWriter with
+            member __.Write(t) = tw.Write t.Text
+            member __.WriteLine() = tw.WriteLine() }
+
+    let output_layout_tagged opts oc l = 
+        l |> squash_layout opts 
+            |> outL opts.AttributeProcessor (leafFormatter opts) oc
+
+    let output_layout opts oc l = 
+        output_layout_tagged opts (asTaggedTextWriter oc) l
+
+    let layout_to_string options layout = 
+        layout |> squash_layout options 
+            |> showL options ((leafFormatter options) >> toText)
+
+    let output_any_ex opts oc x = x |> any_to_layout opts |> output_layout opts oc
+
+    let output_any writer x = output_any_ex FormatOptions.Default writer x
+
+    let layout_as_string opts x = x |> any_to_layout opts |> layout_to_string opts
+
+    let any_to_string x = layout_as_string FormatOptions.Default x
 
 #if COMPILER
-        /// Called 
-        let fsi_any_to_layout opts x = anyL ShowTopLevelBinding BindingFlags.Public opts x
+    let fsi_any_to_layout opts (x, xty) =
+        let formatter = ObjectGraphFormatter(opts, BindingFlags.Public) 
+        formatter.Format (ShowTopLevelBinding, x, xty)
 #else
-// FSharp.Core
-        let internal anyToStringForPrintf options (bindingFlags:BindingFlags) x = 
-            x |> anyL ShowAll bindingFlags options |> layout_to_string options
+    let internal anyToStringForPrintf options (bindingFlags:BindingFlags) (x, xty) = 
+        let formatter = ObjectGraphFormatter(options, bindingFlags) 
+        formatter.Format (ShowAll, x, xty) |> layout_to_string options
 #endif
 
diff --git a/src/utils/sformat.fsi b/src/utils/sformat.fsi
index e6ff9762bb5..e1f37ae31fd 100644
--- a/src/utils/sformat.fsi
+++ b/src/utils/sformat.fsi
@@ -29,10 +29,13 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
     open Microsoft.FSharp.Collections
     open Microsoft.FSharp.Primitives.Basics
 
+#if FSHARP_CORE
     /// Data representing structured layouts of terms.  
-#if FSHARP_CORE  // FSharp.Core.dll makes things internal and hides representations
+    // FSharp.Core.dll makes things internal and hides representations
     type internal Layout
+
     type internal LayoutTag
+
     type internal TaggedText =
         abstract Tag: LayoutTag
         abstract Text: string
@@ -83,8 +86,8 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
         | UnknownEntity
 
     type public TaggedText =
-        abstract Tag : LayoutTag
-        abstract Text : string
+        abstract Tag: LayoutTag
+        abstract Text: string
 
     
     type public TaggedTextWriter =
@@ -106,66 +109,66 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
 #else
     module internal TaggedTextOps =
 #endif
-        val tag : LayoutTag -> string -> TaggedText
-        val keywordFunctions : Set
-        val tagAlias : string -> TaggedText
-        val tagClass : string -> TaggedText
-        val tagUnionCase : string -> TaggedText
-        val tagDelegate : string -> TaggedText
-        val tagEnum : string -> TaggedText
-        val tagEvent : string -> TaggedText
-        val tagField : string -> TaggedText
-        val tagInterface : string -> TaggedText
-        val tagKeyword : string -> TaggedText
-        val tagLineBreak : string -> TaggedText
-        val tagMethod : string -> TaggedText
-        val tagModuleBinding : string -> TaggedText
-        val tagLocal : string -> TaggedText
-        val tagRecord : string -> TaggedText
-        val tagRecordField : string -> TaggedText
-        val tagModule : string -> TaggedText
-        val tagNamespace : string -> TaggedText
-        val tagNumericLiteral : string -> TaggedText
-        val tagOperator : string -> TaggedText
-        val tagParameter : string -> TaggedText
-        val tagProperty : string -> TaggedText
-        val tagSpace : string -> TaggedText
-        val tagStringLiteral : string -> TaggedText
-        val tagStruct : string -> TaggedText
-        val tagTypeParameter : string -> TaggedText
-        val tagText : string -> TaggedText
-        val tagPunctuation : string -> TaggedText
+        val tag: LayoutTag -> string -> TaggedText
+        val keywordFunctions: Set
+        val tagAlias: string -> TaggedText
+        val tagClass: string -> TaggedText
+        val tagUnionCase: string -> TaggedText
+        val tagDelegate: string -> TaggedText
+        val tagEnum: string -> TaggedText
+        val tagEvent: string -> TaggedText
+        val tagField: string -> TaggedText
+        val tagInterface: string -> TaggedText
+        val tagKeyword: string -> TaggedText
+        val tagLineBreak: string -> TaggedText
+        val tagMethod: string -> TaggedText
+        val tagModuleBinding: string -> TaggedText
+        val tagLocal: string -> TaggedText
+        val tagRecord: string -> TaggedText
+        val tagRecordField: string -> TaggedText
+        val tagModule: string -> TaggedText
+        val tagNamespace: string -> TaggedText
+        val tagNumericLiteral: string -> TaggedText
+        val tagOperator: string -> TaggedText
+        val tagParameter: string -> TaggedText
+        val tagProperty: string -> TaggedText
+        val tagSpace: string -> TaggedText
+        val tagStringLiteral: string -> TaggedText
+        val tagStruct: string -> TaggedText
+        val tagTypeParameter: string -> TaggedText
+        val tagText: string -> TaggedText
+        val tagPunctuation: string -> TaggedText
 
         module Literals =
             // common tagged literals
-            val lineBreak : TaggedText
-            val space : TaggedText
-            val comma : TaggedText
-            val semicolon : TaggedText
-            val leftParen : TaggedText
-            val rightParen : TaggedText
-            val leftBracket : TaggedText
-            val rightBracket : TaggedText
+            val lineBreak: TaggedText
+            val space: TaggedText
+            val comma: TaggedText
+            val semicolon: TaggedText
+            val leftParen: TaggedText
+            val rightParen: TaggedText
+            val leftBracket: TaggedText
+            val rightBracket: TaggedText
             val leftBrace: TaggedText
-            val rightBrace : TaggedText
+            val rightBrace: TaggedText
             val leftBraceBar: TaggedText
-            val rightBraceBar : TaggedText
-            val equals : TaggedText
-            val arrow : TaggedText
-            val questionMark : TaggedText
+            val rightBraceBar: TaggedText
+            val equals: TaggedText
+            val arrow: TaggedText
+            val questionMark: TaggedText
 
 #if COMPILER
     type public IEnvironment = 
         /// Return to the layout-generation 
         /// environment to layout any otherwise uninterpreted object
-        abstract GetLayout : obj -> Layout
+        abstract GetLayout: obj -> Layout
         /// The maximum number of elements for which to generate layout for 
         /// list-like structures, or columns in table-like 
         /// structures.  -1 if no maximum.
-        abstract MaxColumns : int
+        abstract MaxColumns: int
         /// The maximum number of rows for which to generate layout for table-like 
         /// structures.  -1 if no maximum.
-        abstract MaxRows : int
+        abstract MaxRows: int
 #endif
       
     /// A layout is a sequence of strings which have been joined together.
@@ -181,92 +184,92 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
 #endif
 
         /// The empty layout
-        val emptyL     : Layout
+        val emptyL : Layout
 
         /// Is it the empty layout?
-        val isEmptyL   : layout:Layout -> bool
+        val isEmptyL: layout:Layout -> bool
 
         /// An uninterpreted leaf, to be interpreted into a string
         /// by the layout engine. This allows leaf layouts for numbers, strings and
         /// other atoms to be customized according to culture.
-        val objL       : value:obj -> Layout
+        val objL   : value:obj -> Layout
 
         /// An string leaf 
-        val wordL      : text:TaggedText -> Layout
+        val wordL  : text:TaggedText -> Layout
 
         /// An string which requires no spaces either side.
-        val sepL       : text:TaggedText -> Layout
+        val sepL   : text:TaggedText -> Layout
 
         /// An string which is right parenthesis (no space on the left).
-        val rightL     : text:TaggedText -> Layout
+        val rightL : text:TaggedText -> Layout
 
         /// An string which is left  parenthesis (no space on the right).
-        val leftL      : text:TaggedText -> Layout
+        val leftL  : text:TaggedText -> Layout
 
         /// Join, unbreakable. 
-        val ( ^^ )     : layout1:Layout -> layout2:Layout -> Layout   
+        val ( ^^ ) : layout1:Layout -> layout2:Layout -> Layout   
 
         /// Join, possible break with indent=0
-        val ( ++ )     : layout1:Layout -> layout2:Layout -> Layout   
+        val ( ++ ) : layout1:Layout -> layout2:Layout -> Layout   
 
         /// Join, possible break with indent=1
-        val ( -- )     : layout1:Layout -> layout2:Layout -> Layout   
+        val ( -- ) : layout1:Layout -> layout2:Layout -> Layout   
 
         /// Join, possible break with indent=2 
-        val ( --- )    : layout1:Layout -> layout2:Layout -> Layout   
+        val ( --- ): layout1:Layout -> layout2:Layout -> Layout   
 
         /// Join broken with ident=0
-        val ( @@ )     : layout1:Layout -> layout2:Layout -> Layout   
+        val ( @@ ) : layout1:Layout -> layout2:Layout -> Layout   
 
         /// Join broken with ident=1 
-        val ( @@- )    : layout1:Layout -> layout2:Layout -> Layout   
+        val ( @@- ): layout1:Layout -> layout2:Layout -> Layout   
 
         /// Join broken with ident=2 
-        val ( @@-- )   : layout1:Layout -> layout2:Layout -> Layout   
+        val ( @@-- ): layout1:Layout -> layout2:Layout -> Layout   
 
         /// Join layouts into a comma separated list.
-        val commaListL : layouts:Layout list -> Layout
+        val commaListL: layouts:Layout list -> Layout
           
         /// Join layouts into a space separated list.    
-        val spaceListL : layouts:Layout list -> Layout
+        val spaceListL: layouts:Layout list -> Layout
           
         /// Join layouts into a semi-colon separated list.
-        val semiListL  : layouts:Layout list -> Layout
+        val semiListL: layouts:Layout list -> Layout
 
         /// Join layouts into a list separated using the given Layout.
-        val sepListL   : layout1:Layout -> layouts:Layout list -> Layout
+        val sepListL: layout1:Layout -> layouts:Layout list -> Layout
 
         /// Wrap round brackets around Layout.
-        val bracketL   : layout:Layout -> Layout
+        val bracketL: layout:Layout -> Layout
 
         /// Wrap square brackets around layout.    
-        val squareBracketL   : layout:Layout -> Layout
+        val squareBracketL: layout:Layout -> Layout
 
         /// Wrap braces around layout.        
-        val braceL     : layout:Layout -> Layout
+        val braceL : layout:Layout -> Layout
 
         /// Form tuple of layouts.            
-        val tupleL     : layouts:Layout list -> Layout
+        val tupleL : layouts:Layout list -> Layout
 
         /// Layout two vertically.
-        val aboveL     : layout1:Layout -> layout2:Layout -> Layout
+        val aboveL : layout1:Layout -> layout2:Layout -> Layout
 
         /// Layout list vertically.    
-        val aboveListL : layouts:Layout list -> Layout
+        val aboveListL: layouts:Layout list -> Layout
 
         /// Layout like an F# option.
-        val optionL    : selector:('T -> Layout) -> value:'T option -> Layout
+        val optionL: selector:('T -> Layout) -> value:'T option -> Layout
 
         /// Layout like an F# list.    
-        val listL      : selector:('T -> Layout) -> value:'T list   -> Layout
+        val listL  : selector:('T -> Layout) -> value:'T list   -> Layout
 
         /// See tagL
-        val tagAttrL : text:string -> maps:(string * string) list -> layout:Layout -> Layout
+        val tagAttrL: text:string -> maps:(string * string) list -> layout:Layout -> Layout
 
         /// For limiting layout of list-like sequences (lists,arrays,etc).
         /// unfold a list of items using (project and z) making layout list via itemL.
         /// If reach maxLength (before exhausting) then truncate.
-        val unfoldL : selector:('T -> Layout) -> folder:('State -> ('T * 'State) option) -> state:'State -> count:int -> Layout list
+        val unfoldL: selector:('T -> Layout) -> folder:('State -> ('T * 'State) option) -> state:'State -> count:int -> Layout list
 
     /// A record of options to control structural formatting.
     /// For F# Interactive properties matching those of this value can be accessed via the 'fsi'
@@ -296,20 +299,21 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
     type internal FormatOptions =
 #endif
         { FloatingPointFormat: string
-          AttributeProcessor: (string -> (string * string) list -> bool -> unit);
+          AttributeProcessor: (string -> (string * string) list -> bool -> unit)
 #if COMPILER  // FSharp.Core.dll: PrintIntercepts aren't used there
-          PrintIntercepts: (IEnvironment -> obj -> Layout option) list;
-          StringLimit: int;
+          PrintIntercepts: (IEnvironment -> obj -> Layout option) list
+          StringLimit: int
 #endif
           FormatProvider: System.IFormatProvider
           BindingFlags: System.Reflection.BindingFlags
-          PrintWidth : int 
-          PrintDepth : int 
-          PrintLength : int
-          PrintSize : int  
-          ShowProperties : bool
+          PrintWidth: int 
+          PrintDepth: int 
+          PrintLength: int
+          PrintSize: int  
+          ShowProperties: bool
           ShowIEnumerable: bool  }
-        static member Default : FormatOptions
+
+        static member Default: FormatOptions
 
 #if COMPILER
     module public Display =
@@ -317,33 +321,24 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
     module internal Display =
 #endif
 
-        /// Convert any value to a string using a standard formatter
-        /// Data is typically formatted in a structured format, e.g.
-        /// lists are formatted using the "[1;2]" notation.
-        /// The details of the format are not specified and may change
-        /// from version to version and according to the flags given
-        /// to the F# compiler.  The format is intended to be human-readable,
-        /// not machine readable.  If alternative generic formats are required
-        /// you should develop your own formatter, using the code in the
-        /// implementation of this file as a starting point.
-        ///
-        /// Data from other .NET languages is formatted using a virtual
-        /// call to Object.ToString() on the boxed version of the input.
-        val any_to_string: value:'T * Type -> string
-
-        /// Output any value to a channel using the same set of formatting rules
-        /// as any_to_string
-        val output_any: writer:TextWriter -> value:'T * Type -> unit
-
-#if FSHARP_CORE   // FSharp.Core.dll: Most functions aren't needed in FSharp.Core.dll, but we add one entry for printf
+#if FSHARP_CORE
 
+        // Most functions aren't needed in FSharp.Core.dll, but we add one inernal entry for printf
         val anyToStringForPrintf: options:FormatOptions -> bindingFlags:System.Reflection.BindingFlags -> value:'T * Type -> string
 #else
+
         val asTaggedTextWriter: writer: TextWriter -> TaggedTextWriter
-        val any_to_layout   : options:FormatOptions -> value:'T * Type -> Layout
-        val squash_layout   : options:FormatOptions -> layout:Layout -> Layout
-        val output_layout_tagged   : options:FormatOptions -> writer:TaggedTextWriter -> layout:Layout -> unit
-        val output_layout   : options:FormatOptions -> writer:TextWriter -> layout:Layout -> unit
+
+        val any_to_layout: options:FormatOptions -> value:'T * Type -> Layout
+
+        val squashTo: width: int -> layout: Layout -> Layout
+
+        val squash_layout: options:FormatOptions -> layout:Layout -> Layout
+
+        val output_layout_tagged: options:FormatOptions -> writer:TaggedTextWriter -> layout:Layout -> unit
+
+        val output_layout: options:FormatOptions -> writer:TextWriter -> layout:Layout -> unit
+
         val layout_as_string: options:FormatOptions -> value:'T * Type -> string
 #endif
 
@@ -353,7 +348,6 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
         /// built using any_to_layout with default format options.
         val layout_to_string: options:FormatOptions -> layout:Layout -> string
 
-
 #if COMPILER
-        val fsi_any_to_layout : options:FormatOptions -> value:'T * Type -> Layout
+        val fsi_any_to_layout: options:FormatOptions -> value:'T * Type -> Layout
 #endif  

From f77a934c9f6cd4f94652853c43e2202c2a3d5170 Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Wed, 19 Aug 2020 15:20:42 +0100
Subject: [PATCH 02/10] cleanup old formatting code

---
 src/utils/sformat.fs | 92 ++++++++++++++++++++++----------------------
 1 file changed, 46 insertions(+), 46 deletions(-)

diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index 77ce086190c..658ed941f94 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -582,12 +582,12 @@ module Display =
             // offset - width of last line of block
             // NOTE: offset <= pos -- depending on tabbing of last block
                
-            let breaks,layout,pos,offset =
+            let breaks, layout, pos, offset =
                 match layout with
-                | Attr (tag,attrs,l) ->
-                    let breaks,layout,pos,offset = fit breaks (pos,l) 
-                    let layout = Attr (tag,attrs,layout) 
-                    breaks,layout,pos,offset
+                | Attr (tag, attrs, l) ->
+                    let breaks, layout, pos, offset = fit breaks (pos, l) 
+                    let layout = Attr (tag, attrs, layout) 
+                    breaks, layout, pos, offset
                 | Leaf (jl, text, jr)
                 | ObjLeaf (jl, ObjToTaggedText text, jr) ->
                     // save the formatted text from the squash
@@ -595,94 +595,94 @@ module Display =
                     let textWidth = length text
                     let rec fitLeaf breaks pos =
                         if pos + textWidth <= maxWidth then
-                            breaks,layout,pos + textWidth,textWidth // great, it fits 
+                            breaks, layout, pos + textWidth, textWidth // great, it fits 
                         else
                             match forceBreak breaks with
                             | None                 -> 
-                                breaks,layout,pos + textWidth,textWidth // tough, no more breaks 
-                            | Some (breaks,saving) -> 
+                                breaks, layout, pos + textWidth, textWidth // tough, no more breaks 
+                            | Some (breaks, saving) -> 
                                 let pos = pos - saving 
                                 fitLeaf breaks pos
                        
                     fitLeaf breaks pos
-                | Node (jl,l,jm,r,jr,joint) ->
+                | Node (jl, l, jm, r, jr, joint) ->
                     let mid = if jm then 0 else 1
                     match joint with
                     | Unbreakable    ->
-                        let breaks,l,pos,offsetl = fit breaks (pos,l)    // fit left 
+                        let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
                         let pos = pos + mid                              // fit space if juxt says so 
-                        let breaks,r,pos,offsetr = fit breaks (pos,r)    // fit right 
-                        breaks,Node (jl,l,jm,r,jr,Unbreakable),pos,offsetl + mid + offsetr
+                        let breaks, r, pos, offsetr = fit breaks (pos, r)    // fit right 
+                        breaks, Node (jl, l, jm, r, jr, Unbreakable), pos, offsetl + mid + offsetr
                     | Broken indent ->
-                        let breaks,l,pos,offsetl = fit breaks (pos,l)    // fit left 
+                        let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
                         let pos = pos - offsetl + indent                 // broken so - offset left + ident 
-                        let breaks,r,pos,offsetr = fit breaks (pos,r)    // fit right 
-                        breaks,Node (jl,l,jm,r,jr,Broken indent),pos,indent + offsetr
+                        let breaks, r, pos, offsetr = fit breaks (pos, r)    // fit right 
+                        breaks, Node (jl, l, jm, r, jr, Broken indent), pos, indent + offsetr
                     | Breakable indent ->
-                        let breaks,l,pos,offsetl = fit breaks (pos,l)    // fit left 
+                        let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
                         // have a break possibility, with saving 
                         let saving = offsetl + mid - indent
                         let pos = pos + mid
                         if saving>0 then
                             let breaks = pushBreak saving breaks
-                            let breaks,r,pos,offsetr = fit breaks (pos,r)
-                            let breaks,broken = popBreak breaks
+                            let breaks, r, pos, offsetr = fit breaks (pos, r)
+                            let breaks, broken = popBreak breaks
                             if broken then
-                                breaks,Node (jl,l,jm,r,jr,Broken indent)   ,pos,indent + offsetr
+                                breaks, Node (jl, l, jm, r, jr, Broken indent)   , pos, indent + offsetr
                             else
-                                breaks,Node (jl,l,jm,r,jr,Breakable indent),pos,offsetl + mid + offsetr
+                                breaks, Node (jl, l, jm, r, jr, Breakable indent), pos, offsetl + mid + offsetr
                         else
                             // actually no saving so no break 
-                            let breaks,r,pos,offsetr = fit breaks (pos,r)
-                            breaks,Node (jl,l,jm,r,jr,Breakable indent)  ,pos,offsetl + mid + offsetr
+                            let breaks, r, pos, offsetr = fit breaks (pos, r)
+                            breaks, Node (jl, l, jm, r, jr, Breakable indent)  , pos, offsetl + mid + offsetr
                
             //printf "\nDone:     pos=%d offset=%d" pos offset;
-            breaks,layout,pos,offset
+            breaks, layout, pos, offset
            
         let breaks = breaks0 ()
         let pos = 0
-        let _,layout,_,_ = fit breaks (pos,layout)
+        let _, layout, _, _ = fit breaks (pos, layout)
         layout
 
     let combine (strs: string list) = String.Concat strs
 
     let showL opts leafFormatter layout =
         let push x rstrs = x :: rstrs
-        let z0 = [],0
-        let addText (rstrs,i) (text:string) = push text rstrs,i + text.Length
-        let index   (_,i)               = i
+        let z0 = [], 0
+        let addText (rstrs, i) (text:string) = push text rstrs, i + text.Length
+        let index   (_, i)               = i
         let extract rstrs = combine(List.rev rstrs) 
-        let newLine (rstrs,_) n     = // \n then spaces... 
+        let newLine (rstrs, _) n     = // \n then spaces... 
             let indent = new System.String(' ', n)
             let rstrs = push "\n"   rstrs
             let rstrs = push indent rstrs
-            rstrs,n
+            rstrs, n
 
         // addL: pos is tab level 
         let rec addL z pos layout = 
             match layout with 
-            | ObjLeaf (_,obj,_)                 -> 
+            | ObjLeaf (_, obj, _)                 -> 
                 let text = leafFormatter obj
                 addText z text                 
-            | Leaf (_,obj,_)                 -> 
+            | Leaf (_, obj, _)                 -> 
                 addText z obj.Text
-            | Node (_,l,_,r,_,Broken indent) 
+            | Node (_, l, _, r, _, Broken indent) 
                     // Print width = 0 implies 1D layout, no squash
                     when not (opts.PrintWidth = 0)  -> 
                 let z = addL z pos l
                 let z = newLine z (pos+indent)
                 let z = addL z (pos+indent) r
                 z
-            | Node (_,l,jm,r,_,_)             -> 
+            | Node (_, l, jm, r, _, _)             -> 
                 let z = addL z pos l
                 let z = if jm then z else addText z " "
                 let pos = index z
                 let z = addL z pos r
                 z
-            | Attr (_,_,l) ->
+            | Attr (_, _, l) ->
                 addL z pos l
            
-        let rstrs,_ = addL z0 0 layout
+        let rstrs, _ = addL z0 0 layout
         extract rstrs
 
     let outL outAttribute leafFormatter (chan: TaggedTextWriter) layout =
@@ -693,7 +693,7 @@ module Display =
         let index i = i
         let addText z text  = write text;  (z + length text)
         let newLine _ n     = // \n then spaces... 
-            let indent = new System.String(' ',n)
+            let indent = new System.String(' ', n)
             chan.WriteLine();
             write (tagText indent);
             n
@@ -701,23 +701,23 @@ module Display =
         // addL: pos is tab level 
         let rec addL z pos layout = 
             match layout with 
-            | ObjLeaf (_,obj,_)                 -> 
+            | ObjLeaf (_, obj, _)                 -> 
                 let text = leafFormatter obj 
                 addText z text
-            | Leaf (_,obj,_)                 -> 
+            | Leaf (_, obj, _)                 -> 
                 addText z obj
-            | Node (_,l,_,r,_,Broken indent) -> 
+            | Node (_, l, _, r, _, Broken indent) -> 
                 let z = addL z pos l
                 let z = newLine z (pos+indent)
                 let z = addL z (pos+indent) r
                 z
-            | Node (_,l,jm,r,_,_)             -> 
+            | Node (_, l, jm, r, _, _)             -> 
                 let z = addL z pos l
                 let z = if jm then z else addText z Literals.space
                 let pos = index z
                 let z = addL z pos r
                 z 
-            | Attr (tag,attrs,l) ->
+            | Attr (tag, attrs, l) ->
             let _ = outAttribute tag attrs true
             let z = addL z pos l
             let _ = outAttribute tag attrs false
@@ -728,7 +728,7 @@ module Display =
 
     let unpackCons recd =
         match recd with 
-        | [|(_,h);(_,t)|] -> (h,t)
+        | [|(_, h);(_, t)|] -> (h, t)
         | _  -> failwith "unpackCons"
 
     let getListValueInfo bindingFlags (x:obj, ty:Type) =
@@ -736,8 +736,8 @@ module Display =
         | null -> None 
         | _ -> 
             match Value.GetValueInfo bindingFlags (x, ty) with
-            | UnionCaseValue (_,"Cons",recd) -> Some (unpackCons recd)
-            | UnionCaseValue (_,"Empty",[| |]) -> None
+            | UnionCaseValue (_, "Cons", recd) -> Some (unpackCons recd)
+            | UnionCaseValue (_, "Empty", [| |]) -> None
             | _ -> failwith "List value had unexpected ValueInfo"
 
     let structL = wordL (tagKeyword "struct")
@@ -747,7 +747,7 @@ module Display =
     let unitL = wordL (tagPunctuation "()")
           
     let makeRecordL nameXs =
-        let itemL (name,xL) = wordL name ^^ wordL Literals.equals -- xL
+        let itemL (name, xL) = wordL name ^^ wordL Literals.equals -- xL
         let braceL xs = (wordL Literals.leftBrace) ^^ xs ^^ (wordL Literals.rightBrace)
             
         nameXs
@@ -756,7 +756,7 @@ module Display =
         |> braceL
 
     let makePropertiesL nameXs =
-        let itemL (name,v) = 
+        let itemL (name, v) = 
             let labelL = wordL name 
             (labelL ^^ wordL Literals.equals)
             ^^ (match v with 

From de8b51ee18cf6101f2fb46b90da7e81cb9ceaa1c Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Wed, 19 Aug 2020 15:23:49 +0100
Subject: [PATCH 03/10] cleanup old formatting code

---
 src/utils/sformat.fs | 74 ++++++++++++++++++++++----------------------
 1 file changed, 37 insertions(+), 37 deletions(-)

diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index 658ed941f94..3f8c83d36c6 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -197,23 +197,23 @@ module LayoutOps =
 
     let rec juxtLeft lf =
         match lf with
-        | ObjLeaf (jl,_,_) -> jl
-        | Leaf (jl,_,_) -> jl
-        | Node (jl,_,_,_,_,_) -> jl
-        | Attr (_,_,l) -> juxtLeft l
+        | ObjLeaf (jl, _, _) -> jl
+        | Leaf (jl, _, _) -> jl
+        | Node (jl, _, _, _, _, _) -> jl
+        | Attr (_, _, l) -> juxtLeft l
 
     let rec juxtRight lf =
         match lf with
-        | ObjLeaf (_,_,jr) -> jr
-        | Leaf (_,_,jr) -> jr
-        | Node (_,_,_,_,jr,_) -> jr
-        | Attr (_,_,l) -> juxtRight l
+        | ObjLeaf (_, _, jr) -> jr
+        | Leaf (_, _, jr) -> jr
+        | Node (_, _, _, _, jr, _) -> jr
+        | Attr (_, _, l) -> juxtRight l
 
     let mkNode l r joint =
         let jl = juxtLeft  l 
         let jm = juxtRight l || juxtLeft r 
         let jr = juxtRight r 
-        Node(jl,l,jm,r,jr,joint)
+        Node(jl, l, jm, r, jr, joint)
 
     // constructors
     let objL (value:obj) = 
@@ -223,15 +223,15 @@ module LayoutOps =
 
     let sLeaf (l, t, r) = Leaf (l, t, r)
 
-    let wordL text = sLeaf (false,text,false)
+    let wordL text = sLeaf (false, text, false)
 
-    let sepL text = sLeaf (true ,text,true)   
+    let sepL text = sLeaf (true , text, true)   
 
-    let rightL text = sLeaf (true ,text,false)   
+    let rightL text = sLeaf (true , text, false)   
 
-    let leftL text = sLeaf (false,text,true)
+    let leftL text = sLeaf (false, text, true)
 
-    let emptyL = sLeaf (true, tag LayoutTag.Text "",true)
+    let emptyL = sLeaf (true, tag LayoutTag.Text "", true)
 
     let isEmptyL layout = 
         match layout with 
@@ -240,7 +240,7 @@ module LayoutOps =
 
     let aboveL layout1 layout2 = mkNode layout1 layout2 (Broken 0)
 
-    let tagAttrL text maps layout = Attr(text,maps,layout)
+    let tagAttrL text maps layout = Attr(text, maps, layout)
 
     let apply2 f l r =
         if isEmptyL l then r
@@ -315,7 +315,7 @@ module LayoutOps =
             if stopShort z then [wordL (tagPunctuation "...")] else
             match project z with
             | None       -> []  // exhausted input 
-            | Some (x,z) -> if n<=0 then [wordL (tagPunctuation "...")]               // hit print_length limit 
+            | Some (x, z) -> if n<=0 then [wordL (tagPunctuation "...")]               // hit print_length limit 
                                     else itemL x :: consume (n-1) z  // cons recursive... 
         consume maxLength z  
 
@@ -443,8 +443,8 @@ module ReflectUtils =
             // the type are the actual fields of the type.  Again,
             // we should be reading attributes here that indicate the
             // true structure of the type, e.g. the order of the fields.   
-            elif FSharpType.IsUnion(reprty,bindingFlags) then 
-                let tag,vals = FSharpValue.GetUnionFields (obj, reprty, bindingFlags) 
+            elif FSharpType.IsUnion(reprty, bindingFlags) then 
+                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))
                 let declaringType =
@@ -452,13 +452,13 @@ module ReflectUtils =
                     else None
                 UnionCaseValue(declaringType, tag.Name, pvals)
 
-            elif FSharpType.IsExceptionRepresentation(reprty,bindingFlags) then 
-                let props = FSharpType.GetExceptionFields(reprty,bindingFlags) 
-                let vals = FSharpValue.GetExceptionFields(obj,bindingFlags) 
+            elif FSharpType.IsExceptionRepresentation(reprty, bindingFlags) then 
+                let props = FSharpType.GetExceptionFields(reprty, bindingFlags) 
+                let vals = FSharpValue.GetExceptionFields(obj, bindingFlags) 
                 let pvals = (props, vals) ||> Array.map2 (fun prop v -> prop.Name, (v, prop.PropertyType))
                 ExceptionValue(reprty, pvals)
 
-            elif FSharpType.IsRecord(reprty,bindingFlags) then 
+            elif FSharpType.IsRecord(reprty, bindingFlags) then 
                 let props = FSharpType.GetRecordFields(reprty, bindingFlags) 
                 RecordValue(props |> Array.map (fun prop -> prop.Name, prop.GetValue (obj, null), prop.PropertyType))
             else
@@ -498,14 +498,14 @@ module Display =
 
     let typeUsesSystemObjectToString (ty:System.Type) =
         try
-            let methInfo = ty.GetMethod("ToString",BindingFlags.Public ||| BindingFlags.Instance,null,[| |],null)
+            let methInfo = ty.GetMethod("ToString", BindingFlags.Public ||| BindingFlags.Instance, null, [| |], null)
             methInfo.DeclaringType = typeof
         with _e -> false
 
     /// If "str" ends with "ending" then remove it from "str", otherwise no change.
     let trimEnding (ending:string) (str:string) =
-        if str.EndsWith(ending,StringComparison.Ordinal) then 
-            str.Substring(0,str.Length - ending.Length) 
+        if str.EndsWith(ending, StringComparison.Ordinal) then 
+            str.Substring(0, str.Length - ending.Length) 
         else str
 
     let catchExn f = try Choice1Of2 (f ()) with e -> Choice2Of2 e
@@ -534,10 +534,10 @@ module Display =
     //   stdout.Flush() 
              
     let chunkN = 400      
-    let breaks0 () = Breaks(0,0,Array.create chunkN 0)
+    let breaks0 () = Breaks(0, 0, Array.create chunkN 0)
 
-    let pushBreak saving (Breaks(next,outer,stack)) =
-        //dumpBreaks "pushBreak" (next,outer,stack);
+    let pushBreak saving (Breaks(next, outer, stack)) =
+        //dumpBreaks "pushBreak" (next, outer, stack);
         let stack = 
             if next = stack.Length then
                 Array.init (next + chunkN) (fun i -> if i < next then stack.[i] else 0) // expand if full 
@@ -545,18 +545,18 @@ module Display =
                 stack
            
         stack.[next] <- saving;
-        Breaks(next+1,outer,stack)
+        Breaks(next+1, outer, stack)
 
-    let popBreak (Breaks(next,outer,stack)) =
-        //dumpBreaks "popBreak" (next,outer,stack);
+    let popBreak (Breaks(next, outer, stack)) =
+        //dumpBreaks "popBreak" (next, outer, stack);
         if next=0 then raise (Failure "popBreak: underflow");
         let topBroke = stack.[next-1] < 0
         let outer = if outer=next then outer-1 else outer  // if all broken, unwind 
         let next  = next - 1
-        Breaks(next,outer,stack),topBroke
+        Breaks(next, outer, stack), topBroke
 
-    let forceBreak (Breaks(next,outer,stack)) =
-        //dumpBreaks "forceBreak" (next,outer,stack);
+    let forceBreak (Breaks(next, outer, stack)) =
+        //dumpBreaks "forceBreak" (next, outer, stack);
         if outer=next then
             // all broken 
             None
@@ -564,13 +564,13 @@ module Display =
             let saving = stack.[outer]
             stack.[outer] <- -stack.[outer];    
             let outer = outer+1
-            Some (Breaks(next,outer,stack),saving)
+            Some (Breaks(next, outer, stack), saving)
 
     /// fitting
-    let squashToAux (maxWidth,leafFormatter: _ -> TaggedText) layout =
+    let squashToAux (maxWidth, leafFormatter: _ -> TaggedText) layout =
         let (|ObjToTaggedText|) = leafFormatter
         if maxWidth <= 0 then layout else 
-        let rec fit breaks (pos,layout) =
+        let rec fit breaks (pos, layout) =
             // breaks = break context, can force to get indentation savings.
             // pos    = current position in line
             // layout = to fit

From cf2fad0c68820415b66f073873eb99da12259976 Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Wed, 19 Aug 2020 15:31:49 +0100
Subject: [PATCH 04/10] cleanup old formatting code

---
 src/fsharp/layout.fs  |  6 +-----
 src/utils/sformat.fs  | 23 ++++++++---------------
 src/utils/sformat.fsi | 10 ++++++----
 3 files changed, 15 insertions(+), 24 deletions(-)

diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs
index 6debd24b2b6..2650d60afb6 100644
--- a/src/fsharp/layout.fs
+++ b/src/fsharp/layout.fs
@@ -23,11 +23,7 @@ let mkNav r t = NavigableTaggedText(t, r) :> TaggedText
 
 let spaces n = new String(' ', n)
 
-
-//--------------------------------------------------------------------------
-// INDEX: support
-//--------------------------------------------------------------------------
-
+// Note, there is duplication here with 'Display.juxtLeft' etc.
 let rec juxtLeft = function
   | ObjLeaf (jl, _text, _jr)         -> jl
   | Leaf (jl, _text, _jr)            -> jl
diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index 3f8c83d36c6..7b0a3ba7b22 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -83,24 +83,17 @@ type Joint =
     | Breakable of int
     | Broken of int
 
-/// Leaf juxt,data,juxt
-/// Node juxt,left,juxt,right,juxt and joint
-///
-/// If either juxt flag is true, then no space between words.
+/// If either juxtaposition flag is true, then no space between words.
 []
 type Layout =
-    | ObjLeaf of bool * obj * bool
-    | Leaf of bool * TaggedText * bool
-    | Node of bool * layout * bool * layout * bool * joint
-    | Attr of string * (string * string) list * layout
-
-and layout = Layout
-
-and joint = Joint
+    | ObjLeaf of juxtLeft: bool * object: obj * juxtRight: bool
+    | Leaf of juxtLeft: bool * text: TaggedText * justRight: bool
+    | Node of juxtLeft: bool * Layout * juxtMiddle: bool * Layout * juxtRight: bool * Joint
+    | Attr of text: string * attributes: (string * string) list * layout: Layout
 
 []
 type IEnvironment = 
-    abstract GetLayout: obj -> layout
+    abstract GetLayout: obj -> Layout
     abstract MaxColumns: int
     abstract MaxRows: int
 
@@ -305,7 +298,7 @@ module LayoutOps =
         leftL Literals.leftBrace ^^ layout ^^ rightL Literals.rightBrace
 
     let boundedUnfoldL
-        (itemL: 'a -> layout)
+        (itemL: 'a -> Layout)
         (project: 'z -> ('a * 'z) option)
         (stopShort: 'z -> bool)
         (z: 'z)
@@ -608,7 +601,7 @@ module Display =
                 | Node (jl, l, jm, r, jr, joint) ->
                     let mid = if jm then 0 else 1
                     match joint with
-                    | Unbreakable    ->
+                    | Unbreakable ->
                         let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
                         let pos = pos + mid                              // fit space if juxt says so 
                         let breaks, r, pos, offsetr = fit breaks (pos, r)    // fit right 
diff --git a/src/utils/sformat.fsi b/src/utils/sformat.fsi
index e1f37ae31fd..9ea4a712c02 100644
--- a/src/utils/sformat.fsi
+++ b/src/utils/sformat.fsi
@@ -98,10 +98,10 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
     /// of this data type is only for the consumption of formatting engines.
     []
     type public Layout =
-     | ObjLeaf of bool * obj * bool
-     | Leaf of bool * TaggedText * bool
-     | Node of bool * Layout * bool * Layout * bool * Joint
-     | Attr of string * (string * string) list * Layout
+        | ObjLeaf of juxtLeft: bool * object: obj * juxtRight: bool
+        | Leaf of juxtLeft: bool * text: TaggedText * justRight: bool
+        | Node of juxtLeft: bool * Layout * juxtMiddle: bool * Layout * juxtRight:bool * Joint
+        | Attr of text: string * attributes: (string * string) list * layout: Layout
 #endif
 
 #if COMPILER
@@ -162,10 +162,12 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
         /// Return to the layout-generation 
         /// environment to layout any otherwise uninterpreted object
         abstract GetLayout: obj -> Layout
+
         /// The maximum number of elements for which to generate layout for 
         /// list-like structures, or columns in table-like 
         /// structures.  -1 if no maximum.
         abstract MaxColumns: int
+
         /// The maximum number of rows for which to generate layout for table-like 
         /// structures.  -1 if no maximum.
         abstract MaxRows: int

From 77d808768da9783b0412b1ff336a6b04111275b0 Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Wed, 19 Aug 2020 15:37:56 +0100
Subject: [PATCH 05/10] cleanup old formatting code

---
 src/utils/sformat.fsi | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/utils/sformat.fsi b/src/utils/sformat.fsi
index 9ea4a712c02..db100c8fe87 100644
--- a/src/utils/sformat.fsi
+++ b/src/utils/sformat.fsi
@@ -46,8 +46,8 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
     []
     type public Joint =
         | Unbreakable
-        | Breakable of int
-        | Broken of int
+        | Breakable of indentation: int
+        | Broken of indentation: int
     
     []
     type public LayoutTag =
@@ -100,7 +100,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
     type public Layout =
         | ObjLeaf of juxtLeft: bool * object: obj * juxtRight: bool
         | Leaf of juxtLeft: bool * text: TaggedText * justRight: bool
-        | Node of juxtLeft: bool * Layout * juxtMiddle: bool * Layout * juxtRight:bool * Joint
+        | Node of juxtLeft: bool * leftLayout: Layout * juxtMiddle: bool * rightLayout: Layout * juxtRight: bool * joint: Joint
         | Attr of text: string * attributes: (string * string) list * layout: Layout
 #endif
 

From 80a832cc6df5ca10a48d2523d3489a7f36739dc4 Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Wed, 19 Aug 2020 15:43:47 +0100
Subject: [PATCH 06/10] cleanup old formatting code

---
 src/fsharp/layout.fs  | 98 +++++++++++++++++++++----------------------
 src/utils/sformat.fs  | 78 +++++++++++++++++-----------------
 src/utils/sformat.fsi |  2 +-
 3 files changed, 89 insertions(+), 89 deletions(-)

diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs
index 2650d60afb6..974074fa1d5 100644
--- a/src/fsharp/layout.fs
+++ b/src/fsharp/layout.fs
@@ -37,7 +37,7 @@ let rec juxtRight = function
   | Attr (_tag, _attrs, l)           -> juxtRight l
 
 // NOTE: emptyL might be better represented as a constructor, so then (Sep"") would have true meaning
-let emptyL = Leaf (true, Internal.Utilities.StructuredFormat.TaggedTextOps.tag LayoutTag.Text "", true)
+let emptyL = Leaf (true, TaggedTextOps.mkTag LayoutTag.Text "", true)
 let isEmptyL = function Leaf(true, tag, true) when tag.Text = "" -> true | _ -> false
       
 let mkNode l r joint =
@@ -59,57 +59,57 @@ let rightL (str:TaggedText) = Leaf (true, str, false)
 let leftL  (str:TaggedText) = Leaf (false, str, true)
 
 module TaggedTextOps =
-    let tagActivePatternCase = Internal.Utilities.StructuredFormat.TaggedTextOps.tag LayoutTag.ActivePatternCase
-    let tagActivePatternResult = Internal.Utilities.StructuredFormat.TaggedTextOps.tag LayoutTag.ActivePatternResult
-    let tagAlias = Internal.Utilities.StructuredFormat.TaggedTextOps.tagAlias
-    let tagClass = Internal.Utilities.StructuredFormat.TaggedTextOps.tagClass
-    let tagUnion = Internal.Utilities.StructuredFormat.TaggedTextOps.tag LayoutTag.Union
-    let tagUnionCase = Internal.Utilities.StructuredFormat.TaggedTextOps.tagUnionCase
-    let tagDelegate = Internal.Utilities.StructuredFormat.TaggedTextOps.tagDelegate
-    let tagEnum = Internal.Utilities.StructuredFormat.TaggedTextOps.tagEnum
-    let tagEvent = Internal.Utilities.StructuredFormat.TaggedTextOps.tagEvent
-    let tagField = Internal.Utilities.StructuredFormat.TaggedTextOps.tagField
-    let tagInterface = Internal.Utilities.StructuredFormat.TaggedTextOps.tagInterface
-    let tagKeyword = Internal.Utilities.StructuredFormat.TaggedTextOps.tagKeyword
-    let tagLineBreak = Internal.Utilities.StructuredFormat.TaggedTextOps.tagLineBreak
-    let tagLocal = Internal.Utilities.StructuredFormat.TaggedTextOps.tagLocal
-    let tagRecord = Internal.Utilities.StructuredFormat.TaggedTextOps.tagRecord
-    let tagRecordField = Internal.Utilities.StructuredFormat.TaggedTextOps.tagRecordField
-    let tagMethod = Internal.Utilities.StructuredFormat.TaggedTextOps.tagMethod
-    let tagMember = Internal.Utilities.StructuredFormat.TaggedTextOps.tag LayoutTag.Member
-    let tagModule = Internal.Utilities.StructuredFormat.TaggedTextOps.tagModule
-    let tagModuleBinding = Internal.Utilities.StructuredFormat.TaggedTextOps.tagModuleBinding
-    let tagNamespace = Internal.Utilities.StructuredFormat.TaggedTextOps.tagNamespace
-    let tagNumericLiteral = Internal.Utilities.StructuredFormat.TaggedTextOps.tagNumericLiteral
-    let tagOperator = Internal.Utilities.StructuredFormat.TaggedTextOps.tagOperator
-    let tagParameter = Internal.Utilities.StructuredFormat.TaggedTextOps.tagParameter
-    let tagProperty = Internal.Utilities.StructuredFormat.TaggedTextOps.tagProperty
-    let tagSpace = Internal.Utilities.StructuredFormat.TaggedTextOps.tagSpace
-    let tagStringLiteral = Internal.Utilities.StructuredFormat.TaggedTextOps.tagStringLiteral
-    let tagStruct = Internal.Utilities.StructuredFormat.TaggedTextOps.tagStruct
-    let tagTypeParameter = Internal.Utilities.StructuredFormat.TaggedTextOps.tagTypeParameter
-    let tagText = Internal.Utilities.StructuredFormat.TaggedTextOps.tagText
-    let tagPunctuation = Internal.Utilities.StructuredFormat.TaggedTextOps.tagPunctuation
-    let tagUnknownEntity = Internal.Utilities.StructuredFormat.TaggedTextOps.tag LayoutTag.UnknownEntity
-    let tagUnknownType = Internal.Utilities.StructuredFormat.TaggedTextOps.tag LayoutTag.UnknownType
+    let tagActivePatternCase = TaggedTextOps.mkTag LayoutTag.ActivePatternCase
+    let tagActivePatternResult = TaggedTextOps.mkTag LayoutTag.ActivePatternResult
+    let tagAlias = TaggedTextOps.tagAlias
+    let tagClass = TaggedTextOps.tagClass
+    let tagUnion = TaggedTextOps.mkTag LayoutTag.Union
+    let tagUnionCase = TaggedTextOps.tagUnionCase
+    let tagDelegate = TaggedTextOps.tagDelegate
+    let tagEnum = TaggedTextOps.tagEnum
+    let tagEvent = TaggedTextOps.tagEvent
+    let tagField = TaggedTextOps.tagField
+    let tagInterface = TaggedTextOps.tagInterface
+    let tagKeyword = TaggedTextOps.tagKeyword
+    let tagLineBreak = TaggedTextOps.tagLineBreak
+    let tagLocal = TaggedTextOps.tagLocal
+    let tagRecord = TaggedTextOps.tagRecord
+    let tagRecordField = TaggedTextOps.tagRecordField
+    let tagMethod = TaggedTextOps.tagMethod
+    let tagMember = TaggedTextOps.mkTag LayoutTag.Member
+    let tagModule = TaggedTextOps.tagModule
+    let tagModuleBinding = TaggedTextOps.tagModuleBinding
+    let tagNamespace = TaggedTextOps.tagNamespace
+    let tagNumericLiteral = TaggedTextOps.tagNumericLiteral
+    let tagOperator = TaggedTextOps.tagOperator
+    let tagParameter = TaggedTextOps.tagParameter
+    let tagProperty = TaggedTextOps.tagProperty
+    let tagSpace = TaggedTextOps.tagSpace
+    let tagStringLiteral = TaggedTextOps.tagStringLiteral
+    let tagStruct = TaggedTextOps.tagStruct
+    let tagTypeParameter = TaggedTextOps.tagTypeParameter
+    let tagText = TaggedTextOps.tagText
+    let tagPunctuation = TaggedTextOps.tagPunctuation
+    let tagUnknownEntity = TaggedTextOps.mkTag LayoutTag.UnknownEntity
+    let tagUnknownType = TaggedTextOps.mkTag LayoutTag.UnknownType
 
     module Literals =
         // common tagged literals
-        let lineBreak = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.lineBreak
-        let space = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.space
-        let comma = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.comma
-        let semicolon = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.semicolon
-        let leftParen = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.leftParen
-        let rightParen = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.rightParen
-        let leftBracket = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.leftBracket
-        let rightBracket = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.rightBracket
-        let leftBrace = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.leftBrace
-        let rightBrace = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.rightBrace
-        let leftBraceBar = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.leftBraceBar
-        let rightBraceBar = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.rightBraceBar
-        let equals = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.equals
-        let arrow = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.arrow
-        let questionMark = Internal.Utilities.StructuredFormat.TaggedTextOps.Literals.questionMark
+        let lineBreak = TaggedTextOps.Literals.lineBreak
+        let space = TaggedTextOps.Literals.space
+        let comma = TaggedTextOps.Literals.comma
+        let semicolon = TaggedTextOps.Literals.semicolon
+        let leftParen = TaggedTextOps.Literals.leftParen
+        let rightParen = TaggedTextOps.Literals.rightParen
+        let leftBracket = TaggedTextOps.Literals.leftBracket
+        let rightBracket = TaggedTextOps.Literals.rightBracket
+        let leftBrace = TaggedTextOps.Literals.leftBrace
+        let rightBrace = TaggedTextOps.Literals.rightBrace
+        let leftBraceBar = TaggedTextOps.Literals.leftBraceBar
+        let rightBraceBar = TaggedTextOps.Literals.rightBraceBar
+        let equals = TaggedTextOps.Literals.equals
+        let arrow = TaggedTextOps.Literals.arrow
+        let questionMark = TaggedTextOps.Literals.questionMark
         let dot = tagPunctuation "."
         let leftAngle = tagPunctuation "<"
         let rightAngle = tagPunctuation ">"
diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index 7b0a3ba7b22..ae3dd744eb8 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -80,15 +80,15 @@ type TaggedTextWriter =
 []
 type Joint =
     | Unbreakable
-    | Breakable of int
-    | Broken of int
+    | Breakable of indentation: int
+    | Broken of indentation: int
 
 /// If either juxtaposition flag is true, then no space between words.
 []
 type Layout =
     | ObjLeaf of juxtLeft: bool * object: obj * juxtRight: bool
     | Leaf of juxtLeft: bool * text: TaggedText * justRight: bool
-    | Node of juxtLeft: bool * Layout * juxtMiddle: bool * Layout * juxtRight: bool * Joint
+    | Node of juxtLeft: bool * leftLayout: Layout * juxtMiddle: bool * rightLayout: Layout * juxtRight: bool * joint: Joint
     | Attr of text: string * attributes: (string * string) list * layout: Layout
 
 []
@@ -98,15 +98,15 @@ type IEnvironment =
     abstract MaxRows: int
 
 module TaggedTextOps =
-    let tag tag text = 
+    let mkTag tag text = 
         { new TaggedText with 
-        member x.Tag = tag
-        member x.Text = text }
+            member _.Tag = tag
+            member _.Text = text }
 
     let length (tt: TaggedText) = tt.Text.Length
     let toText (tt: TaggedText) = tt.Text
 
-    let tagAlias t = tag LayoutTag.Alias t
+    let tagAlias t = mkTag LayoutTag.Alias t
     let keywordFunctions = Set ["raise"; "reraise"; "typeof"; "typedefof"; "sizeof"; "nameof"]
     let keywordTypes = 
         [
@@ -140,32 +140,32 @@ module TaggedTextOps =
         "uint64"
         "unativeint"
         ] |> Set.ofList
-    let tagClass name = if Set.contains name keywordTypes then tag LayoutTag.Keyword name else tag LayoutTag.Class name
-    let tagUnionCase t = tag LayoutTag.UnionCase t
-    let tagDelegate t = tag LayoutTag.Delegate t
-    let tagEnum t = tag LayoutTag.Enum t
-    let tagEvent t = tag LayoutTag.Event t
-    let tagField t = tag LayoutTag.Field t
-    let tagInterface t = tag LayoutTag.Interface t
-    let tagKeyword t = tag LayoutTag.Keyword t
-    let tagLineBreak t = tag LayoutTag.LineBreak t
-    let tagLocal t = tag LayoutTag.Local t
-    let tagRecord t = tag LayoutTag.Record t
-    let tagRecordField t = tag LayoutTag.RecordField t
-    let tagMethod t = tag LayoutTag.Method t
-    let tagModule t = tag LayoutTag.Module t
-    let tagModuleBinding name = if keywordFunctions.Contains name then tag LayoutTag.Keyword name else tag LayoutTag.ModuleBinding name
-    let tagNamespace t = tag LayoutTag.Namespace t
-    let tagNumericLiteral t = tag LayoutTag.NumericLiteral t
-    let tagOperator t = tag LayoutTag.Operator t
-    let tagParameter t = tag LayoutTag.Parameter t
-    let tagProperty t = tag LayoutTag.Property t
-    let tagSpace t = tag LayoutTag.Space t
-    let tagStringLiteral t = tag LayoutTag.StringLiteral t
-    let tagStruct t = tag LayoutTag.Struct t
-    let tagTypeParameter t = tag LayoutTag.TypeParameter t
-    let tagText t = tag LayoutTag.Text t
-    let tagPunctuation t = tag LayoutTag.Punctuation t
+    let tagClass name = if Set.contains name keywordTypes then mkTag LayoutTag.Keyword name else mkTag LayoutTag.Class name
+    let tagUnionCase t = mkTag LayoutTag.UnionCase t
+    let tagDelegate t = mkTag LayoutTag.Delegate t
+    let tagEnum t = mkTag LayoutTag.Enum t
+    let tagEvent t = mkTag LayoutTag.Event t
+    let tagField t = mkTag LayoutTag.Field t
+    let tagInterface t = mkTag LayoutTag.Interface t
+    let tagKeyword t = mkTag LayoutTag.Keyword t
+    let tagLineBreak t = mkTag LayoutTag.LineBreak t
+    let tagLocal t = mkTag LayoutTag.Local t
+    let tagRecord t = mkTag LayoutTag.Record t
+    let tagRecordField t = mkTag LayoutTag.RecordField t
+    let tagMethod t = mkTag LayoutTag.Method t
+    let tagModule t = mkTag LayoutTag.Module t
+    let tagModuleBinding name = if keywordFunctions.Contains name then mkTag LayoutTag.Keyword name else mkTag LayoutTag.ModuleBinding name
+    let tagNamespace t = mkTag LayoutTag.Namespace t
+    let tagNumericLiteral t = mkTag LayoutTag.NumericLiteral t
+    let tagOperator t = mkTag LayoutTag.Operator t
+    let tagParameter t = mkTag LayoutTag.Parameter t
+    let tagProperty t = mkTag LayoutTag.Property t
+    let tagSpace t = mkTag LayoutTag.Space t
+    let tagStringLiteral t = mkTag LayoutTag.StringLiteral t
+    let tagStruct t = mkTag LayoutTag.Struct t
+    let tagTypeParameter t = mkTag LayoutTag.TypeParameter t
+    let tagText t = mkTag LayoutTag.Text t
+    let tagPunctuation t = mkTag LayoutTag.Punctuation t
 
     module Literals =
         // common tagged literals
@@ -211,7 +211,7 @@ module LayoutOps =
     // constructors
     let objL (value:obj) = 
         match value with 
-        | :? string as s -> Leaf (false, tag LayoutTag.Text s, false)
+        | :? string as s -> Leaf (false, mkTag LayoutTag.Text s, false)
         | o -> ObjLeaf (false, o, false)
 
     let sLeaf (l, t, r) = Leaf (l, t, r)
@@ -224,7 +224,7 @@ module LayoutOps =
 
     let leftL text = sLeaf (false, text, true)
 
-    let emptyL = sLeaf (true, tag LayoutTag.Text "", true)
+    let emptyL = sLeaf (true, mkTag LayoutTag.Text "", true)
 
     let isEmptyL layout = 
         match layout with 
@@ -711,10 +711,10 @@ module Display =
                 let z = addL z pos r
                 z 
             | Attr (tag, attrs, l) ->
-            let _ = outAttribute tag attrs true
-            let z = addL z pos l
-            let _ = outAttribute tag attrs false
-            z
+                let _ = outAttribute tag attrs true
+                let z = addL z pos l
+                let _ = outAttribute tag attrs false
+                z
            
         let _ = addL z0 0 layout
         ()
diff --git a/src/utils/sformat.fsi b/src/utils/sformat.fsi
index db100c8fe87..00a901d25f8 100644
--- a/src/utils/sformat.fsi
+++ b/src/utils/sformat.fsi
@@ -109,7 +109,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
 #else
     module internal TaggedTextOps =
 #endif
-        val tag: LayoutTag -> string -> TaggedText
+        val mkTag: LayoutTag -> string -> TaggedText
         val keywordFunctions: Set
         val tagAlias: string -> TaggedText
         val tagClass: string -> TaggedText

From 9ab5d324ebe88846984b0bfb5f6440a21a930faa Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Wed, 19 Aug 2020 16:06:59 +0100
Subject: [PATCH 07/10] cleanup old formatting code

---
 src/utils/sformat.fs | 90 ++++++++++++++++++++++++--------------------
 1 file changed, 49 insertions(+), 41 deletions(-)

diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index ae3dd744eb8..82ac03f5952 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -240,13 +240,13 @@ module LayoutOps =
         elif isEmptyL r then l 
         else f l r
 
-    let (^^)  layout1 layout2  = mkNode layout1 layout2 (Unbreakable)
+    let (^^)  layout1 layout2 = mkNode layout1 layout2 (Unbreakable)
 
-    let (++)  layout1 layout2  = mkNode layout1 layout2 (Breakable 0)
+    let (++)  layout1 layout2 = mkNode layout1 layout2 (Breakable 0)
 
-    let (--)  layout1 layout2  = mkNode layout1 layout2 (Breakable 1)
+    let (--)  layout1 layout2 = mkNode layout1 layout2 (Breakable 1)
 
-    let (---) layout1 layout2  = mkNode layout1 layout2 (Breakable 2)
+    let (---) layout1 layout2 = mkNode layout1 layout2 (Breakable 2)
 
     let (@@) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 0)) layout1 layout2
 
@@ -256,18 +256,18 @@ module LayoutOps =
 
     let tagListL tagger els =
         match els with 
-        | []    -> emptyL
-        | [x]   -> x
+        | [] -> emptyL
+        | [x] -> x
         | x :: xs ->
             let rec process' prefixL yl =
                 match yl with
-                | []    -> prefixL
-                | y :: ys -> process' ((tagger prefixL) ++ y) ys
+                | [] -> prefixL
+                | y :: ys -> process' (tagger prefixL ++ y) ys
             process' x xs
             
-    let commaListL layouts = tagListL (fun prefixL -> prefixL ^^ rightL (Literals.comma)) layouts
+    let commaListL layouts = tagListL (fun prefixL -> prefixL ^^ rightL Literals.comma) layouts
 
-    let semiListL layouts  = tagListL (fun prefixL -> prefixL ^^ rightL (Literals.semicolon)) layouts
+    let semiListL layouts = tagListL (fun prefixL -> prefixL ^^ rightL Literals.semicolon) layouts
 
     let spaceListL layouts = tagListL (fun prefixL -> prefixL) layouts
 
@@ -279,13 +279,13 @@ module LayoutOps =
 
     let aboveListL layouts = 
         match layouts with
-        | []    -> emptyL
-        | [x]   -> x
+        | [] -> emptyL
+        | [x] -> x
         | x :: ys -> List.fold (fun pre y -> pre @@ y) x ys
 
     let optionL selector value = 
         match value with 
-        | None   -> wordL (tagUnionCase "None")
+        | None -> wordL (tagUnionCase "None")
         | Some x -> wordL (tagUnionCase "Some") -- (selector x)
 
     let listL selector value =
@@ -307,7 +307,7 @@ module LayoutOps =
         let rec consume n z =
             if stopShort z then [wordL (tagPunctuation "...")] else
             match project z with
-            | None       -> []  // exhausted input 
+            | None -> []  // exhausted input 
             | Some (x, z) -> if n<=0 then [wordL (tagPunctuation "...")]               // hit print_length limit 
                                     else itemL x :: consume (n-1) z  // cons recursive... 
         consume maxLength z  
@@ -545,7 +545,7 @@ module Display =
         if next=0 then raise (Failure "popBreak: underflow");
         let topBroke = stack.[next-1] < 0
         let outer = if outer=next then outer-1 else outer  // if all broken, unwind 
-        let next  = next - 1
+        let next = next - 1
         Breaks(next, outer, stack), topBroke
 
     let forceBreak (Breaks(next, outer, stack)) =
@@ -565,7 +565,7 @@ module Display =
         if maxWidth <= 0 then layout else 
         let rec fit breaks (pos, layout) =
             // breaks = break context, can force to get indentation savings.
-            // pos    = current position in line
+            // pos = current position in line
             // layout = to fit
             //------
             // returns:
@@ -581,6 +581,7 @@ module Display =
                     let breaks, layout, pos, offset = fit breaks (pos, l) 
                     let layout = Attr (tag, attrs, layout) 
                     breaks, layout, pos, offset
+
                 | Leaf (jl, text, jr)
                 | ObjLeaf (jl, ObjToTaggedText text, jr) ->
                     // save the formatted text from the squash
@@ -591,13 +592,14 @@ module Display =
                             breaks, layout, pos + textWidth, textWidth // great, it fits 
                         else
                             match forceBreak breaks with
-                            | None                 -> 
+                            | None -> 
                                 breaks, layout, pos + textWidth, textWidth // tough, no more breaks 
                             | Some (breaks, saving) -> 
                                 let pos = pos - saving 
                                 fitLeaf breaks pos
                        
                     fitLeaf breaks pos
+
                 | Node (jl, l, jm, r, jr, joint) ->
                     let mid = if jm then 0 else 1
                     match joint with
@@ -606,11 +608,13 @@ module Display =
                         let pos = pos + mid                              // fit space if juxt says so 
                         let breaks, r, pos, offsetr = fit breaks (pos, r)    // fit right 
                         breaks, Node (jl, l, jm, r, jr, Unbreakable), pos, offsetl + mid + offsetr
+
                     | Broken indent ->
                         let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
                         let pos = pos - offsetl + indent                 // broken so - offset left + ident 
                         let breaks, r, pos, offsetr = fit breaks (pos, r)    // fit right 
                         breaks, Node (jl, l, jm, r, jr, Broken indent), pos, indent + offsetr
+
                     | Breakable indent ->
                         let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
                         // have a break possibility, with saving 
@@ -643,10 +647,10 @@ module Display =
         let push x rstrs = x :: rstrs
         let z0 = [], 0
         let addText (rstrs, i) (text:string) = push text rstrs, i + text.Length
-        let index   (_, i)               = i
+        let index   (_, i)          = i
         let extract rstrs = combine(List.rev rstrs) 
-        let newLine (rstrs, _) n     = // \n then spaces... 
-            let indent = new System.String(' ', n)
+        let newLine (rstrs, _) n = // \n then spaces... 
+            let indent = new String(' ', n)
             let rstrs = push "\n"   rstrs
             let rstrs = push indent rstrs
             rstrs, n
@@ -654,24 +658,28 @@ module Display =
         // addL: pos is tab level 
         let rec addL z pos layout = 
             match layout with 
-            | ObjLeaf (_, obj, _)                 -> 
+            | ObjLeaf (_, obj, _) -> 
                 let text = leafFormatter obj
-                addText z text                 
-            | Leaf (_, obj, _)                 -> 
+                addText z text
+
+            | Leaf (_, obj, _) ->
                 addText z obj.Text
-            | Node (_, l, _, r, _, Broken indent) 
+
+            | Node (_, l, _, r, _, Broken indent)
                     // Print width = 0 implies 1D layout, no squash
-                    when not (opts.PrintWidth = 0)  -> 
+                    when not (opts.PrintWidth = 0) ->
                 let z = addL z pos l
                 let z = newLine z (pos+indent)
                 let z = addL z (pos+indent) r
                 z
-            | Node (_, l, jm, r, _, _)             -> 
+
+            | Node (_, l, jm, r, _, _) ->
                 let z = addL z pos l
                 let z = if jm then z else addText z " "
                 let pos = index z
                 let z = addL z pos r
                 z
+
             | Attr (_, _, l) ->
                 addL z pos l
            
@@ -684,9 +692,9 @@ module Display =
         // z is just current indent 
         let z0 = 0
         let index i = i
-        let addText z text  = write text;  (z + length text)
-        let newLine _ n     = // \n then spaces... 
-            let indent = new System.String(' ', n)
+        let addText z text = write text;  (z + length text)
+        let newLine _ n = // \n then spaces... 
+            let indent = new String(' ', n)
             chan.WriteLine();
             write (tagText indent);
             n
@@ -694,17 +702,17 @@ module Display =
         // addL: pos is tab level 
         let rec addL z pos layout = 
             match layout with 
-            | ObjLeaf (_, obj, _)                 -> 
+            | ObjLeaf (_, obj, _) -> 
                 let text = leafFormatter obj 
                 addText z text
-            | Leaf (_, obj, _)                 -> 
+            | Leaf (_, obj, _) -> 
                 addText z obj
             | Node (_, l, _, r, _, Broken indent) -> 
                 let z = addL z pos l
                 let z = newLine z (pos+indent)
                 let z = addL z (pos+indent) r
                 z
-            | Node (_, l, jm, r, _, _)             -> 
+            | Node (_, l, jm, r, _, _) -> 
                 let z = addL z pos l
                 let z = if jm then z else addText z Literals.space
                 let pos = index z
@@ -722,7 +730,7 @@ module Display =
     let unpackCons recd =
         match recd with 
         | [|(_, h);(_, t)|] -> (h, t)
-        | _  -> failwith "unpackCons"
+        | _ -> failwith "unpackCons"
 
     let getListValueInfo bindingFlags (x:obj, ty:Type) =
         match x with 
@@ -810,7 +818,7 @@ module Display =
         //
         // The suffix like "+[dd chars]" is 11 chars.
         //                  12345678901
-        let suffixLength    = 11 // turning point suffix length
+        let suffixLength = 11 // turning point suffix length
         let prefixMinLength = 12 // arbitrary. If print width is reduced, want to print a minimum of information on strings...
         let prefixLength = max (width - 2 (*quotes*) - suffixLength) prefixMinLength
         "\"" + (str.Substring(0,prefixLength)) + "\"" + "+[" + (str.Length - prefixLength).ToString() + " chars]"
@@ -859,7 +867,7 @@ module Display =
                 match x with 
                 | null -> 
                     reprL showMode (depthLim-1) prec info x
-                | _    ->
+                | _ ->
                     if (path.ContainsKey(x)) then 
                         wordL (tagPunctuation "...")
                     else 
@@ -893,7 +901,7 @@ module Display =
                         let res = 
                             match res with 
                             | Some res -> res
-                            | None     -> reprL showMode (depthLim-1) prec info x
+                            | None -> reprL showMode (depthLim-1) prec info x
 
                         path.Remove(x) |> ignore
                         res
@@ -1028,7 +1036,7 @@ module Display =
                 countNodes 1
                 wordL (tagPunctuation "[]")
 
-        and unionCaseValueL depthLim prec (declaringType: Type option) unionCaseName recd  =
+        and unionCaseValueL depthLim prec (declaringType: Type option) unionCaseName recd =
             countNodes 1
             let caseName =
                 match declaringType with
@@ -1044,7 +1052,7 @@ module Display =
             countNodes 1
             let name = exceptionType.Name 
             match recd with
-            | []   -> (wordL (tagClass name))
+            | [] -> (wordL (tagClass name))
             | recd -> (wordL (tagClass name) --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
 
         and showModeFilter showMode layout =
@@ -1092,7 +1100,7 @@ module Display =
                     else Some ((box (arr.GetValue(x,y)), ty),y+1)
                 let rowL x = boundedUnfoldL (nestedObjL depthLim Precedence.BracketIfTuple) (project2 x) stopShort b2 opts.PrintLength |> makeListL
                 let project1 x = if x>=(b1+n1) then None else Some (x,x+1)
-                let rowsL  = boundedUnfoldL rowL project1 stopShort b1 opts.PrintLength
+                let rowsL = boundedUnfoldL rowL project1 stopShort b1 opts.PrintLength
                 makeArray2L (if b1=0 && b2 = 0 then rowsL else wordL (tagText("bound1=" + string_of_int b1)) :: wordL(tagText("bound2=" + string_of_int b2)) :: rowsL)
             | n -> 
                 makeArrayL [wordL (tagText("rank=" + string_of_int n))]
@@ -1192,7 +1200,7 @@ module Display =
                                                     x<>null && isListType (x.GetType()) ->
                 listValueL depthLim constr recd
 
-            | UnionCaseValue(declaringType, unionCaseName, recd)   ->
+            | UnionCaseValue(declaringType, unionCaseName, recd) ->
                 unionCaseValueL depthLim prec declaringType unionCaseName (Array.toList recd)
 
             | ExceptionValue(exceptionType, recd) ->
@@ -1212,7 +1220,7 @@ module Display =
                     wordL (tagText "")
                 else nullL
 
-            | ObjectValue obj  ->
+            | ObjectValue obj ->
                 let ty = obj.GetType()
                 match obj with 
                 | :? string as s ->

From bfe727d7ff79c93de8d12e20c5b1b06bfda36169 Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Wed, 19 Aug 2020 16:18:15 +0100
Subject: [PATCH 08/10] cleanup old formatting code

---
 src/fsharp/layout.fs  | 48 +++++++++++----------------------
 src/utils/sformat.fs  | 63 +++++++++++++++++++++++--------------------
 src/utils/sformat.fsi |  5 +++-
 3 files changed, 54 insertions(+), 62 deletions(-)

diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs
index 974074fa1d5..22c92e56acf 100644
--- a/src/fsharp/layout.fs
+++ b/src/fsharp/layout.fs
@@ -16,26 +16,13 @@ type TaggedText = Internal.Utilities.StructuredFormat.TaggedText
 type NavigableTaggedText(taggedText: TaggedText, range: Range.range) =
     member val Range = range
     interface TaggedText with
-        member x.Tag = taggedText.Tag
-        member x.Text = taggedText.Text
+        member _.Tag = taggedText.Tag
+        member _.Text = taggedText.Text
 
 let mkNav r t = NavigableTaggedText(t, r) :> TaggedText
 
 let spaces n = new String(' ', n)
 
-// Note, there is duplication here with 'Display.juxtLeft' etc.
-let rec juxtLeft = function
-  | ObjLeaf (jl, _text, _jr)         -> jl
-  | Leaf (jl, _text, _jr)            -> jl
-  | Node (jl, _l, _jm, _r, _jr, _joint) -> jl
-  | Attr (_tag, _attrs, l)           -> juxtLeft l
-
-let rec juxtRight = function
-  | ObjLeaf (_jl, _text, jr)         -> jr
-  | Leaf (_jl, _text, jr)            -> jr
-  | Node (_jl, _l, _jm, _r, jr, _joint) -> jr
-  | Attr (_tag, _attrs, l)           -> juxtRight l
-
 // NOTE: emptyL might be better represented as a constructor, so then (Sep"") would have true meaning
 let emptyL = Leaf (true, TaggedTextOps.mkTag LayoutTag.Text "", true)
 let isEmptyL = function Leaf(true, tag, true) when tag.Text = "" -> true | _ -> false
@@ -43,11 +30,7 @@ let isEmptyL = function Leaf(true, tag, true) when tag.Text = "" -> true | _ ->
 let mkNode l r joint =
    if isEmptyL l then r else
    if isEmptyL r then l else
-   let jl = juxtLeft  l 
-   let jm = juxtRight l || juxtLeft r 
-   let jr = juxtRight r 
-   Node(jl, l, jm, r, jr, joint)
-
+   Node(l, r, joint)
 
 //--------------------------------------------------------------------------
 //INDEX: constructors
@@ -281,12 +264,13 @@ let renderL (rr: LayoutRenderer<_, _>) layout =
         (* pos is tab level *)
       | Leaf (_, text, _)                 -> 
           k(rr.AddText z text, i + text.Text.Length)
-      | Node (_, l, _, r, _, Broken indent) -> 
+      | Node (l, r, Broken indent) -> 
           addL z pos i l <|
             fun (z, _i) ->
               let z, i = rr.AddBreak z (pos+indent), (pos+indent) 
               addL z (pos+indent) i r k
-      | Node (_, l, jm, r, _, _)             -> 
+      | Node (l, r, _)             -> 
+          let jm = Layout.JuxtapositionMiddle (l, r)
           addL z pos i l <|
             fun (z, i) ->
               let z, i = if jm then z, i else rr.AddText z Literals.space, i+1 
@@ -306,11 +290,11 @@ let renderL (rr: LayoutRenderer<_, _>) layout =
 /// string render 
 let stringR =
   { new LayoutRenderer with 
-      member x.Start () = []
-      member x.AddText rstrs taggedText = taggedText.Text :: rstrs
-      member x.AddBreak rstrs n = (spaces n) :: "\n" ::  rstrs 
-      member x.AddTag z (_, _, _) = z
-      member x.Finish rstrs = String.Join("", Array.ofList (List.rev rstrs)) }
+      member _.Start () = []
+      member _.AddText rstrs taggedText = taggedText.Text :: rstrs
+      member _.AddBreak rstrs n = (spaces n) :: "\n" ::  rstrs 
+      member _.AddTag z (_, _, _) = z
+      member _.Finish rstrs = String.Join("", Array.ofList (List.rev rstrs)) }
 
 type NoState = NoState
 type NoResult = NoResult
@@ -318,11 +302,11 @@ type NoResult = NoResult
 /// string render 
 let taggedTextListR collector =
   { new LayoutRenderer with 
-      member x.Start () = NoState
-      member x.AddText z text = collector text; z
-      member x.AddBreak rstrs n = collector Literals.lineBreak; collector (tagSpace(spaces n)); rstrs 
-      member x.AddTag z (_, _, _) = z
-      member x.Finish rstrs = NoResult }
+      member _.Start () = NoState
+      member _.AddText z text = collector text; z
+      member _.AddBreak rstrs n = collector Literals.lineBreak; collector (tagSpace(spaces n)); rstrs 
+      member _.AddTag z (_, _, _) = z
+      member _.Finish rstrs = NoResult }
 
 
 /// channel LayoutRenderer
diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index 82ac03f5952..e37546f90bf 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -88,9 +88,26 @@ type Joint =
 type Layout =
     | ObjLeaf of juxtLeft: bool * object: obj * juxtRight: bool
     | Leaf of juxtLeft: bool * text: TaggedText * justRight: bool
-    | Node of juxtLeft: bool * leftLayout: Layout * juxtMiddle: bool * rightLayout: Layout * juxtRight: bool * joint: Joint
+    | Node of leftLayout: Layout * rightLayout: Layout * joint: Joint
     | Attr of text: string * attributes: (string * string) list * layout: Layout
 
+    member layout.JuxtapositionLeft =
+        match layout with
+        | ObjLeaf (jl, _, _) -> jl
+        | Leaf (jl, _, _) -> jl
+        | Node (left, _, _) -> left.JuxtapositionLeft
+        | Attr (_, _, subLayout) -> subLayout.JuxtapositionLeft
+
+    static member JuxtapositionMiddle (left: Layout, right: Layout) =
+        left.JuxtapositionRight || right.JuxtapositionLeft
+
+    member layout.JuxtapositionRight =
+        match layout with
+        | ObjLeaf (_, _, jr) -> jr
+        | Leaf (_, _, jr) -> jr
+        | Node (_, right, _) -> right.JuxtapositionRight
+        | Attr (_, _, subLayout) -> subLayout.JuxtapositionRight
+
 []
 type IEnvironment = 
     abstract GetLayout: obj -> Layout
@@ -188,25 +205,8 @@ module TaggedTextOps =
 module LayoutOps = 
     open TaggedTextOps
 
-    let rec juxtLeft lf =
-        match lf with
-        | ObjLeaf (jl, _, _) -> jl
-        | Leaf (jl, _, _) -> jl
-        | Node (jl, _, _, _, _, _) -> jl
-        | Attr (_, _, l) -> juxtLeft l
-
-    let rec juxtRight lf =
-        match lf with
-        | ObjLeaf (_, _, jr) -> jr
-        | Leaf (_, _, jr) -> jr
-        | Node (_, _, _, _, jr, _) -> jr
-        | Attr (_, _, l) -> juxtRight l
-
     let mkNode l r joint =
-        let jl = juxtLeft  l 
-        let jm = juxtRight l || juxtLeft r 
-        let jr = juxtRight r 
-        Node(jl, l, jm, r, jr, joint)
+        Node(l, r, joint)
 
     // constructors
     let objL (value:obj) = 
@@ -600,20 +600,23 @@ module Display =
                        
                     fitLeaf breaks pos
 
-                | Node (jl, l, jm, r, jr, joint) ->
+                | Node (l, r, joint) ->
+                    let jl = l.JuxtapositionLeft
+                    let jr = r.JuxtapositionLeft
+                    let jm = Layout.JuxtapositionMiddle (l, r)
                     let mid = if jm then 0 else 1
                     match joint with
                     | Unbreakable ->
                         let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
                         let pos = pos + mid                              // fit space if juxt says so 
                         let breaks, r, pos, offsetr = fit breaks (pos, r)    // fit right 
-                        breaks, Node (jl, l, jm, r, jr, Unbreakable), pos, offsetl + mid + offsetr
+                        breaks, Node (l, r, Unbreakable), pos, offsetl + mid + offsetr
 
                     | Broken indent ->
                         let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
                         let pos = pos - offsetl + indent                 // broken so - offset left + ident 
                         let breaks, r, pos, offsetr = fit breaks (pos, r)    // fit right 
-                        breaks, Node (jl, l, jm, r, jr, Broken indent), pos, indent + offsetr
+                        breaks, Node (l, r, Broken indent), pos, indent + offsetr
 
                     | Breakable indent ->
                         let breaks, l, pos, offsetl = fit breaks (pos, l)    // fit left 
@@ -625,13 +628,13 @@ module Display =
                             let breaks, r, pos, offsetr = fit breaks (pos, r)
                             let breaks, broken = popBreak breaks
                             if broken then
-                                breaks, Node (jl, l, jm, r, jr, Broken indent)   , pos, indent + offsetr
+                                breaks, Node (l, r, Broken indent)   , pos, indent + offsetr
                             else
-                                breaks, Node (jl, l, jm, r, jr, Breakable indent), pos, offsetl + mid + offsetr
+                                breaks, Node (l, r, Breakable indent), pos, offsetl + mid + offsetr
                         else
                             // actually no saving so no break 
                             let breaks, r, pos, offsetr = fit breaks (pos, r)
-                            breaks, Node (jl, l, jm, r, jr, Breakable indent)  , pos, offsetl + mid + offsetr
+                            breaks, Node (l, r, Breakable indent)  , pos, offsetl + mid + offsetr
                
             //printf "\nDone:     pos=%d offset=%d" pos offset;
             breaks, layout, pos, offset
@@ -665,7 +668,7 @@ module Display =
             | Leaf (_, obj, _) ->
                 addText z obj.Text
 
-            | Node (_, l, _, r, _, Broken indent)
+            | Node (l, r, Broken indent)
                     // Print width = 0 implies 1D layout, no squash
                     when not (opts.PrintWidth = 0) ->
                 let z = addL z pos l
@@ -673,7 +676,8 @@ module Display =
                 let z = addL z (pos+indent) r
                 z
 
-            | Node (_, l, jm, r, _, _) ->
+            | Node (l, r, _) ->
+                let jm = Layout.JuxtapositionMiddle (l, r)
                 let z = addL z pos l
                 let z = if jm then z else addText z " "
                 let pos = index z
@@ -707,12 +711,13 @@ module Display =
                 addText z text
             | Leaf (_, obj, _) -> 
                 addText z obj
-            | Node (_, l, _, r, _, Broken indent) -> 
+            | Node (l, r, Broken indent) -> 
                 let z = addL z pos l
                 let z = newLine z (pos+indent)
                 let z = addL z (pos+indent) r
                 z
-            | Node (_, l, jm, r, _, _) -> 
+            | Node (l, r, _) -> 
+                let jm = Layout.JuxtapositionMiddle (l, r)
                 let z = addL z pos l
                 let z = if jm then z else addText z Literals.space
                 let pos = index z
diff --git a/src/utils/sformat.fsi b/src/utils/sformat.fsi
index 00a901d25f8..a71fd6ef1f6 100644
--- a/src/utils/sformat.fsi
+++ b/src/utils/sformat.fsi
@@ -100,8 +100,11 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
     type public Layout =
         | ObjLeaf of juxtLeft: bool * object: obj * juxtRight: bool
         | Leaf of juxtLeft: bool * text: TaggedText * justRight: bool
-        | Node of juxtLeft: bool * leftLayout: Layout * juxtMiddle: bool * rightLayout: Layout * juxtRight: bool * joint: Joint
+        | Node of leftLayout: Layout * rightLayout: Layout * joint: Joint
         | Attr of text: string * attributes: (string * string) list * layout: Layout
+        member JuxtapositionLeft : bool
+        member JuxtapositionRight : bool
+        static member JuxtapositionMiddle: left: Layout * right: Layout -> bool
 #endif
 
 #if COMPILER

From f8f35ab5d9cda5f68041d71feda0b687018c625f Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Wed, 19 Aug 2020 16:20:35 +0100
Subject: [PATCH 09/10] cleanup old formatting code

---
 src/utils/sformat.fs  | 2 --
 src/utils/sformat.fsi | 3 +--
 2 files changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index e37546f90bf..a871b709838 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -601,8 +601,6 @@ module Display =
                     fitLeaf breaks pos
 
                 | Node (l, r, joint) ->
-                    let jl = l.JuxtapositionLeft
-                    let jr = r.JuxtapositionLeft
                     let jm = Layout.JuxtapositionMiddle (l, r)
                     let mid = if jm then 0 else 1
                     match joint with
diff --git a/src/utils/sformat.fsi b/src/utils/sformat.fsi
index a71fd6ef1f6..da5b4219fb5 100644
--- a/src/utils/sformat.fsi
+++ b/src/utils/sformat.fsi
@@ -102,8 +102,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl
         | Leaf of juxtLeft: bool * text: TaggedText * justRight: bool
         | Node of leftLayout: Layout * rightLayout: Layout * joint: Joint
         | Attr of text: string * attributes: (string * string) list * layout: Layout
-        member JuxtapositionLeft : bool
-        member JuxtapositionRight : bool
+
         static member JuxtapositionMiddle: left: Layout * right: Layout -> bool
 #endif
 

From 04966abe807f43ee0f1357dd5af25a390afce9b2 Mon Sep 17 00:00:00 2001
From: Don Syme 
Date: Fri, 21 Aug 2020 17:51:46 +0100
Subject: [PATCH 10/10] Update sformat.fs

---
 src/utils/sformat.fs | 46 ++++++++++++++------------------------------
 1 file changed, 14 insertions(+), 32 deletions(-)

diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index a871b709838..ae397492934 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -521,16 +521,10 @@ module Display =
     // - if all breaks forced, then outer=next.
     // - popping under these conditions needs to reduce outer and next.
         
-
-    //let dumpBreaks prefix (Breaks(next,outer,stack)) = ()
-    //   printf "%s: next=%d outer=%d stack.Length=%d\n" prefix next outer stack.Length;
-    //   stdout.Flush() 
-             
     let chunkN = 400      
     let breaks0 () = Breaks(0, 0, Array.create chunkN 0)
 
     let pushBreak saving (Breaks(next, outer, stack)) =
-        //dumpBreaks "pushBreak" (next, outer, stack);
         let stack = 
             if next = stack.Length then
                 Array.init (next + chunkN) (fun i -> if i < next then stack.[i] else 0) // expand if full 
@@ -541,7 +535,6 @@ module Display =
         Breaks(next+1, outer, stack)
 
     let popBreak (Breaks(next, outer, stack)) =
-        //dumpBreaks "popBreak" (next, outer, stack);
         if next=0 then raise (Failure "popBreak: underflow");
         let topBroke = stack.[next-1] < 0
         let outer = if outer=next then outer-1 else outer  // if all broken, unwind 
@@ -549,7 +542,6 @@ module Display =
         Breaks(next, outer, stack), topBroke
 
     let forceBreak (Breaks(next, outer, stack)) =
-        //dumpBreaks "forceBreak" (next, outer, stack);
         if outer=next then
             // all broken 
             None
@@ -792,9 +784,6 @@ module Display =
         match c with 
         | '\'' when isChar -> "\\\'"
         | '\"' when not isChar -> "\\\""
-        //| '\n' -> "\\n"
-        //| '\r' -> "\\r"
-        //| '\t' -> "\\t"
         | '\\' -> "\\\\"
         | '\b' -> "\\b"
         | _ when System.Char.IsControl(c) -> 
@@ -808,24 +797,21 @@ module Display =
         let rec check i = i < s.Length && not (System.Char.IsControl(s,i)) && s.[i] <> '\"' && check (i+1) 
         let rec conv i acc = if i = s.Length then combine (List.rev acc) else conv (i+1) (formatChar false s.[i] :: acc)  
         "\"" + s + "\""
-        // REVIEW: should we check for the common case of no control characters? Reinstate the following?
-        //"\"" + (if check 0 then s else conv 0 []) + "\""
 
+    // Return a truncated version of the string, e.g.
+    //   "This is the initial text, which has been truncated"+[12 chars]
+    //
+    // Note: The layout code forces breaks based on leaf size and possible break points.
+    //       It does not force leaf size based on width.
+    //       So long leaf-string width can not depend on their printing context...
+    //
+    // The suffix like "+[dd chars]" is 11 chars.
+    //                  12345678901
     let formatStringInWidth (width:int) (str:string) =
-        // Return a truncated version of the string, e.g.
-        //   "This is the initial text, which has been truncated"+[12 chars]
-        //
-        // Note: The layout code forces breaks based on leaf size and possible break points.
-        //       It does not force leaf size based on width.
-        //       So long leaf-string width can not depend on their printing context...
-        //
-        // The suffix like "+[dd chars]" is 11 chars.
-        //                  12345678901
         let suffixLength = 11 // turning point suffix length
         let prefixMinLength = 12 // arbitrary. If print width is reduced, want to print a minimum of information on strings...
         let prefixLength = max (width - 2 (*quotes*) - suffixLength) prefixMinLength
         "\"" + (str.Substring(0,prefixLength)) + "\"" + "+[" + (str.Length - prefixLength).ToString() + " chars]"
-
                            
     type Precedence = 
         | BracketIfTupleOrNotAtomic = 2
@@ -843,12 +829,12 @@ module Display =
         (ty.GetGenericTypeDefinition() = typedefof> 
          || ty.GetGenericTypeDefinition() = typedefof>)
 
+    // showMode = ShowTopLevelBinding on the outermost expression when called from fsi.exe,
+    // This allows certain outputs, e.g. objects that would print as  to be suppressed, etc. See 4343.
+    // Calls to layout proper sub-objects should pass showMode = ShowAll.
+    //
+    // Precedences to ensure we add brackets in the right places   
     type ObjectGraphFormatter(opts: FormatOptions, bindingFlags) =
-        // showMode = ShowTopLevelBinding on the outermost expression when called from fsi.exe,
-        // This allows certain outputs, e.g. objects that would print as  to be suppressed, etc. See 4343.
-        // Calls to layout proper sub-objects should pass showMode = ShowAll.
-
-        // Precedences to ensure we add brackets in the right places   
             
         // Keep a record of objects encountered along the way
         let path = Dictionary(10,HashIdentity.Reference)
@@ -1253,10 +1239,6 @@ module Display =
         member _.Format(showMode, x:'a, xty:Type) =
             objL showMode opts.PrintDepth  Precedence.BracketIfTuple (x, xty)
 
-    // --------------------------------------------------------------------
-    // pprinter: leafFormatter
-    // --------------------------------------------------------------------
-
     let leafFormatter (opts:FormatOptions) (obj :obj) =
         match obj with 
         | null -> tagKeyword "null"