diff --git a/Readme.md b/Readme.md index 072c4fe..f9f1fd2 100644 --- a/Readme.md +++ b/Readme.md @@ -104,7 +104,7 @@ The details of string interpolation internals are specified in [F# RFC FS-1001 - They appear as follow in this library: * Type-checked "printf-style" fills behave exactly as they do in `sprintf` and friends. -* Unchecked ".NET-style" fills appear with a `Specifier.TypeChar` of 'P' and the .NET format string +* Unchecked ".NET-style" fills appear with a `Specifier.TypeChar` of `'P'` and the .NET format string in `Specifier.InteropHoleDotNetFormat`. [fs-1001]: https://github.com/fsharp/fslang-design/blob/aca88da13cdb95f4f337d4f7d44cbf9d343704ae/FSharp-5.0/FS-1001-StringInterpolation.md#f-rfc-fs-1001---string-interpolation diff --git a/Release Notes.md b/Release Notes.md index c0db328..10afae1 100644 --- a/Release Notes.md +++ b/Release Notes.md @@ -1,3 +1,7 @@ +### New in 2.1.0 + +* Synchronize with the latest FSharp.Core version and support the `%B` format specifier + ### New in 2.0.0 * Include the readme in the NuGet package diff --git a/src/BlackFox.MasterOfFoo.Tests/InternalRepresentationTests.fs b/src/BlackFox.MasterOfFoo.Tests/InternalRepresentationTests.fs index aaf56e7..4c950f6 100644 --- a/src/BlackFox.MasterOfFoo.Tests/InternalRepresentationTests.fs +++ b/src/BlackFox.MasterOfFoo.Tests/InternalRepresentationTests.fs @@ -143,6 +143,16 @@ Finalize """ } + test "int hole only %B" { + testEqual + (testprintf "%B" 42) + """ +Init +Write value: 42, type: FromFormatSpecifier, valueType: System.Int32, spec: 'B', Precision=-, Width=-, Flags=None, starWidth: , starPrecision: , AsPrintF: 101010; +Finalize +""" + } + test "float64 hole only %f" { testEqual (testprintf "%f" 42.42) diff --git a/src/BlackFox.MasterOfFoo.Tests/Test.fs b/src/BlackFox.MasterOfFoo.Tests/Test.fs index 53de6f4..190b2a5 100644 --- a/src/BlackFox.MasterOfFoo.Tests/Test.fs +++ b/src/BlackFox.MasterOfFoo.Tests/Test.fs @@ -74,13 +74,20 @@ let tests = [ "%s" } - test "int format" { + test "int format %i" { Expect.equal (coreprintf "%i" 5) (testprintf "%i" 5) "%i" } + test "int format %B" { + Expect.equal + (coreprintf "%B" 5) + (testprintf "%B" 5) + "%B" + } + test "int untyped interpolation" { Expect.equal (coreprintf $"{5}") diff --git a/src/BlackFox.MasterOfFoo/PrintfEnv.fs b/src/BlackFox.MasterOfFoo/PrintfEnv.fs index 4793076..39e3dad 100644 --- a/src/BlackFox.MasterOfFoo/PrintfEnv.fs +++ b/src/BlackFox.MasterOfFoo/PrintfEnv.fs @@ -135,3 +135,10 @@ type PrintfEnv<'State, 'Residue, 'Result>(state: 'State) = env.Write(PrintableElement("%", PrintableElementType.MadeByEngine)) env.Finalize() + + /// This is the new name of Finalize in the new version of FSharp.Core + /// + /// We can't rename our method without breaking customers code but changing the name everywhere in printf.fs is + /// also a pain. So as an alternative this internal version, made only to ease porting was introduced. + member internal env.Finish () = + env.Finalize() diff --git a/src/BlackFox.MasterOfFoo/printf.fs b/src/BlackFox.MasterOfFoo/printf.fs index 9dcb5a5..24081f0 100644 --- a/src/BlackFox.MasterOfFoo/printf.fs +++ b/src/BlackFox.MasterOfFoo/printf.fs @@ -16,6 +16,7 @@ open Microsoft.FSharp.Collections open LanguagePrimitives.IntrinsicOperators +type objnull = obj open BlackFox.MasterOfFoo open BlackFox.MasterOfFoo.FormatFlagsHelpers @@ -148,7 +149,7 @@ module internal PrintfImpl = let p = parsePrecision s &i2 let typeChar = parseTypeChar s &i2 - // shortcut for the simpliest case + // shortcut for the simplest case // if typeChar is not % or it has star as width\precision - resort to long path if typeChar = '%' && not (w = StarValue || p = StarValue) then buf.Append('%') |> ignore @@ -165,7 +166,7 @@ module internal PrintfImpl = /// Type of results produced by specialization. /// /// This is a function that accepts a thunk to create PrintfEnv on demand (at the very last - /// appliction of an argument) and returns a concrete instance of an appriate curried printer. + /// application of an argument) and returns a concrete instance of an appropriate curried printer. /// /// After all arguments are collected, specialization obtains concrete PrintfEnv from the thunk /// and uses it to output collected data. @@ -180,7 +181,7 @@ module internal PrintfImpl = /// If we captured into an mutable array then these would interfere type PrintfInitial<'State, 'Residue, 'Result> = (unit -> PrintfEnv<'State, 'Residue, 'Result>) type PrintfFuncFactory<'Printer, 'State, 'Residue, 'Result> = - delegate of obj list * PrintfInitial<'State, 'Residue, 'Result> -> 'Printer + delegate of objnull list * PrintfInitial<'State, 'Residue, 'Result> -> 'Printer [] let MaxArgumentsInSpecialization = 3 @@ -247,7 +248,7 @@ module internal PrintfImpl = static member CaptureLittleA<'A, 'Tail>(next: PrintfFuncFactory<_, 'State, 'Residue, 'Result>) = PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial -> (fun (f: 'State -> 'A -> 'Residue) (arg1: 'A) -> - let args = box arg1 :: box (fun s (arg:obj) -> f s (unbox arg)) :: args + let args = box arg1 :: box (fun s (arg:objnull) -> f s (unbox arg)) :: args next.Invoke(args, initial) : 'Tail ) ) @@ -280,7 +281,7 @@ module internal PrintfImpl = env.WriteSkipEmpty prefix1 env.Write(conv1 (box arg1)) env.WriteSkipEmpty prefix2 - env.Finalize()) + env.Finish()) ) // Special case for format strings containing two simple formats like '%d %s' etc, i.e. @@ -298,7 +299,7 @@ module internal PrintfImpl = env.WriteSkipEmpty prefix2 env.Write(conv2 (box arg2)) env.WriteSkipEmpty prefix3 - env.Finalize()) + env.Finish()) ) let inline (===) a b = Object.ReferenceEquals(a, b) @@ -316,12 +317,12 @@ module internal PrintfImpl = /// A wrapper struct used to slightly strengthen the types of "ValueConverter" objects produced during composition of /// the dynamic implementation. These are always functions but sometimes they take one argument, sometimes two. [] - type ValueConverter private (f: obj) = + type ValueConverter internal (f: objnull) = member x.FuncObj = f - static member inline Make (f: obj -> string) = ValueConverter(box f) - static member inline Make (f: obj -> int -> string) = ValueConverter(box f) - static member inline Make (f: obj -> int-> int -> string) = ValueConverter(box f) + static member inline Make (f: objnull -> string) = ValueConverter(box f) + static member inline Make (f: objnull -> int -> string) = ValueConverter(box f) + static member inline Make (f: objnull -> int-> int -> string) = ValueConverter(box f) let getFormatForFloat (ch: char) (prec: int) = ch.ToString() + prec.ToString() @@ -339,7 +340,7 @@ module internal PrintfImpl = /// pad here is function that converts T to string with respect of justification /// basic - function that converts T to string without applying justification rules /// adaptPaddedFormatted returns boxed function that has various number of arguments depending on if width\precision flags has '*' value - let adaptPaddedFormatted (spec: FormatSpecifier) getFormat (basic: string -> obj -> string) (pad: string -> int -> obj -> string) : ValueConverter = + let adaptPaddedFormatted (spec: FormatSpecifier) getFormat (basic: string -> objnull -> string) (pad: string -> int -> objnull -> string) : ValueConverter = if spec.IsStarWidth then if spec.IsStarPrecision then // width=*, prec=* @@ -369,17 +370,17 @@ module internal PrintfImpl = let fmt = getFormat prec if spec.IsWidthSpecified then // width=val, prec=* - ValueConverter.Make (fun v -> - pad fmt spec.Width v) + ValueConverter.Make ( + pad fmt spec.Width) else // width=X, prec=* - ValueConverter.Make (fun v -> - basic fmt v) + ValueConverter.Make ( + basic fmt) /// pad here is function that converts T to string with respect of justification /// basic - function that converts T to string without applying justification rules /// adaptPadded returns boxed function that has various number of arguments depending on if width flags has '*' value - let adaptPadded (spec: FormatSpecifier) (basic: obj -> string) (pad: int -> obj -> string) : ValueConverter = + let adaptPadded (spec: FormatSpecifier) (basic: objnull -> string) (pad: int -> objnull -> string) : ValueConverter = if spec.IsStarWidth then // width=*, prec=? ValueConverter.Make (fun v width -> @@ -387,14 +388,14 @@ module internal PrintfImpl = else if spec.IsWidthSpecified then // width=val, prec=* - ValueConverter.Make (fun v -> - pad spec.Width v) + ValueConverter.Make ( + pad spec.Width) else // width=X, prec=* - ValueConverter.Make (fun v -> - basic v) + ValueConverter.Make ( + basic) - let withPaddingFormatted (spec: FormatSpecifier) getFormat (defaultFormat: string) (f: string -> obj -> string) left right : ValueConverter = + let withPaddingFormatted (spec: FormatSpecifier) getFormat (defaultFormat: string) (f: string -> objnull -> string) left right : ValueConverter = if not (spec.IsWidthSpecified || spec.IsPrecisionSpecified) then ValueConverter.Make (f defaultFormat) else @@ -403,7 +404,7 @@ module internal PrintfImpl = else adaptPaddedFormatted spec getFormat f right - let withPadding (spec: FormatSpecifier) (f: obj -> string) left right : ValueConverter = + let withPadding (spec: FormatSpecifier) (f: objnull -> string) left right : ValueConverter = if not spec.IsWidthSpecified then ValueConverter.Make f else @@ -414,11 +415,11 @@ module internal PrintfImpl = /// Contains functions to handle left/right justifications for non-numeric types (strings/bools) module Basic = - let leftJustify (f: obj -> string) padChar = + let leftJustify (f: objnull -> string) padChar = fun (w: int) v -> (f v).PadRight(w, padChar) - let rightJustify (f: obj -> string) padChar = + let rightJustify (f: objnull -> string) padChar = fun (w: int) v -> (f v).PadLeft(w, padChar) @@ -495,16 +496,16 @@ module internal PrintfImpl = else str /// noJustification handler for f: 'T -> string - basic integer types - let noJustification (f: obj -> string) (prefix: string) isUnsigned = + let noJustification (f: objnull -> string) (prefix: string) isUnsigned = if isUnsigned then - fun (v: obj) -> noJustificationCore (f v) true true prefix + fun (v: objnull) -> noJustificationCore (f v) true true prefix else - fun (v: obj) -> noJustificationCore (f v) true (isPositive v) prefix + fun (v: objnull) -> noJustificationCore (f v) true (isPositive v) prefix - /// contains functions to handle left\right and no justification case for numbers + /// contains functions to handle left/right and no justification case for numbers module Integer = - let eliminateNative (v: obj) = + let eliminateNative (v: objnull) = match v with | :? nativeint as n -> if IntPtr.Size = 4 then box (n.ToInt32()) @@ -514,7 +515,7 @@ module internal PrintfImpl = else box (uint64 (n.ToUInt64())) | _ -> v - let rec toString (v: obj) = + let rec toString (v: objnull) = match v with | :? int32 as n -> n.ToString(CultureInfo.InvariantCulture) | :? int64 as n -> n.ToString(CultureInfo.InvariantCulture) @@ -540,7 +541,7 @@ module internal PrintfImpl = | :? nativeint | :? unativeint -> toFormattedString fmt (eliminateNative v) | _ -> failwith "toFormattedString: unreachable" - let rec toUnsigned (v: obj) = + let rec toUnsigned (v: objnull) = match v with | :? int32 as n -> box (uint32 n) | :? int64 as n -> box (uint64 n) @@ -550,35 +551,35 @@ module internal PrintfImpl = | _ -> v /// Left justification handler for f: 'T -> string - basic integer types - let leftJustify isGFormat (f: obj -> string) (prefix: string) padChar isUnsigned = + let leftJustify isGFormat (f: objnull -> string) (prefix: string) padChar isUnsigned = if isUnsigned then if isGFormat then - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.leftJustifyWithGFormat (f v) true true true w prefix padChar else - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.leftJustifyWithNonGFormat (f v) true true w prefix padChar else if isGFormat then - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.leftJustifyWithGFormat (f v) true true (GenericNumber.isPositive v) w prefix padChar else - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.leftJustifyWithNonGFormat (f v) true (GenericNumber.isPositive v) w prefix padChar /// Right justification handler for f: 'T -> string - basic integer types let rightJustify f (prefixForPositives: string) padChar isUnsigned = if isUnsigned then if padChar = '0' then - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.rightJustifyWithZeroAsPadChar (f v) true true w prefixForPositives else System.Diagnostics.Debug.Assert((padChar = ' ')) - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.rightJustifyWithSpaceAsPadChar (f v) true true w prefixForPositives else if padChar = '0' then - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.rightJustifyWithZeroAsPadChar (f v) true (GenericNumber.isPositive v) w prefixForPositives else @@ -589,7 +590,7 @@ module internal PrintfImpl = /// Computes a new function from 'f' that wraps the basic conversion given /// by 'f' with padding for 0, spacing and justification, if the flags specify /// it. If they don't, f is made into a value converter - let withPadding (spec: FormatSpecifier) isUnsigned (f: obj -> string) = + let withPadding (spec: FormatSpecifier) isUnsigned (f: objnull -> string) = let allowZeroPadding = not (isLeftJustify spec.Flags) || spec.IsDecimalFormat let padChar, prefix = spec.GetPadAndPrefix allowZeroPadding Padding.withPadding spec @@ -598,21 +599,27 @@ module internal PrintfImpl = (rightJustify f prefix padChar isUnsigned) let getValueConverter (spec: FormatSpecifier) : ValueConverter = - let c = spec.TypeChar - if c = 'd' || c = 'i' then + match spec.TypeChar with + | 'd' | 'i' -> withPadding spec false toString - elif c = 'u' then + | 'u' -> withPadding spec true (toUnsigned >> toString) - elif c = 'x' then + | 'x' -> withPadding spec true (toFormattedString "x") - elif c = 'X' then + | 'X' -> withPadding spec true (toFormattedString "X") - elif c = 'o' then - withPadding spec true (fun (v: obj) -> + | 'o' -> + withPadding spec true (fun (v: objnull) -> + // Convert.ToInt64 throws for uint64 with values above int64 range so cast directly match toUnsigned v with | :? uint64 as u -> Convert.ToString(int64 u, 8) | u -> Convert.ToString(Convert.ToInt64 u, 8)) - else raise (ArgumentException()) + | 'B' -> + withPadding spec true (fun (v: objnull) -> + match toUnsigned v with + | :? uint64 as u -> Convert.ToString(int64 u, 2) + | u -> Convert.ToString(Convert.ToInt64 u, 2)) + | _ -> invalidArg "spec" "Invalid integer format" module FloatAndDecimal = @@ -674,7 +681,7 @@ module internal PrintfImpl = type ObjectPrinter = static member ObjectToString(spec: FormatSpecifier) : ValueConverter = - Basic.withPadding spec (fun (v: obj) -> + Basic.withPadding spec (fun (v: objnull) -> match v with | null -> "" | x -> x.ToString()) @@ -685,7 +692,7 @@ module internal PrintfImpl = match spec.InteropHoleDotNetFormat with | ValueNone -> null | ValueSome fmt -> "{0:" + fmt + "}" - Basic.withPadding spec (fun (vobj: obj) -> + Basic.withPadding spec (fun (vobj: objnull) -> match vobj with | null -> "" | x -> @@ -693,7 +700,7 @@ module internal PrintfImpl = | null -> x.ToString() | fmt -> String.Format(fmt, x)) - static member GenericToStringCore(v: 'T, opts: FormatOptions, bindingFlags): string = + static member GenericToStringCore(v: 'T, opts: FormatOptions, bindingFlags) = let vty = match box v with | null -> typeof<'T> @@ -717,7 +724,7 @@ module internal PrintfImpl = match spec.IsStarWidth, spec.IsStarPrecision with | true, true -> - ValueConverter.Make (fun (vobj: obj) (width: int) (prec: int) -> + ValueConverter.Make (fun (vobj: objnull) (width: int) (prec: int) -> let v = unbox<'T> vobj let opts = { opts with PrintSize = prec } let opts = if not useZeroWidth then { opts with PrintWidth = width} else opts @@ -725,19 +732,19 @@ module internal PrintfImpl = ) | true, false -> - ValueConverter.Make (fun (vobj: obj) (width: int) -> + ValueConverter.Make (fun (vobj: objnull) (width: int) -> let v = unbox<'T> vobj let opts = if not useZeroWidth then { opts with PrintWidth = width} else opts ObjectPrinter.GenericToStringCore(v, opts, bindingFlags)) | false, true -> - ValueConverter.Make (fun (vobj: obj) (prec: int) -> + ValueConverter.Make (fun (vobj: objnull) (prec: int) -> let v = unbox<'T> vobj let opts = { opts with PrintSize = prec } ObjectPrinter.GenericToStringCore(v, opts, bindingFlags) ) | false, false -> - ValueConverter.Make (fun (vobj: obj) -> + ValueConverter.Make (fun (vobj: objnull) -> let v = unbox<'T> vobj ObjectPrinter.GenericToStringCore(v, opts, bindingFlags)) @@ -745,10 +752,14 @@ module internal PrintfImpl = let defaultFormat = getFormatForFloat spec.TypeChar DefaultPrecision FloatAndDecimal.withPadding spec (getFormatForFloat spec.TypeChar) defaultFormat - let private NonPublicStatics = BindingFlags.NonPublic ||| BindingFlags.Static + let private AllStatics = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static - let mi_GenericToString = typeof.GetMethod("GenericToString", NonPublicStatics) + let mi_GenericToString = typeof.GetMethod("GenericToString", AllStatics) + /// **MasterOfFoo specifics** + /// + /// The code of this function is the code of `getValueConverter` renamed to `getValueConverterCore` as we need a + /// different return type for converters. let private getValueConverterCore (ty: Type) (spec: FormatSpecifier) : ValueConverter = match spec.TypeChar with | 'b' -> @@ -756,10 +767,10 @@ module internal PrintfImpl = | 's' -> Basic.withPadding spec (unbox >> stringToSafeString) | 'c' -> - Basic.withPadding spec (fun (c: obj) -> (unbox c).ToString()) + Basic.withPadding spec (fun (c: objnull) -> (unbox c).ToString()) | 'M' -> FloatAndDecimal.withPadding spec (fun _ -> "G") "G" // %M ignores precision - | 'd' | 'i' | 'x' | 'X' | 'u' | 'o'-> + | 'd' | 'i' | 'u' | 'B' | 'o' | 'x' | 'X' -> Integer.getValueConverter spec | 'e' | 'E' | 'f' | 'F' @@ -775,6 +786,10 @@ module internal PrintfImpl = | _ -> raise (ArgumentException(sprintf "Bad format specifier: %c" spec.TypeChar)) + /// **MasterOfFoo specifics** + /// + /// This type is equivalent to the `ValueConverter` type from the F# source code but with `PrintableElement` as + /// the final result instead of `string`. [] type PrintableValueConverter private (f: obj) = member x.FuncObj = f @@ -783,6 +798,11 @@ module internal PrintfImpl = static member inline Make<'t> (f: obj -> int -> PrintableElement) = PrintableValueConverter(box f) static member inline Make<'t> (f: obj -> int-> int -> PrintableElement) = PrintableValueConverter(box f) + /// **MasterOfFoo specifics** + /// + /// As our converters need to return a `PrintableElement` instead of a `string`, we need to adapt the + /// `getValueConverter` by guessing how many arguments the function will take (Depending on if star width and/or + /// star precision are used), generate the correct function and box it. let getValueConverter (ty : Type) (spec : FormatSpecifier) : PrintableValueConverter = let et = PrintableElementType.FromFormatSpecifier let realUntyped = getValueConverterCore ty spec @@ -828,8 +848,8 @@ module internal PrintfImpl = [] type FormatParser<'Printer, 'State, 'Residue, 'Result>(fmt: string) = - let buildCaptureFunc (spec: FormatSpecifier, allSteps, argTys: Type[], retTy, nextInfo) = - let (next:obj, nextCanCombine: bool, nextArgTys: Type[], nextRetTy, nextNextOpt) = nextInfo + let buildCaptureFunc (spec: FormatSpecifier, allSteps, argTys: Type array, retTy, nextInfo) = + let (next:obj, nextCanCombine: bool, nextArgTys: Type array, nextRetTy, nextNextOpt) = nextInfo assert (argTys.Length > 0) // See if we can compress a capture to a multi-capture @@ -842,7 +862,7 @@ module internal PrintfImpl = // %a has an existential type which must be converted to obj assert (argTys.Length = 2) let captureMethName = "CaptureLittleA" - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod([| argTys.[1]; retTy |]) let factoryObj = mi.Invoke(null, [| next |]) factoryObj, false, argTys, retTy, None @@ -854,25 +874,25 @@ module internal PrintfImpl = match nextNextOpt with | None -> let captureMethName = "CaptureFinal" + string captureCount - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(combinedArgTys) let factoryObj = mi.Invoke(null, [| allSteps |]) factoryObj, true, combinedArgTys, nextRetTy, None | Some nextNext -> let captureMethName = "Capture" + string captureCount - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(Array.append combinedArgTys [| nextRetTy |]) let factoryObj = mi.Invoke(null, [| nextNext |]) factoryObj, true, combinedArgTys, nextRetTy, nextNextOpt | captureCount, _ -> let captureMethName = "Capture" + string captureCount - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(Array.append argTys [| retTy |]) let factoryObj = mi.Invoke(null, [| next |]) factoryObj, true, argTys, retTy, Some next - let buildStep (spec: FormatSpecifier) (argTys: Type[]) prefix = + let buildStep (spec: FormatSpecifier) (argTys: Type array) prefix = if spec.TypeChar = 'a' then StepLittleA prefix elif spec.TypeChar = 't' then @@ -888,10 +908,10 @@ module internal PrintfImpl = let argTy = match argTys with null -> typeof | _ -> argTys.[argTys.Length - 1] let conv = getValueConverter argTy spec if isTwoStar then - let convFunc = conv.FuncObj :?> (obj -> int -> int -> PrintableElement) + let convFunc = conv.FuncObj :?> (objnull -> int -> int -> PrintableElement) StepStar2 (prefix, convFunc) else - let convFunc = conv.FuncObj :?> (obj -> int -> PrintableElement) + let convFunc = conv.FuncObj :?> (objnull -> int -> PrintableElement) StepStar1 (prefix, convFunc) else // For interpolated string format processing, the static types of the '%A' arguments @@ -901,8 +921,7 @@ module internal PrintfImpl = let convFunc arg argTy = let mi = mi_GenericToString.MakeGenericMethod [| argTy |] let f = mi.Invoke(null, [| box spec |]) :?> ValueConverter - let f2 = f.FuncObj :?> (obj -> string) - + let f2 = f.FuncObj :?> (objnull -> string) let printer = fun () -> f2 arg PrintableElement( printer, @@ -919,7 +938,7 @@ module internal PrintfImpl = // are provided via the argument typed extracted from the curried function. They are known on first phase. let argTy = match argTys with null -> typeof | _ -> argTys.[0] let conv = getValueConverter argTy spec - let convFunc = conv.FuncObj :?> (obj -> PrintableElement) + let convFunc = conv.FuncObj :?> (objnull -> PrintableElement) StepWithArg (prefix, convFunc) let parseSpec (i: byref) = @@ -1018,13 +1037,13 @@ module internal PrintfImpl = PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun _args initial -> let env = initial() env.WriteSkipEmpty prefix - env.Finalize() + env.Finish() ) |> box // If there is one simple format specifier then we can create an even better factory function | [| StepWithArg (prefix1, conv1); StepString prefix2 |] -> let captureMethName = "OneStepWithArg" - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(combinedArgTys) let factoryObj = mi.Invoke(null, [| box prefix1; box conv1; box prefix2 |]) factoryObj @@ -1032,7 +1051,7 @@ module internal PrintfImpl = // If there are two simple format specifiers then we can create an even better factory function | [| StepWithArg (prefix1, conv1); StepWithArg (prefix2, conv2); StepString prefix3 |] -> let captureMethName = "TwoStepWithArg" - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(combinedArgTys) let factoryObj = mi.Invoke(null, [| box prefix1; box conv1; box prefix2; box conv2; box prefix3 |]) factoryObj diff --git a/src/BlackFox.MasterOfFoo/printf_original.fs b/src/BlackFox.MasterOfFoo/printf_original.fs index 524471a..f0fc5a1 100644 --- a/src/BlackFox.MasterOfFoo/printf_original.fs +++ b/src/BlackFox.MasterOfFoo/printf_original.fs @@ -7,6 +7,7 @@ open System.IO open System.Text open System.Collections.Concurrent +open System.Diagnostics open System.Globalization open System.Reflection @@ -16,8 +17,11 @@ open Microsoft.FSharp.Collections open LanguagePrimitives.IntrinsicOperators -type PrintfFormat<'Printer, 'State, 'Residue, 'Result>(value:string, captures: obj[], captureTys: Type[]) = +type PrintfFormat<'Printer, 'State, 'Residue, 'Result> + [] + (value:string, captures: objnull array, captureTys: Type array) = + [] new (value) = new PrintfFormat<'Printer, 'State, 'Residue, 'Result>(value, null, null) member _.Value = value @@ -28,10 +32,13 @@ type PrintfFormat<'Printer, 'State, 'Residue, 'Result>(value:string, captures: o override _.ToString() = value -type PrintfFormat<'Printer, 'State, 'Residue, 'Result, 'Tuple>(value:string, captures, captureTys: Type[]) = +type PrintfFormat<'Printer, 'State, 'Residue, 'Result, 'Tuple> + [] + (value:string, captures, captureTys: Type array) = inherit PrintfFormat<'Printer, 'State, 'Residue, 'Result>(value, captures, captureTys) + [] new (value) = new PrintfFormat<'Printer, 'State, 'Residue, 'Result, 'Tuple>(value, null, null) type Format<'Printer, 'State, 'Residue, 'Result> = PrintfFormat<'Printer, 'State, 'Residue, 'Result> @@ -239,7 +246,7 @@ module internal PrintfImpl = let p = parsePrecision s &i2 let typeChar = parseTypeChar s &i2 - // shortcut for the simpliest case + // shortcut for the simplest case // if typeChar is not % or it has star as width\precision - resort to long path if typeChar = '%' && not (w = StarValue || p = StarValue) then buf.Append('%') |> ignore @@ -253,21 +260,21 @@ module internal PrintfImpl = i <- i + 1 buf.ToString() - [] /// Represents one step in the execution of a format string + [] type Step = - | StepWithArg of prefix: string * conv: (obj -> string) - | StepWithTypedArg of prefix: string * conv: (obj -> Type -> string) + | StepWithArg of prefix: string * conv: (objnull -> string) + | StepWithTypedArg of prefix: string * conv: (objnull -> Type -> string) | StepString of prefix: string | StepLittleT of prefix: string | StepLittleA of prefix: string - | StepStar1 of prefix: string * conv: (obj -> int -> string) + | StepStar1 of prefix: string * conv: (objnull -> int -> string) | StepPercentStar1 of prefix: string - | StepStar2 of prefix: string * conv: (obj -> int -> int -> string) + | StepStar2 of prefix: string * conv: (objnull -> int -> int -> string) | StepPercentStar2 of prefix: string // Count the number of string fragments in a sequence of steps - static member BlockCount(steps: Step[]) = + static member BlockCount(steps: Step array) = let mutable count = 0 for step in steps do match step with @@ -316,7 +323,7 @@ module internal PrintfImpl = if not (String.IsNullOrEmpty s) then env.Write s - member env.RunSteps (args: obj[], argTys: Type[], steps: Step[]) = + member env.RunSteps (args: objnull array, argTys: Type array, steps: Step array) = let mutable argIndex = 0 let mutable tyIndex = 0 @@ -352,7 +359,7 @@ module internal PrintfImpl = argIndex <- argIndex + 1 let arg = args.[argIndex] argIndex <- argIndex + 1 - let f = farg :?> ('State -> obj -> 'Residue) + let f = farg :?> ('State -> objnull -> 'Residue) env.WriteT(f env.State arg) | StepStar1(prefix, conv) -> @@ -388,7 +395,7 @@ module internal PrintfImpl = /// Type of results produced by specialization. /// /// This is a function that accepts a thunk to create PrintfEnv on demand (at the very last - /// appliction of an argument) and returns a concrete instance of an appriate curried printer. + /// application of an argument) and returns a concrete instance of an appropriate curried printer. /// /// After all arguments are collected, specialization obtains concrete PrintfEnv from the thunk /// and uses it to output collected data. @@ -403,7 +410,7 @@ module internal PrintfImpl = /// If we captured into an mutable array then these would interfere type PrintfInitial<'State, 'Residue, 'Result> = (unit -> PrintfEnv<'State, 'Residue, 'Result>) type PrintfFuncFactory<'Printer, 'State, 'Residue, 'Result> = - delegate of obj list * PrintfInitial<'State, 'Residue, 'Result> -> 'Printer + delegate of objnull list * PrintfInitial<'State, 'Residue, 'Result> -> 'Printer [] let MaxArgumentsInSpecialization = 3 @@ -470,7 +477,7 @@ module internal PrintfImpl = static member CaptureLittleA<'A, 'Tail>(next: PrintfFuncFactory<_, 'State, 'Residue, 'Result>) = PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial -> (fun (f: 'State -> 'A -> 'Residue) (arg1: 'A) -> - let args = box arg1 :: box (fun s (arg:obj) -> f s (unbox arg)) :: args + let args = box arg1 :: box (fun s (arg:objnull) -> f s (unbox arg)) :: args next.Invoke(args, initial) : 'Tail ) ) @@ -539,12 +546,12 @@ module internal PrintfImpl = /// A wrapper struct used to slightly strengthen the types of "ValueConverter" objects produced during composition of /// the dynamic implementation. These are always functions but sometimes they take one argument, sometimes two. [] - type ValueConverter private (f: obj) = + type ValueConverter internal (f: objnull) = member x.FuncObj = f - static member inline Make (f: obj -> string) = ValueConverter(box f) - static member inline Make (f: obj -> int -> string) = ValueConverter(box f) - static member inline Make (f: obj -> int-> int -> string) = ValueConverter(box f) + static member inline Make (f: objnull -> string) = ValueConverter(box f) + static member inline Make (f: objnull -> int -> string) = ValueConverter(box f) + static member inline Make (f: objnull -> int-> int -> string) = ValueConverter(box f) let getFormatForFloat (ch: char) (prec: int) = ch.ToString() + prec.ToString() @@ -562,7 +569,7 @@ module internal PrintfImpl = /// pad here is function that converts T to string with respect of justification /// basic - function that converts T to string without applying justification rules /// adaptPaddedFormatted returns boxed function that has various number of arguments depending on if width\precision flags has '*' value - let adaptPaddedFormatted (spec: FormatSpecifier) getFormat (basic: string -> obj -> string) (pad: string -> int -> obj -> string) : ValueConverter = + let adaptPaddedFormatted (spec: FormatSpecifier) getFormat (basic: string -> objnull -> string) (pad: string -> int -> objnull -> string) : ValueConverter = if spec.IsStarWidth then if spec.IsStarPrecision then // width=*, prec=* @@ -592,17 +599,17 @@ module internal PrintfImpl = let fmt = getFormat prec if spec.IsWidthSpecified then // width=val, prec=* - ValueConverter.Make (fun v -> - pad fmt spec.Width v) + ValueConverter.Make ( + pad fmt spec.Width) else // width=X, prec=* - ValueConverter.Make (fun v -> - basic fmt v) + ValueConverter.Make ( + basic fmt) /// pad here is function that converts T to string with respect of justification /// basic - function that converts T to string without applying justification rules /// adaptPadded returns boxed function that has various number of arguments depending on if width flags has '*' value - let adaptPadded (spec: FormatSpecifier) (basic: obj -> string) (pad: int -> obj -> string) : ValueConverter = + let adaptPadded (spec: FormatSpecifier) (basic: objnull -> string) (pad: int -> objnull -> string) : ValueConverter = if spec.IsStarWidth then // width=*, prec=? ValueConverter.Make (fun v width -> @@ -610,14 +617,14 @@ module internal PrintfImpl = else if spec.IsWidthSpecified then // width=val, prec=* - ValueConverter.Make (fun v -> - pad spec.Width v) + ValueConverter.Make ( + pad spec.Width) else // width=X, prec=* - ValueConverter.Make (fun v -> - basic v) + ValueConverter.Make ( + basic) - let withPaddingFormatted (spec: FormatSpecifier) getFormat (defaultFormat: string) (f: string -> obj -> string) left right : ValueConverter = + let withPaddingFormatted (spec: FormatSpecifier) getFormat (defaultFormat: string) (f: string -> objnull -> string) left right : ValueConverter = if not (spec.IsWidthSpecified || spec.IsPrecisionSpecified) then ValueConverter.Make (f defaultFormat) else @@ -626,7 +633,7 @@ module internal PrintfImpl = else adaptPaddedFormatted spec getFormat f right - let withPadding (spec: FormatSpecifier) (f: obj -> string) left right : ValueConverter = + let withPadding (spec: FormatSpecifier) (f: objnull -> string) left right : ValueConverter = if not spec.IsWidthSpecified then ValueConverter.Make f else @@ -637,11 +644,11 @@ module internal PrintfImpl = /// Contains functions to handle left/right justifications for non-numeric types (strings/bools) module Basic = - let leftJustify (f: obj -> string) padChar = + let leftJustify (f: objnull -> string) padChar = fun (w: int) v -> (f v).PadRight(w, padChar) - let rightJustify (f: obj -> string) padChar = + let rightJustify (f: objnull -> string) padChar = fun (w: int) v -> (f v).PadLeft(w, padChar) @@ -718,16 +725,16 @@ module internal PrintfImpl = else str /// noJustification handler for f: 'T -> string - basic integer types - let noJustification (f: obj -> string) (prefix: string) isUnsigned = + let noJustification (f: objnull -> string) (prefix: string) isUnsigned = if isUnsigned then - fun (v: obj) -> noJustificationCore (f v) true true prefix + fun (v: objnull) -> noJustificationCore (f v) true true prefix else - fun (v: obj) -> noJustificationCore (f v) true (isPositive v) prefix + fun (v: objnull) -> noJustificationCore (f v) true (isPositive v) prefix - /// contains functions to handle left\right and no justification case for numbers + /// contains functions to handle left/right and no justification case for numbers module Integer = - let eliminateNative (v: obj) = + let eliminateNative (v: objnull) = match v with | :? nativeint as n -> if IntPtr.Size = 4 then box (n.ToInt32()) @@ -737,7 +744,7 @@ module internal PrintfImpl = else box (uint64 (n.ToUInt64())) | _ -> v - let rec toString (v: obj) = + let rec toString (v: objnull) = match v with | :? int32 as n -> n.ToString(CultureInfo.InvariantCulture) | :? int64 as n -> n.ToString(CultureInfo.InvariantCulture) @@ -763,7 +770,7 @@ module internal PrintfImpl = | :? nativeint | :? unativeint -> toFormattedString fmt (eliminateNative v) | _ -> failwith "toFormattedString: unreachable" - let rec toUnsigned (v: obj) = + let rec toUnsigned (v: objnull) = match v with | :? int32 as n -> box (uint32 n) | :? int64 as n -> box (uint64 n) @@ -773,35 +780,35 @@ module internal PrintfImpl = | _ -> v /// Left justification handler for f: 'T -> string - basic integer types - let leftJustify isGFormat (f: obj -> string) (prefix: string) padChar isUnsigned = + let leftJustify isGFormat (f: objnull -> string) (prefix: string) padChar isUnsigned = if isUnsigned then if isGFormat then - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.leftJustifyWithGFormat (f v) true true true w prefix padChar else - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.leftJustifyWithNonGFormat (f v) true true w prefix padChar else if isGFormat then - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.leftJustifyWithGFormat (f v) true true (GenericNumber.isPositive v) w prefix padChar else - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.leftJustifyWithNonGFormat (f v) true (GenericNumber.isPositive v) w prefix padChar /// Right justification handler for f: 'T -> string - basic integer types let rightJustify f (prefixForPositives: string) padChar isUnsigned = if isUnsigned then if padChar = '0' then - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.rightJustifyWithZeroAsPadChar (f v) true true w prefixForPositives else System.Diagnostics.Debug.Assert((padChar = ' ')) - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.rightJustifyWithSpaceAsPadChar (f v) true true w prefixForPositives else if padChar = '0' then - fun (w: int) (v: obj) -> + fun (w: int) (v: objnull) -> GenericNumber.rightJustifyWithZeroAsPadChar (f v) true (GenericNumber.isPositive v) w prefixForPositives else @@ -812,7 +819,7 @@ module internal PrintfImpl = /// Computes a new function from 'f' that wraps the basic conversion given /// by 'f' with padding for 0, spacing and justification, if the flags specify /// it. If they don't, f is made into a value converter - let withPadding (spec: FormatSpecifier) isUnsigned (f: obj -> string) = + let withPadding (spec: FormatSpecifier) isUnsigned (f: objnull -> string) = let allowZeroPadding = not (isLeftJustify spec.Flags) || spec.IsDecimalFormat let padChar, prefix = spec.GetPadAndPrefix allowZeroPadding Padding.withPadding spec @@ -821,21 +828,27 @@ module internal PrintfImpl = (rightJustify f prefix padChar isUnsigned) let getValueConverter (spec: FormatSpecifier) : ValueConverter = - let c = spec.TypeChar - if c = 'd' || c = 'i' then + match spec.TypeChar with + | 'd' | 'i' -> withPadding spec false toString - elif c = 'u' then + | 'u' -> withPadding spec true (toUnsigned >> toString) - elif c = 'x' then + | 'x' -> withPadding spec true (toFormattedString "x") - elif c = 'X' then + | 'X' -> withPadding spec true (toFormattedString "X") - elif c = 'o' then - withPadding spec true (fun (v: obj) -> + | 'o' -> + withPadding spec true (fun (v: objnull) -> + // Convert.ToInt64 throws for uint64 with values above int64 range so cast directly match toUnsigned v with | :? uint64 as u -> Convert.ToString(int64 u, 8) | u -> Convert.ToString(Convert.ToInt64 u, 8)) - else raise (ArgumentException()) + | 'B' -> + withPadding spec true (fun (v: objnull) -> + match toUnsigned v with + | :? uint64 as u -> Convert.ToString(int64 u, 2) + | u -> Convert.ToString(Convert.ToInt64 u, 2)) + | _ -> invalidArg (nameof spec) "Invalid integer format" module FloatAndDecimal = @@ -897,7 +910,7 @@ module internal PrintfImpl = type ObjectPrinter = static member ObjectToString(spec: FormatSpecifier) : ValueConverter = - Basic.withPadding spec (fun (v: obj) -> + Basic.withPadding spec (fun (v: objnull) -> match v with | null -> "" | x -> x.ToString()) @@ -908,7 +921,7 @@ module internal PrintfImpl = match spec.InteropHoleDotNetFormat with | ValueNone -> null | ValueSome fmt -> "{0:" + fmt + "}" - Basic.withPadding spec (fun (vobj: obj) -> + Basic.withPadding spec (fun (vobj: objnull) -> match vobj with | null -> "" | x -> @@ -940,7 +953,7 @@ module internal PrintfImpl = match spec.IsStarWidth, spec.IsStarPrecision with | true, true -> - ValueConverter.Make (fun (vobj: obj) (width: int) (prec: int) -> + ValueConverter.Make (fun (vobj: objnull) (width: int) (prec: int) -> let v = unbox<'T> vobj let opts = { opts with PrintSize = prec } let opts = if not useZeroWidth then { opts with PrintWidth = width} else opts @@ -948,19 +961,19 @@ module internal PrintfImpl = ) | true, false -> - ValueConverter.Make (fun (vobj: obj) (width: int) -> + ValueConverter.Make (fun (vobj: objnull) (width: int) -> let v = unbox<'T> vobj let opts = if not useZeroWidth then { opts with PrintWidth = width} else opts ObjectPrinter.GenericToStringCore(v, opts, bindingFlags)) | false, true -> - ValueConverter.Make (fun (vobj: obj) (prec: int) -> + ValueConverter.Make (fun (vobj: objnull) (prec: int) -> let v = unbox<'T> vobj let opts = { opts with PrintSize = prec } ObjectPrinter.GenericToStringCore(v, opts, bindingFlags) ) | false, false -> - ValueConverter.Make (fun (vobj: obj) -> + ValueConverter.Make (fun (vobj: objnull) -> let v = unbox<'T> vobj ObjectPrinter.GenericToStringCore(v, opts, bindingFlags)) @@ -968,9 +981,9 @@ module internal PrintfImpl = let defaultFormat = getFormatForFloat spec.TypeChar DefaultPrecision FloatAndDecimal.withPadding spec (getFormatForFloat spec.TypeChar) defaultFormat - let private NonPublicStatics = BindingFlags.NonPublic ||| BindingFlags.Static + let private AllStatics = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static - let mi_GenericToString = typeof.GetMethod("GenericToString", NonPublicStatics) + let mi_GenericToString = typeof.GetMethod("GenericToString", AllStatics) let private getValueConverter (ty: Type) (spec: FormatSpecifier) : ValueConverter = match spec.TypeChar with @@ -979,10 +992,10 @@ module internal PrintfImpl = | 's' -> Basic.withPadding spec (unbox >> stringToSafeString) | 'c' -> - Basic.withPadding spec (fun (c: obj) -> (unbox c).ToString()) + Basic.withPadding spec (fun (c: objnull) -> (unbox c).ToString()) | 'M' -> FloatAndDecimal.withPadding spec (fun _ -> "G") "G" // %M ignores precision - | 'd' | 'i' | 'x' | 'X' | 'u' | 'o'-> + | 'd' | 'i' | 'u' | 'B' | 'o' | 'x' | 'X' -> Integer.getValueConverter spec | 'e' | 'E' | 'f' | 'F' @@ -1016,7 +1029,7 @@ module internal PrintfImpl = type LargeStringPrintfEnv<'Result>(continuation, blockSize) = inherit PrintfEnv(()) - let buf: string[] = Array.zeroCreate blockSize + let buf: string array = Array.zeroCreate blockSize let mutable ptr = 0 override _.Finish() : 'Result = continuation (String.Concat buf) @@ -1076,8 +1089,8 @@ module internal PrintfImpl = [] type FormatParser<'Printer, 'State, 'Residue, 'Result>(fmt: string) = - let buildCaptureFunc (spec: FormatSpecifier, allSteps, argTys: Type[], retTy, nextInfo) = - let (next:obj, nextCanCombine: bool, nextArgTys: Type[], nextRetTy, nextNextOpt) = nextInfo + let buildCaptureFunc (spec: FormatSpecifier, allSteps, argTys: Type array, retTy, nextInfo) = + let (next:obj, nextCanCombine: bool, nextArgTys: Type array, nextRetTy, nextNextOpt) = nextInfo assert (argTys.Length > 0) // See if we can compress a capture to a multi-capture @@ -1090,7 +1103,7 @@ module internal PrintfImpl = // %a has an existential type which must be converted to obj assert (argTys.Length = 2) let captureMethName = "CaptureLittleA" - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod([| argTys.[1]; retTy |]) let factoryObj = mi.Invoke(null, [| next |]) factoryObj, false, argTys, retTy, None @@ -1102,25 +1115,25 @@ module internal PrintfImpl = match nextNextOpt with | None -> let captureMethName = "CaptureFinal" + string captureCount - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(combinedArgTys) let factoryObj = mi.Invoke(null, [| allSteps |]) factoryObj, true, combinedArgTys, nextRetTy, None | Some nextNext -> let captureMethName = "Capture" + string captureCount - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(Array.append combinedArgTys [| nextRetTy |]) let factoryObj = mi.Invoke(null, [| nextNext |]) factoryObj, true, combinedArgTys, nextRetTy, nextNextOpt | captureCount, _ -> let captureMethName = "Capture" + string captureCount - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(Array.append argTys [| retTy |]) let factoryObj = mi.Invoke(null, [| next |]) factoryObj, true, argTys, retTy, Some next - let buildStep (spec: FormatSpecifier) (argTys: Type[]) prefix = + let buildStep (spec: FormatSpecifier) (argTys: Type array) prefix = if spec.TypeChar = 'a' then StepLittleA prefix elif spec.TypeChar = 't' then @@ -1136,10 +1149,10 @@ module internal PrintfImpl = let argTy = match argTys with null -> typeof | _ -> argTys.[argTys.Length - 1] let conv = getValueConverter argTy spec if isTwoStar then - let convFunc = conv.FuncObj :?> (obj -> int -> int -> string) + let convFunc = conv.FuncObj :?> (objnull -> int -> int -> string) StepStar2 (prefix, convFunc) else - let convFunc = conv.FuncObj :?> (obj -> int -> string) + let convFunc = conv.FuncObj :?> (objnull -> int -> string) StepStar1 (prefix, convFunc) else // For interpolated string format processing, the static types of the '%A' arguments @@ -1149,7 +1162,7 @@ module internal PrintfImpl = let convFunc arg argTy = let mi = mi_GenericToString.MakeGenericMethod [| argTy |] let f = mi.Invoke(null, [| box spec |]) :?> ValueConverter - let f2 = f.FuncObj :?> (obj -> string) + let f2 = f.FuncObj :?> (objnull -> string) f2 arg StepWithTypedArg (prefix, convFunc) @@ -1159,7 +1172,7 @@ module internal PrintfImpl = // are provided via the argument typed extracted from the curried function. They are known on first phase. let argTy = match argTys with null -> typeof | _ -> argTys.[0] let conv = getValueConverter argTy spec - let convFunc = conv.FuncObj :?> (obj -> string) + let convFunc = conv.FuncObj :?> (objnull -> string) StepWithArg (prefix, convFunc) let parseSpec (i: byref) = @@ -1264,7 +1277,7 @@ module internal PrintfImpl = // If there is one simple format specifier then we can create an even better factory function | [| StepWithArg (prefix1, conv1); StepString prefix2 |] -> let captureMethName = "OneStepWithArg" - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(combinedArgTys) let factoryObj = mi.Invoke(null, [| box prefix1; box conv1; box prefix2 |]) factoryObj @@ -1272,7 +1285,7 @@ module internal PrintfImpl = // If there are two simple format specifiers then we can create an even better factory function | [| StepWithArg (prefix1, conv1); StepWithArg (prefix2, conv2); StepString prefix3 |] -> let captureMethName = "TwoStepWithArg" - let mi = typeof>.GetMethod(captureMethName, NonPublicStatics) + let mi = typeof>.GetMethod(captureMethName, AllStatics) let mi = mi.MakeGenericMethod(combinedArgTys) let factoryObj = mi.Invoke(null, [| box prefix1; box conv1; box prefix2; box conv2; box prefix3 |]) factoryObj @@ -1390,6 +1403,8 @@ module Printf = let ksprintf continuation (format: StringFormat<'T, 'Result>) : 'T = gprintf (fun stringCount -> LargeStringPrintfEnv(continuation, stringCount)) format + // Note: this compiled name is wrong - it should be PrintFormatToString + // however for binary compat we do not change this. [] let sprintf (format: StringFormat<'T>) = // We inline gprintf by hand here to be sure to remove a few allocations diff --git a/src/BlackFox.MasterOfFoo/sformat_original.fs b/src/BlackFox.MasterOfFoo/sformat_original.fs index bceec36..9f1b724 100644 --- a/src/BlackFox.MasterOfFoo/sformat_original.fs +++ b/src/BlackFox.MasterOfFoo/sformat_original.fs @@ -7,9 +7,6 @@ // 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. - -#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation - #if COMPILER namespace FSharp.Compiler.Text #else @@ -17,8 +14,14 @@ namespace FSharp.Compiler.Text namespace Microsoft.FSharp.Text.StructuredPrintfImpl #endif +#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation +// 3261 and 3262 Nullness warnings - this waits for LKG update, since this file is included in fsharp.core and fsharp.compiler.service and goes via proto build. +// Supporting all possible combinations of available library+compiler versions would complicate code in this source files too much at the moment. +#nowarn "3261" +#nowarn "3262" + // Breakable block layout implementation. -// This is a fresh implementation of pre-existing ideas. +// This is a fresh implementation of preexisting ideas. open System open System.IO @@ -29,6 +32,9 @@ open Microsoft.FSharp.Core open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Reflection open Microsoft.FSharp.Collections +#if COMPILER +open Internal.Utilities.Library +#endif [] type TextTag = @@ -89,26 +95,26 @@ type Joint = [] type Layout = | ObjLeaf of juxtLeft: bool * object: obj * juxtRight: bool - | Leaf of juxtLeft: bool * text: TaggedText * justRight: bool + | Leaf of juxtLeft: bool * text: TaggedText * juxtRight: bool | 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 + | ObjLeaf(jl, _, _) -> jl + | Leaf(jl, _, _) -> jl + | Node(left, _, _) -> left.JuxtapositionLeft + | Attr(_, _, subLayout) -> subLayout.JuxtapositionLeft - static member JuxtapositionMiddle (left: Layout, right: Layout) = + 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 + | ObjLeaf(_, _, jr) -> jr + | Leaf(_, _, jr) -> jr + | Node(_, right, _) -> right.JuxtapositionRight + | Attr(_, _, subLayout) -> subLayout.JuxtapositionRight [] type IEnvironment = @@ -116,10 +122,16 @@ type IEnvironment = abstract MaxColumns: int abstract MaxRows: int +#if NO_CHECKNULLS +[] +module NullShim = + // Shim to match nullness checking library support in preview + let inline (|Null|NonNull|) (x: 'T) : Choice = match x with null -> Null | v -> NonNull v +#endif + [] module TaggedText = let mkTag tag text = TaggedText(tag, text) - let length (tt: TaggedText) = tt.Text.Length let toText (tt: TaggedText) = tt.Text let tagClass name = mkTag TextTag.Class name @@ -135,8 +147,6 @@ module TaggedText = let tagMethod t = mkTag TextTag.Method t let tagPunctuation t = mkTag TextTag.Punctuation t let tagOperator t = mkTag TextTag.Operator t - let tagSpace t = mkTag TextTag.Space t - let leftParen = tagPunctuation "(" let rightParen = tagPunctuation ")" let comma = tagPunctuation "," @@ -144,13 +154,13 @@ module TaggedText = let questionMark = tagPunctuation "?" let leftBracket = tagPunctuation "[" let rightBracket = tagPunctuation "]" - let leftBrace= tagPunctuation "{" + let leftBrace = tagPunctuation "{" let rightBrace = tagPunctuation "}" - let space = tagSpace " " let equals = tagOperator "=" #if COMPILER let tagAlias t = mkTag TextTag.Alias t + let keywordFunctions = [ "raise" @@ -182,6 +192,7 @@ module TaggedText = "unativeint" ] |> Set.ofList + let tagDelegate t = mkTag TextTag.Delegate t let tagEnum t = mkTag TextTag.Enum t let tagEvent t = mkTag TextTag.Event t @@ -189,10 +200,17 @@ module TaggedText = let tagLineBreak t = mkTag TextTag.LineBreak t let tagRecord t = mkTag TextTag.Record t let tagModule t = mkTag TextTag.Module t - let tagModuleBinding name = if keywordFunctions.Contains name then mkTag TextTag.Keyword name else mkTag TextTag.ModuleBinding name + + let tagModuleBinding name = + if keywordFunctions.Contains name then + mkTag TextTag.Keyword name + else + mkTag TextTag.ModuleBinding name + let tagFunction t = mkTag TextTag.Function t let tagNamespace t = mkTag TextTag.Namespace t let tagParameter t = mkTag TextTag.Parameter t + let tagSpace t = mkTag TextTag.Space t let tagStruct t = mkTag TextTag.Struct t let tagTypeParameter t = mkTag TextTag.TypeParameter t let tagActivePatternCase t = mkTag TextTag.ActivePatternCase t @@ -204,6 +222,7 @@ module TaggedText = // common tagged literals let lineBreak = tagLineBreak "\n" + let space = tagSpace " " let leftBraceBar = tagPunctuation "{|" let rightBraceBar = tagPunctuation "|}" let arrow = tagPunctuation "->" @@ -224,8 +243,11 @@ module TaggedText = let keywordGet = tagKeyword "get" let bar = tagPunctuation "|" let keywordStruct = tagKeyword "struct" + let keywordClass = tagKeyword "class" + let keywordInterface = tagKeyword "interface" let keywordInherit = tagKeyword "inherit" let keywordEnd = tagKeyword "end" + let keywordBegin = tagKeyword "begin" let keywordNested = tagKeyword "nested" let keywordType = tagKeyword "type" let keywordDelegate = tagKeyword "delegate" @@ -235,7 +257,7 @@ module TaggedText = let keywordAbstract = tagKeyword "abstract" let keywordOverride = tagKeyword "override" let keywordEnum = tagKeyword "enum" - let leftBracketBar = tagPunctuation "[|" + let leftBracketBar = tagPunctuation "[|" let rightBracketBar = tagPunctuation "|]" let keywordTypeof = tagKeyword "typeof" let keywordTypedefof = tagKeyword "typedefof" @@ -243,36 +265,50 @@ module TaggedText = let rightBracketAngle = tagPunctuation ">]" let star = tagOperator "*" let keywordNew = tagKeyword "new" + let keywordInline = tagKeyword "inline" + let keywordModule = tagKeyword "module" + let keywordNamespace = tagKeyword "namespace" + let keywordReturn = tagKeyword "return" + let punctuationUnit = tagPunctuation "()" #endif [] module Layout = // constructors - let objL (value:obj) = + let objL (value: obj) = match value with - | :? string as s -> Leaf (false, mkTag TextTag.Text s, false) - | o -> ObjLeaf (false, o, false) + | :? string as s -> Leaf(false, mkTag TextTag.Text s, false) + | o -> ObjLeaf(false, o, false) - let wordL text = Leaf (false, text, false) + let wordL text = Leaf(false, text, false) - let sepL text = Leaf (true , text, true) + let sepL text = Leaf(true, text, true) - let rightL text = Leaf (true , text, false) + let rightL text = Leaf(true, text, false) - let leftL text = Leaf (false, text, true) + let leftL text = Leaf(false, text, true) - let emptyL = Leaf (true, mkTag TextTag.Text "", true) + let emptyL = Leaf(true, mkTag TextTag.Text "", true) let isEmptyL layout = match layout with - | Leaf(true, s, true) -> s.Text = "" + | Leaf(true, s, true) -> String.IsNullOrEmpty(s.Text) | _ -> false +#if COMPILER + let rec endsWithL (text: string) layout = + match layout with + | Leaf(_, s, _) -> s.Text.EndsWith(text, StringComparison.Ordinal) + | Node(_, r, _) -> endsWithL text r + | Attr(_, _, l) -> endsWithL text l + | ObjLeaf _ -> false +#endif + let mkNode l r joint = - if isEmptyL l then r else - if isEmptyL r then l else - Node(l, r, joint) + if isEmptyL l then r + else if isEmptyL r then l + else Node(l, r, joint) let aboveL layout1 layout2 = mkNode layout1 layout2 (Broken 0) @@ -283,56 +319,67 @@ module Layout = 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 3) + let (----) layout1 layout2 = mkNode layout1 layout2 (Breakable 3) let (-----) layout1 layout2 = mkNode layout1 layout2 (Breakable 4) - 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 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 1)) layout1 layout2 - let (@@--) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 2)) layout1 layout2 + let (@@--) layout1 layout2 = + apply2 (fun l r -> mkNode l r (Broken 2)) layout1 layout2 - let (@@---) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 3)) layout1 layout2 + let (@@---) layout1 layout2 = + apply2 (fun l r -> mkNode l r (Broken 3)) layout1 layout2 - let (@@----) layout1 layout2 = apply2 (fun l r -> mkNode l r (Broken 4)) layout1 layout2 + let (@@----) layout1 layout2 = + apply2 (fun l r -> mkNode l r (Broken 4)) layout1 layout2 let tagListL tagger els = match els with | [] -> emptyL - | [x] -> x + | [ 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 comma) layouts + let commaListL layouts = + tagListL (fun prefixL -> prefixL ^^ rightL comma) layouts - let semiListL layouts = tagListL (fun prefixL -> prefixL ^^ rightL semicolon) layouts + let semiListL layouts = + tagListL (fun prefixL -> prefixL ^^ rightL semicolon) layouts - let spaceListL layouts = tagListL (fun prefixL -> prefixL) layouts + let spaceListL layouts = tagListL id layouts - let sepListL layout1 layouts = tagListL (fun prefixL -> prefixL ^^ layout1) layouts + let sepListL layout1 layouts = + tagListL (fun prefixL -> prefixL ^^ layout1) layouts - let bracketL layout = leftL leftParen ^^ layout ^^ rightL rightParen + let bracketL layout = + leftL leftParen ^^ layout ^^ rightL rightParen - let tupleL layouts = bracketL (sepListL (sepL comma) layouts) + let tupleL layouts = + bracketL (sepListL (sepL comma) layouts) let aboveListL layouts = match layouts with | [] -> emptyL - | [x] -> x - | x :: ys -> List.fold (fun pre y -> pre @@ y) x ys + | [ x ] -> x + | x :: ys -> List.fold (@@) x ys let optionL selector value = match value with @@ -340,7 +387,9 @@ module Layout = | Some x -> wordL (tagUnionCase "Some") -- (selector x) let listL selector value = - leftL leftBracket ^^ sepListL (sepL semicolon) (List.map selector value) ^^ rightL rightBracket + leftL leftBracket + ^^ sepListL (sepL semicolon) (List.map selector value) + ^^ rightL rightBracket let squareBracketL layout = leftL leftBracket ^^ layout ^^ rightL rightBracket @@ -348,19 +397,20 @@ module Layout = let braceL layout = leftL leftBrace ^^ layout ^^ rightL rightBrace - let boundedUnfoldL - (itemL: 'a -> Layout) - (project: 'z -> ('a * 'z) option) - (stopShort: 'z -> bool) - (z: 'z) - maxLength = + 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... + 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 let unfoldL selector folder state count = @@ -369,37 +419,39 @@ module Layout = /// These are a typical set of options used to control structured formatting. [] type FormatOptions = - { FloatingPointFormat: string - AttributeProcessor: (string -> (string * string) list -> bool -> unit) + { + 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 -> objnull -> Layout option) list + StringLimit: int #endif - FormatProvider: IFormatProvider - BindingFlags: BindingFlags - PrintWidth: int - PrintDepth: int - PrintLength: int - PrintSize: int - ShowProperties: bool - ShowIEnumerable: bool + FormatProvider: IFormatProvider + BindingFlags: BindingFlags + PrintWidth: int + PrintDepth: int + PrintLength: int + PrintSize: int + ShowProperties: bool + ShowIEnumerable: bool } static member Default = - { FormatProvider = (CultureInfo.InvariantCulture :> IFormatProvider) + { + FormatProvider = (CultureInfo.InvariantCulture :> IFormatProvider) #if COMPILER // This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter - PrintIntercepts = [] - StringLimit = Int32.MaxValue + PrintIntercepts = [] + StringLimit = Int32.MaxValue #endif - AttributeProcessor= (fun _ _ _ -> ()) - BindingFlags = BindingFlags.Public - FloatingPointFormat = "g10" - PrintWidth = 80 - PrintDepth = 100 - PrintLength = 100 - PrintSize = 10000 - ShowProperties = false - ShowIEnumerable = true + AttributeProcessor = (fun _ _ _ -> ()) + BindingFlags = BindingFlags.Public + FloatingPointFormat = "g10" + PrintWidth = 80 + PrintDepth = 100 + PrintLength = 100 + PrintSize = 10000 + ShowProperties = false + ShowIEnumerable = true } module ReflectUtils = @@ -413,27 +465,29 @@ module ReflectUtils = | UnitType | ObjectType of Type - let isNamedType (ty:Type) = not (ty.IsArray || ty.IsByRef || ty.IsPointer) + 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 equivHeadTypes (ty1: Type) (ty2: Type) = + isNamedType (ty1) + && if ty1.IsGenericType then + ty2.IsGenericType + && Type.op_Equality (ty1.GetGenericTypeDefinition(), ty2.GetGenericTypeDefinition()) + else + Type.op_Equality (ty1, ty2) let option = typedefof - let func = typedefof<(obj -> obj)> + let func = typedefof obj> - let isOptionTy ty = equivHeadTypes ty (typeof) + let isOptionTy ty = equivHeadTypes ty typeof - let isUnitType 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) + FSharpType.IsUnion ty + && (let cases = FSharpType.GetUnionCases ty + cases.Length > 0 && equivHeadTypes typedefof<_ list> cases[0].DeclaringType) [] type TupleType = @@ -456,89 +510,119 @@ module ReflectUtils = // of an F# value. let GetValueInfoOfObject (bindingFlags: BindingFlags) (obj: obj) = match obj with - | null -> NullValue + | 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)) - UnionCaseValue(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) + 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", StringComparison.Ordinal) 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)) + + UnionCaseValue(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 GetValueInfo bindingFlags (x: 'a, ty: Type) (* x could be null *) = let obj = (box x) match obj with - | null -> + | Null -> let isNullaryUnion = match ty.GetCustomAttributes(typeof, false) with - | [|:? CompilationRepresentationAttribute as attr|] -> + | [| :? 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 - UnionCaseValue(nullaryCase.Name, [| |]) - elif isUnitType ty then UnitValue - else NullValue - | _ -> - GetValueInfoOfObject bindingFlags (obj) + let nullaryCase = + FSharpType.GetUnionCases ty + |> Array.filter (fun uc -> uc.GetFields().Length = 0) + |> Array.item 0 + + UnionCaseValue(nullaryCase.Name, [||]) + elif isUnitType ty then + UnitValue + else + NullValue + | NonNull obj -> + GetValueInfoOfObject bindingFlags obj module Display = open ReflectUtils - let string_of_int (i:int) = i.ToString() + let string_of_int (i: int) = i.ToString() - let typeUsesSystemObjectToString (ty:System.Type) = + let typeUsesSystemObjectToString (ty: Type) = try - let methInfo = ty.GetMethod("ToString", BindingFlags.Public ||| BindingFlags.Instance, null, [| |], null) - methInfo.DeclaringType = typeof - with _e -> false + let methInfo = + ty.GetMethod("ToString", BindingFlags.Public ||| BindingFlags.Instance, null, [||], null) - let catchExn f = try Choice1Of2 (f ()) with e -> Choice2Of2 e + methInfo.DeclaringType = typeof + with _e -> + false + + 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 + | Breaks of /// pos of next free slot nextFreeSlot: int * /// pos of next possible "outer" break - OR - outer=next if none possible @@ -557,193 +641,204 @@ module Display = let pushBreak saving (Breaks(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 + 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) + 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 + 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 + 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 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 - - fitLeaf breaks pos - - | Node (l, r, joint) -> - 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 (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 (l, r, 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 (l, r, Broken indent) , pos, indent + offsetr + + 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 - 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 (l, r, Breakable indent) , pos, offsetl + mid + offsetr + 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(l, r, joint) -> + 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(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(l, r, 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(l, r, Broken indent), pos, indent + offsetr + else + 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(l, r, 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 + 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 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 String(' ', n) - let rstrs = push "\n" rstrs + let indent = 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, _) -> + | ObjLeaf(_, obj, _) -> let text = leafFormatter obj addText z text - | Leaf (_, obj, _) -> - addText z obj.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) -> + | Node(l, r, Broken indent) when opts.PrintWidth <> 0 -> let z = addL z pos l - let z = newLine z (pos+indent) - let z = addL z (pos+indent) r + let z = newLine z (pos + indent) + let z = addL z (pos + indent) r z - | Node (l, r, _) -> - let jm = Layout.JuxtapositionMiddle (l, 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 let z = addL z pos r z - | Attr (_, _, l) -> - addL z pos l + | Attr(_, _, l) -> addL z pos l let rstrs, _ = addL z0 0 layout extract rstrs +#if COMPILER 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 addText z text = + write text + (z + length text) + let newLine _ n = // \n then spaces... - let indent = new String(' ', n) - chan.WriteLine(); - write (tagText indent); + let indent = String(' ', n) + chan.WriteLine() + write (tagText indent) 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, _) -> - addText z obj - | Node (l, r, Broken indent) -> + | 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 + let z = newLine z (pos + indent) + let z = addL z (pos + indent) r z - | Node (l, r, _) -> - let jm = Layout.JuxtapositionMiddle (l, 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 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 @@ -751,19 +846,20 @@ module Display = let _ = addL z0 0 layout () +#endif let unpackCons recd = match recd with - | [|(_, h);(_, t)|] -> (h, t) + | [| (_, h); (_, t) |] -> (h, t) | _ -> failwith "unpackCons" - let getListValueInfo bindingFlags (x:obj, ty:Type) = + let getListValueInfo bindingFlags (x: obj, ty: Type) = match x with - | null -> None - | _ -> + | Null -> None + | NonNull x -> 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") @@ -774,22 +870,25 @@ module Display = let makeRecordL nameXs = let itemL (name, xL) = (wordL name ^^ wordL equals) -- xL - let braceL xs = (wordL leftBrace) ^^ xs ^^ (wordL rightBrace) - nameXs - |> List.map itemL - |> aboveListL - |> braceL + let braceL xs = + (wordL leftBrace) ^^ xs ^^ (wordL rightBrace) + + nameXs |> List.map itemL |> aboveListL |> braceL let makePropertiesL nameXs = let itemL (name, v) = let labelL = wordL name + (labelL ^^ wordL equals) ^^ (match v with | None -> wordL questionMark | Some xL -> xL) ^^ (rightL semicolon) - let braceL xs = (leftL leftBrace) ^^ xs ^^ (rightL rightBrace) + + let braceL xs = + (leftL leftBrace) ^^ xs ^^ (rightL rightBrace) + braceL (aboveListL (List.map itemL nameXs)) let makeListL itemLs = @@ -802,13 +901,23 @@ module Display = ^^ sepListL (rightL semicolon) xs ^^ (rightL (tagPunctuation "|]")) - let makeArray2L xs = leftL leftBracket ^^ aboveListL xs ^^ rightL rightBracket + let makeArray2L xs = + leftL leftBracket ^^ aboveListL xs ^^ rightL 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) + 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 @@ -816,32 +925,47 @@ module Display = | '\"' when not isChar -> "\\\"" | '\\' -> "\\\\" | '\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() + | _ when 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) + let formatString (s: string) = + let rec check i = + i < s.Length && not (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 + "\"" +#if COMPILER // 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... + // So long leaf-string width cannot depend on their printing context... // // The suffix like "+[dd chars]" is 11 chars. // 12345678901 - let formatStringInWidth (width:int) (str:string) = + let formatStringInWidth (width: int) (str: string) = 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]" + + "\"" + + (str.Substring(0, prefixLength)) + + "\"" + + "+[" + + (str.Length - prefixLength).ToString() + + " chars]" +#endif type Precedence = | BracketIfTupleOrNotAtomic = 2 @@ -854,10 +978,17 @@ module Display = | ShowAll | ShowTopLevelBinding - let isSetOrMapType (ty:Type) = - ty.IsGenericType && - (ty.GetGenericTypeDefinition() = typedefof> - || ty.GetGenericTypeDefinition() = typedefof>) + let isSetOrMapType (ty: Type) = + ty.IsGenericType + && (ty.GetGenericTypeDefinition() = typedefof> + || ty.GetGenericTypeDefinition() = typedefof>) + + let messageRegexLookup = + @"^(?
.*?)(?.*?)(?.*)$"
+        |> System.Text.RegularExpressions.Regex
+
+    let illFormedBracketPatternLookup =
+        @"(? System.Text.RegularExpressions.Regex
 
     // 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.
@@ -867,173 +998,207 @@ module Display =
     type ObjectGraphFormatter(opts: FormatOptions, bindingFlags) =
 
         // Keep a record of objects encountered along the way
-        let path = Dictionary(10,HashIdentity.Reference)
+        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
+        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)
+        let rec nestedObjL depthLim prec (x: obj, ty: Type) = objL ShowAll depthLim prec (x, ty)
 
-        and objL showMode depthLim prec (x:obj, ty:Type) =
+        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 "...")
-                    else
-                        path.Add(x,0)
+                if depthLim <= 0 || exceededPrintSize () then
+                    wordL (tagPunctuation "...")
+                else
+                    match x with
+                    | Null -> reprL showMode (depthLim - 1) prec info x
+                    | NonNull x ->
+                        if (path.ContainsKey(x)) then
+                            wordL (tagPunctuation "...")
+                        else
+                            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 ->
-                                structuredFormatObjectL showMode ty depthLim (res.[0] :?> StructuredFormatDisplayAttribute) x
+                            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
+                                    | NonNull 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 _.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)
+                            // 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 _.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
-                        res
-            with
-                e ->
+                            let res =
+                                match res with
+                                | Some res -> res
+                                | None -> reprL showMode (depthLim - 1) prec info x
+
+                            path.Remove(x) |> ignore
+                            res
+            with e ->
                 countNodes 1
-                wordL (tagText("Error: " + e.Message))
+                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
+            if isNull (box txt) || txt.Length <= 1 then
                 None
             else
-            let messageRegexPattern = @"^(?
.*?)(?.*?)(?.*)$"
-            let illFormedBracketPattern = @"(? 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 "")]
+                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 = messageRegexLookup.Match txt
+
+                    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 = illFormedBracketPatternLookup.IsMatch txt
+
+                        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 = messageRegexLookup.Match postText
+
+                                // 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
+                                | _ when String.IsNullOrEmpty(postText) ->
+                                    //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 =
+                                        illFormedBracketPatternLookup.IsMatch postTextMatch.Groups["pre"].Value
+
+                                    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
+
+                                | remainingPropertyText ->
+                                    // make sure we don't have any stray brackets
+                                    let strayClosingMatch = illFormedBracketPatternLookup.IsMatch remainingPropertyText
+
+                                    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 (remainingPropertyText))))
+                                                    :: 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 leftParen ^^ commaListL (List.map (snd >> nestedObjL depthLim Precedence.BracketIfTuple) txs) ^^ rightL rightParen
+            | [ (_, x) ] -> nestedObjL depthLim Precedence.BracketIfTupleOrNotAtomic x
+            | txs ->
+                leftL leftParen
+                ^^ commaListL (List.map (snd >> nestedObjL depthLim Precedence.BracketIfTuple) txs)
+                ^^ rightL rightParen
 
         and bracketIfL flag basicL =
-            if flag then (leftL leftParen) ^^ basicL ^^ (rightL rightParen) else basicL
+            if flag then
+                (leftL leftParen) ^^ basicL ^^ (rightL rightParen)
+            else
+                basicL
 
         and tupleValueL depthLim prec vals tupleType =
-            let basicL = sepListL (rightL comma) (List.map (nestedObjL depthLim Precedence.BracketIfTuple ) (Array.toList vals))
+            let basicL =
+                sepListL (rightL 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
@@ -1041,15 +1206,20 @@ module Display =
         and recordValueL depthLim items =
             let itemL (name, x, ty) =
                 countNodes 1
-                tagRecordField name,nestedObjL depthLim Precedence.BracketIfTuple (x, ty)
+                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 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)
+
+                let itemLs =
+                    nestedObjL depthLim Precedence.BracketIfTuple x
+                    :: boundedUnfoldL (nestedObjL depthLim Precedence.BracketIfTuple) project stopShort xs (opts.PrintLength - 1)
+
                 makeListL itemLs
             | _ ->
                 countNodes 1
@@ -1058,16 +1228,22 @@ module Display =
         and unionCaseValueL depthLim prec unionCaseName recd =
             countNodes 1
             let caseName = wordL (tagMethod unionCaseName)
+
             match recd with
             | [] -> caseName
-            | recd -> (caseName --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
+            | 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)
+            | recd ->
+                (wordL (tagClass name) --- recdAtomicTupleL depthLim recd)
+                |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
 
         and showModeFilter showMode layout =
             match showMode with
@@ -1077,85 +1253,164 @@ module Display =
         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
+            wordL (tagText ("")) |> showModeFilter showMode
 
         and stringValueL (s: string) =
             countNodes 1
 #if COMPILER
-            if s.Length + 2(*quotes*) <= opts.StringLimit then
+            if s.Length + 2 (*quotes*) <= opts.StringLimit then
                 // With the quotes, it fits within the limit.
-                wordL (tagStringLiteral(formatString s))
+                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))
+                wordL (tagStringLiteral (formatStringInWidth opts.StringLimit s))
 #else
             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)
+
+                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)
+                    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))]
+
+                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)) ]
 
         and mapSetValueL depthLim prec (ty: Type) (obj: obj) =
-            let word = if ty.GetGenericTypeDefinition() = typedefof> then "map" else "set"
+            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)
+
+                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()
+
+            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)
+                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()
+                | :? 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)
+                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
+
+                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)
+                    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()
+                    | :? IDisposable as e -> e.Dispose()
                     | _ -> ()
 
             else
@@ -1168,60 +1423,72 @@ module Display =
 
             // This buries an obj in the layout, rendered at squash time via a leafFormatter.
             let basicL = Layout.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 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 ->
+                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
-                )
+                    | [| :? 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) } )
-#else
-            Array.Sort((propsAndFields :> Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } )
-#endif
+            let nDepth = depthLim / 10
+
+            Array.Sort(
+                propsAndFields,
+                { new IComparer with
+                    member this.Compare(p1, p2) = compare p1.Name p2.Name
+                }
+            )
 
-            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)
+            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
+            | TupleValue(tupleType, vals) -> tupleValueL depthLim prec vals tupleType
 
-            | RecordValue items ->
-                recordValueL depthLim (Array.toList items)
+            | 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()) ->
+            | UnionCaseValue(constr, recd) when // x is List. Note: "null" is never a valid list value.
+                (not (isNull x)) && isListType (x.GetType())
+                ->
                 listValueL depthLim constr recd
 
-            | UnionCaseValue(unionCaseName, recd) ->
-                unionCaseValueL depthLim prec unionCaseName (Array.toList recd)
+            | UnionCaseValue(unionCaseName, recd) -> unionCaseValueL depthLim prec unionCaseName (Array.toList recd)
 
-            | ExceptionValue(exceptionType, recd) ->
-                fsharpExceptionL depthLim prec exceptionType (Array.toList recd)
+            | ExceptionValue(exceptionType, recd) -> fsharpExceptionL depthLim prec exceptionType (Array.toList recd)
 
-            | FunctionClosureValue closureType ->
-                functionClosureL showMode closureType
+            | FunctionClosureValue closureType -> functionClosureL showMode closureType
 
             | UnitValue ->
                 countNodes 1
@@ -1232,25 +1499,26 @@ module Display =
                 // If this is the root element, wrap the null with angle brackets
                 if depthLim = opts.PrintDepth - 1 then
                     wordL (tagText "")
-                else nullL
+                else
+                    nullL
 
             | ObjectValue obj ->
                 let ty = obj.GetType()
+
                 match obj with
-                | :? string as s ->
-                    stringValueL s
+                | :? string as s -> stringValueL s
 
-                | :? Array as arr ->
-                    arrayValueL depthLim arr
+                | :? Array as arr -> arrayValueL depthLim arr
 
-                | _ when isSetOrMapType ty ->
-                    mapSetValueL depthLim prec ty obj
+                | _ when isSetOrMapType ty -> mapSetValueL depthLim prec ty obj
 
-                | :? System.Collections.IEnumerable as ie ->
-                    sequenceValueL showMode depthLim prec ie
+                | :? System.Collections.IEnumerable as ie -> sequenceValueL showMode depthLim prec ie
 
-                | _ when showMode = ShowTopLevelBinding && typeUsesSystemObjectToString ty ->
-                    emptyL
+                | _ when showMode = ShowTopLevelBinding && typeUsesSystemObjectToString ty -> emptyL
+
+                | :? Enum ->
+                    countNodes 1
+                    Layout.objL obj
 
                 | _ when opts.ShowProperties ->
                     countNodes 1
@@ -1261,108 +1529,123 @@ module Display =
                     // This buries an obj in the layout, rendered at squash time via a leafFormatter.
                     Layout.objL obj
 
-        member _.Format(showMode, x:'a, xty:Type) =
-            objL showMode opts.PrintDepth  Precedence.BracketIfTuple (x, xty)
+        member _.Format(showMode, x: 'a, xty: Type) =
+            objL showMode opts.PrintDepth Precedence.BracketIfTuple (x, xty)
 
-    let leafFormatter (opts:FormatOptions) (obj :obj) =
+    let leafFormatter (opts: FormatOptions) (obj: obj) =
         match obj with
-        | null -> tagKeyword "null"
+        | Null -> tagKeyword "null"
         | :? double as d ->
-            let s = d.ToString(opts.FloatingPointFormat,opts.FormatProvider)
+            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
+                if Double.IsNaN(d) then
+                    "nan"
+                elif Double.IsNegativeInfinity(d) then
+                    "-infinity"
+                elif Double.IsPositiveInfinity(d) then
+                    "infinity"
+                elif
+                    opts.FloatingPointFormat[0] = 'g'
+                    && String.forall (fun c -> 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))
+                (if Single.IsNaN(d) then
+                     "nan"
+                 elif Single.IsNegativeInfinity(d) then
+                     "-infinity"
+                 elif Single.IsPositiveInfinity(d) then
+                     "infinity"
+                 elif
+                     opts.FloatingPointFormat.Length >= 1
+                     && opts.FloatingPointFormat[0] = 'g'
+                     && float32 (Int32.MinValue) < d
+                     && d < float32 (Int32.MaxValue)
+                     && float32 (int32 (d)) = d
+                 then
+                     (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
+        | :? 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
+        | :? 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
+        | :? 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
+        | :? 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
+        | :? 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
+                    | text -> 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
 
+#if COMPILER
     let any_to_layout options (value, typValue) =
         let formatter = ObjectGraphFormatter(options, BindingFlags.Public)
         formatter.Format(ShowAll, value, typValue)
 
     let squashTo width layout =
-       layout |> squashToAux (width, leafFormatter FormatOptions.Default)
+        layout |> squashToAux (width, leafFormatter FormatOptions.Default)
+#endif
 
     let squash_layout options layout =
         // Print width = 0 implies 1D layout, no squash
         if options.PrintWidth = 0 then
             layout
         else
-            layout |> squashToAux (options.PrintWidth,leafFormatter options)
+            layout |> squashToAux (options.PrintWidth, leafFormatter options)
 
+#if COMPILER
     let asTaggedTextWriter (writer: TextWriter) =
         { new TaggedTextWriter with
             member _.Write(t) = writer.Write t.Text
-            member _.WriteLine() = writer.WriteLine() }
+            member _.WriteLine() = writer.WriteLine()
+        }
 
     let output_layout_tagged options writer layout =
-        layout |> squash_layout options
-            |> outL options.AttributeProcessor (leafFormatter options) writer
-
-    let output_layout options writer layout =
-        output_layout_tagged options (asTaggedTextWriter writer) layout
+        layout
+        |> squash_layout options
+        |> outL options.AttributeProcessor (leafFormatter options) writer
+#endif
 
     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 options x = x |> any_to_layout options |> layout_to_string options
-
-    let any_to_string x = layout_as_string FormatOptions.Default x
+        layout
+        |> squash_layout options
+        |> showL options ((leafFormatter options) >> toText)
 
 #if COMPILER
     let fsi_any_to_layout options (value, typValue) =
         let formatter = ObjectGraphFormatter(options, BindingFlags.Public)
-        formatter.Format (ShowTopLevelBinding, value, typValue)
+        formatter.Format(ShowTopLevelBinding, value, typValue)
 #else
-    let internal anyToStringForPrintf options (bindingFlags:BindingFlags) (value, typValue) =
+    let internal anyToStringForPrintf options (bindingFlags: BindingFlags) (value, typValue) =
         let formatter = ObjectGraphFormatter(options, bindingFlags)
-        formatter.Format (ShowAll, value, typValue) |> layout_to_string options
+        formatter.Format(ShowAll, value, typValue) |> layout_to_string options
 #endif
-