type PrintfFormat<'Printer,'State,'Residue,'Result>(value:string) =

member x.Value = value

type PrintfFormat<'Printer,'State,'Residue,'Result,'Tuple>(value:string) =

inherit PrintfFormat<'Printer,'State,'Residue,'Result>(value)

type Format<'Printer,'State,'Residue,'Result> = PrintfFormat<'Printer,'State,'Residue,'Result>

type Format<'Printer,'State,'Residue,'Result,'Tuple> = PrintfFormat<'Printer,'State,'Residue,'Result,'Tuple>

#if FX_RESHAPED_REFLECTION

open Microsoft.FSharp.Core.PrimReflectionAdapters

open Microsoft.FSharp.Core.ReflectionAdapters

/// Basic idea of implementation:

/// Every Printf.* family should returns curried function that collects arguments and then somehow prints them.

/// Idea - instead of building functions on fly argument by argument we instead introduce some predefined parts and then construct functions from these parts

/// Parts include:

/// Plain ones:

/// 1. Final pieces (1..5) - set of functions with arguments number 1..5.

/// Primary characteristic - these functions produce final result of the *printf* operation

/// 2. Chained pieces (1..5) - set of functions with arguments number 1..5.

/// Primary characteristic - these functions doesn not produce final result by itself, instead they tailed with some another piece (chained or final).

/// Plain parts correspond to simple format specifiers (that are projected to just one parameter of the function, say %d or %s). However we also have

/// format specifiers that can be projected to more than one argument (i.e %a, %t or any simple format specified with * width or precision).

/// For them we add special cases (both chained and final to denote that they can either return value themselves or continue with some other piece)

/// These primitives allow us to construct curried functions with arbitrary signatures.

/// For example:

/// - function that corresponds to %s%s%s%s%s (string -> string -> string -> string -> string -> T) will be represented by one piece final 5.

/// - function that has more that 5 arguments will include chained parts: %s%s%s%s%s%d%s => chained2 -> final 5

/// Primary benefits:

/// 1. creating specialized version of any part requires only one reflection call. This means that we can handle up to 5 simple format specifiers

/// with just one reflection call

/// 2. we can make combinable parts independent from particular printf implementation. Thus final result can be cached and shared.

/// i.e when first calll to printf "%s %s" will trigger creation of the specialization. Subsequent calls will pick existing specialization

open System

open System.IO

open System.Collections.Generic

open System.Reflection

open Microsoft.FSharp.Core

open Microsoft.FSharp.Core.Operators

open Microsoft.FSharp.Collections

open LanguagePrimitives.IntrinsicOperators

[<Flags>]

type FormatFlags =

| None = 0

| LeftJustify = 1

| PadWithZeros = 2

| PlusForPositives = 4

| SpaceForPositives = 8

let inline hasFlag flags (expected : FormatFlags) = (flags &&& expected) = expected

let inline isLeftJustify flags = hasFlag flags FormatFlags.LeftJustify

let inline isPadWithZeros flags = hasFlag flags FormatFlags.PadWithZeros

let inline isPlusForPositives flags = hasFlag flags FormatFlags.PlusForPositives

let inline isSpaceForPositives flags = hasFlag flags FormatFlags.SpaceForPositives

/// Used for width and precision to denote that user has specified '*' flag

[<Literal>]

let StarValue = -1

/// Used for width and precision to denote that corresponding value was omitted in format string

[<Literal>]

let NotSpecifiedValue = -2

[<System.Diagnostics.DebuggerDisplayAttribute("{ToString()}")>]

[<NoComparison; NoEquality>]

type FormatSpecifier =

{

TypeChar : char

Precision : int

Width : int

Flags : FormatFlags

}

member this.IsStarPrecision = this.Precision = StarValue

member this.IsPrecisionSpecified = this.Precision <> NotSpecifiedValue

member this.IsStarWidth = this.Width = StarValue

member this.IsWidthSpecified = this.Width <> NotSpecifiedValue

override this.ToString() =

let valueOf n = match n with StarValue -> "*" | NotSpecifiedValue -> "-" | n -> n.ToString()

System.String.Format

(

"'{0}', Precision={1}, Width={2}, Flags={3}",

this.TypeChar,

(valueOf this.Precision),

(valueOf this.Width),

this.Flags

)

/// Set of helpers to parse format string

module private FormatString =

let inline isDigit c = c >= '0' && c <= '9'

let intFromString (s : string) pos =

let rec go acc i =

if isDigit s.[i] then

let n = int s.[i] - int '0'

go (acc * 10 + n) (i + 1)

else acc, i

go 0 pos

let parseFlags (s : string) i : FormatFlags * int =

let rec go flags i =

match s.[i] with

| '0' -> go (flags ||| FormatFlags.PadWithZeros) (i + 1)

| '+' -> go (flags ||| FormatFlags.PlusForPositives) (i + 1)

| ' ' -> go (flags ||| FormatFlags.SpaceForPositives) (i + 1)

| '-' -> go (flags ||| FormatFlags.LeftJustify) (i + 1)

| _ -> flags, i

go FormatFlags.None i

let parseWidth (s : string) i : int * int =

if s.[i] = '*' then StarValue, (i + 1)

elif isDigit (s.[i]) then intFromString s i

else NotSpecifiedValue, i

let parsePrecision (s : string) i : int * int =

if s.[i] = '.' then

if s.[i + 1] = '*' then StarValue, i + 2

elif isDigit (s.[i + 1]) then intFromString s (i + 1)

else raise (ArgumentException("invalid precision value"))

else NotSpecifiedValue, i

let parseTypeChar (s : string) i : char * int =

s.[i], (i + 1)

let findNextFormatSpecifier (s : string) i =

let rec go i (buf : Text.StringBuilder) =

if i >= s.Length then

s.Length, buf.ToString()

else

let c = s.[i]

if c = '%' then

if i + 1 < s.Length then

let _, i1 = parseFlags s (i + 1)

let w, i2 = parseWidth s i1

let p, i3 = parsePrecision s i2

let typeChar, i4 = parseTypeChar s i3

// shortcut for the simpliest 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

go i4 buf

else

i, buf.ToString()

else

raise (ArgumentException("Missing format specifier"))

else

buf.Append(c) |> ignore

go (i + 1) buf

go i (Text.StringBuilder())

/// Abstracts generated printer from the details of particular environment: how to write text, how to produce results etc...

[<AbstractClass>]

type PrintfEnv<'State, 'Residue, 'Result> =

val State : 'State

new(s : 'State) = { State = s }

abstract Finalize : unit -> 'Result

abstract Write : string -> unit

abstract WriteT : 'Residue -> unit

type Utils =

static member inline Write (env : PrintfEnv<_, _, _>, a, b) =

env.Write a

env.Write b

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c) =

Utils.Write(env, a, b)

env.Write c

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d) =

Utils.Write(env, a, b)

Utils.Write(env, c, d)

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e) =

Utils.Write(env, a, b, c)

Utils.Write(env, d, e)

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f) =

Utils.Write(env, a, b, c, d)

Utils.Write(env, e, f)

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f, g) =

Utils.Write(env, a, b, c, d, e)

Utils.Write(env, f, g)

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h) =

Utils.Write(env, a, b, c, d, e, f)

Utils.Write(env, g, h)

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i) =

Utils.Write(env, a, b, c, d, e, f, g)

Utils.Write(env, h ,i)

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i, j) =

Utils.Write(env, a, b, c, d, e, f, g, h)

Utils.Write(env, i, j)

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i, j, k) =

Utils.Write(env, a, b, c, d, e, f, g, h, i)

Utils.Write(env, j, k)

static member inline Write (env : PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i, j, k, l, m) =

Utils.Write(env, a, b, c, d, e, f, g, h, i, j, k)

Utils.Write(env, l, m)

/// Type of results produced by specialization

/// This is function that accepts thunk to create PrintfEnv on demand and returns concrete instance of Printer (curried function)

/// After all arguments is collected, specialization obtains concrete PrintfEnv from the thunk and use it to output collected data.

type PrintfFactory<'State, 'Residue, 'Result, 'Printer> = (unit -> PrintfEnv<'State, 'Residue, 'Result>) -> 'Printer

[<Literal>]

let MaxArgumentsInSpecialization = 5

/// Specializations are created via factory methods. These methods accepts 2 kinds of arguments

/// - parts of format string that corresponds to raw text

/// - functions that can transform collected values to strings

/// basic shape of the signature of specialization

/// <prefix-string> + <converter for arg1> + <suffix that comes after arg1> + ... <converter for arg-N> + <suffix that comes after arg-N>

type Specializations<'State, 'Residue, 'Result> private ()=

static member Final1<'A>

(

s0, conv1, s1

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) ->

let env = env()

Utils.Write(env, s0, (conv1 a), s1)

env.Finalize()

)

)

static member Final2<'A, 'B>

(

s0, conv1, s1, conv2, s2

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) (b : 'B) ->

let env = env()

Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2)

env.Finalize()

)

)

static member Final3<'A, 'B, 'C>

(

s0, conv1, s1, conv2, s2, conv3, s3

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) (b : 'B) (c : 'C) ->

let env = env()

Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3)

env.Finalize()

)

)

static member Final4<'A, 'B, 'C, 'D>

(

s0, conv1, s1, conv2, s2, conv3, s3, conv4, s4

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) (b : 'B) (c : 'C) (d : 'D)->

let env = env()

Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4)

env.Finalize()

)

)

static member Final5<'A, 'B, 'C, 'D, 'E>

(

s0, conv1, s1, conv2, s2, conv3, s3, conv4, s4, conv5, s5

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) (b : 'B) (c : 'C) (d : 'D) (e : 'E)->

let env = env()

Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4, (conv5 e), s5)

env.Finalize()

)

)

static member Chained1<'A, 'Tail>

(

s0, conv1,

next

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) ->

let env() =

let env = env()

Utils.Write(env, s0, (conv1 a))

env

next env : 'Tail

)

)

static member Chained2<'A, 'B, 'Tail>

(

s0, conv1, s1, conv2,

next

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) (b : 'B) ->

let env() =

let env = env()

Utils.Write(env, s0, (conv1 a), s1, (conv2 b))

env

next env : 'Tail

)

)

static member Chained3<'A, 'B, 'C, 'Tail>

(

s0, conv1, s1, conv2, s2, conv3,

next

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) (b : 'B) (c : 'C) ->

let env() =

let env = env()

Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c))

env

next env : 'Tail

)

)

static member Chained4<'A, 'B, 'C, 'D, 'Tail>

(

s0, conv1, s1, conv2, s2, conv3, s3, conv4,

next

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) (b : 'B) (c : 'C) (d : 'D)->

let env() =

let env = env()

Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d))

env

next env : 'Tail

)

)

static member Chained5<'A, 'B, 'C, 'D, 'E, 'Tail>

(

s0, conv1, s1, conv2, s2, conv3, s3, conv4, s4, conv5,

next

) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (a : 'A) (b : 'B) (c : 'C) (d : 'D) (e : 'E)->

let env() =

let env = env()

Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4, (conv5 e))

env

next env : 'Tail

)

)

static member TFinal(s1 : string, s2 : string) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (f : 'State -> 'Residue) ->

let env = env()

env.Write(s1)

env.WriteT(f env.State)

env.Write s2

env.Finalize()

)

)

static member TChained<'Tail>(s1 : string, next : PrintfFactory<'State, 'Residue, 'Result,'Tail>) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (f : 'State -> 'Residue) ->

let env() =

let env = env()

env.Write(s1)

env.WriteT(f env.State)

env

next(env) : 'Tail

)

)

static member LittleAFinal<'A>(s1 : string, s2 : string) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (f : 'State -> 'A ->'Residue) (a : 'A) ->

let env = env()

env.Write s1

env.WriteT(f env.State a)

env.Write s2

env.Finalize()

)

)

static member LittleAChained<'A, 'Tail>(s1 : string, next : PrintfFactory<'State, 'Residue, 'Result,'Tail>) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (f : 'State -> 'A ->'Residue) (a : 'A) ->

let env() =

let env = env()

env.Write s1

env.WriteT(f env.State a)

env

next env : 'Tail

)

)

static member StarFinal1<'A>(s1 : string, conv, s2 : string) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (star1 : int) (a : 'A) ->

let env = env()

env.Write s1

env.Write (conv a star1 : string)

env.Write s2

env.Finalize()

)

)

static member PercentStarFinal1(s1 : string, s2 : string) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (_star1 : int) ->

let env = env()

env.Write s1

env.Write("%")

env.Write s2

env.Finalize()

)

)

static member StarFinal2<'A>(s1 : string, conv, s2 : string) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (star1 : int) (star2 : int) (a : 'A) ->

let env = env()

env.Write s1

env.Write (conv a star1 star2: string)

env.Write s2

env.Finalize()

)

)

/// Handles case when '%*.*%' is used at the end of string

static member PercentStarFinal2(s1 : string, s2 : string) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (_star1 : int) (_star2 : int) ->

let env = env()

env.Write s1

env.Write("%")

env.Write s2

env.Finalize()

)

)

static member StarChained1<'A, 'Tail>(s1 : string, conv, next : PrintfFactory<'State, 'Residue, 'Result,'Tail>) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (star1 : int) (a : 'A) ->

let env() =

let env = env()

env.Write s1

env.Write(conv a star1 : string)

env

next env : 'Tail

)

)

/// Handles case when '%*%' is used in the middle of the string so it needs to be chained to another printing block

static member PercentStarChained1<'Tail>(s1 : string, next : PrintfFactory<'State, 'Residue, 'Result,'Tail>) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (_star1 : int) ->

let env() =

let env = env()

env.Write s1

env.Write("%")

env

next env : 'Tail

)

)

static member StarChained2<'A, 'Tail>(s1 : string, conv, next : PrintfFactory<'State, 'Residue, 'Result,'Tail>) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (star1 : int) (star2 : int) (a : 'A) ->

let env() =

let env = env()

env.Write s1

env.Write(conv a star1 star2 : string)

env

next env : 'Tail

)

)

/// Handles case when '%*.*%' is used in the middle of the string so it needs to be chained to another printing block

static member PercentStarChained2<'Tail>(s1 : string, next : PrintfFactory<'State, 'Residue, 'Result,'Tail>) =

(fun (env : unit -> PrintfEnv<'State, 'Residue, 'Result>) ->

(fun (_star1 : int) (_star2 : int) ->

let env() =

let env = env()

env.Write s1

env.Write("%")

env

next env : 'Tail

)

)

let inline (===) a b = Object.ReferenceEquals(a, b)

let invariantCulture = System.Globalization.CultureInfo.InvariantCulture

let inline boolToString v = if v then "true" else "false"

let inline stringToSafeString v = if v = null then "" else v

[<Literal>]

let DefaultPrecision = 6

let getFormatForFloat (ch : char) (prec : int) = ch.ToString() + prec.ToString()

let normalizePrecision prec = min (max prec 0) 99

/// Contains helpers to convert printer functions to functions that prints value with respect to specified justification

/// There are two kinds to printers:

/// 'T -> string - converts value to string - used for strings, basic integers etc..

/// string -> 'T -> string - converts value to string with given format string - used by numbers with floating point, typically precision is set via format string

/// To support both categories there are two entry points:

/// - withPadding - adapts first category

/// - withPaddingFormatted - adapts second category

module Padding =

/// pad here is function that converts T to string with respect of justification

/// basic - function that converts T to string without appying justification rules

/// adaptPaddedFormatted returns boxed function that has various number of arguments depending on if width\precision flags has '*' value

let inline adaptPaddedFormatted (spec : FormatSpecifier) getFormat (basic : string -> 'T -> string) (pad : string -> int -> 'T -> string) =

if spec.IsStarWidth then

if spec.IsStarPrecision then

// width=*, prec=*

box(fun v width prec ->

let fmt = getFormat (normalizePrecision prec)

pad fmt width v

)

else

// width=*, prec=?

let prec = if spec.IsPrecisionSpecified then normalizePrecision spec.Precision else DefaultPrecision

let fmt = getFormat prec

box(fun v width ->

pad fmt width v

)

elif spec.IsStarPrecision then

if spec.IsWidthSpecified then

// width=val, prec=*

box(fun v prec ->

let fmt = getFormat prec

pad fmt spec.Width v

)

else

// width=X, prec=*

box(fun v prec ->

let fmt = getFormat prec

basic fmt v

)

else

let prec = if spec.IsPrecisionSpecified then normalizePrecision spec.Precision else DefaultPrecision

let fmt = getFormat prec

if spec.IsWidthSpecified then

// width=val, prec=*

box(fun v ->

pad fmt spec.Width v

)

else

// width=X, prec=*

box(fun v ->

basic fmt v

)

/// pad here is function that converts T to string with respect of justification

/// basic - function that converts T to string without appying justification rules

/// adaptPadded returns boxed function that has various number of arguments depending on if width flags has '*' value

let inline adaptPadded (spec : FormatSpecifier) (basic : 'T -> string) (pad : int -> 'T -> string) =

if spec.IsStarWidth then

// width=*, prec=?

box(fun v width ->

pad width v

)

else

if spec.IsWidthSpecified then

// width=val, prec=*

box(fun v ->

pad spec.Width v

)

else

// width=X, prec=*

box(fun v ->

basic v

)

let inline withPaddingFormatted (spec : FormatSpecifier) getFormat (defaultFormat : string) (f : string -> 'T -> string) left right =

if not (spec.IsWidthSpecified || spec.IsPrecisionSpecified) then

box (f defaultFormat)

else

if isLeftJustify spec.Flags then

adaptPaddedFormatted spec getFormat f left

else

adaptPaddedFormatted spec getFormat f right

let inline withPadding (spec : FormatSpecifier) (f : 'T -> string) left right =

if not (spec.IsWidthSpecified) then

box f

else

if isLeftJustify spec.Flags then

adaptPadded spec f left

else

adaptPadded spec f right

let inline isNumber (x: ^T) =

not (^T: (static member IsPositiveInfinity: 'T -> bool) x) && not (^T: (static member IsNegativeInfinity: 'T -> bool) x) && not (^T: (static member IsNaN: 'T -> bool) x)

let inline isInteger n =

n % LanguagePrimitives.GenericOne = LanguagePrimitives.GenericZero

let inline isPositive n =

n >= LanguagePrimitives.GenericZero

/// contains functions to handle left\right justifications for non-numeric types (strings\bools)

module Basic =

let inline leftJustify f padChar =

fun (w : int) v ->

(f v : string).PadRight(w, padChar)

let inline rightJustify f padChar =

fun (w : int) v ->

(f v : string).PadLeft(w, padChar)

/// contains functions to handle left\right and no justification case for numbers

module GenericNumber =

/// handles right justification when pad char = '0'

/// this case can be tricky:

/// - negative numbers, -7 should be printed as '-007', not '00-7'

/// - positive numbers when prefix for positives is set: 7 should be '+007', not '00+7'

let inline rightJustifyWithZeroAsPadChar (str : string) isNumber isPositive w (prefixForPositives : string) =

System.Diagnostics.Debug.Assert(prefixForPositives.Length = 0 || prefixForPositives.Length = 1)

if isNumber then

if isPositive then

prefixForPositives + (if w = 0 then str else str.PadLeft(w - prefixForPositives.Length, '0')) // save space to

else

if str.[0] = '-' then

let str = str.Substring(1)

"-" + (if w = 0 then str else str.PadLeft(w - 1, '0'))

else

str.PadLeft(w, '0')

else

str.PadLeft(w, ' ')

/// handler right justification when pad char = ' '

let inline rightJustifyWithSpaceAsPadChar (str : string) isNumber isPositive w (prefixForPositives : string) =

System.Diagnostics.Debug.Assert(prefixForPositives.Length = 0 || prefixForPositives.Length = 1)

(if isNumber && isPositive then prefixForPositives + str else str).PadLeft(w, ' ')

/// handles left justification with formatting with 'G'\'g' - either for decimals or with 'g'\'G' is explicitly set

let inline leftJustifyWithGFormat (str : string) isNumber isInteger isPositive w (prefixForPositives : string) padChar =

if isNumber then

let str = if isPositive then prefixForPositives + str else str

// NOTE: difference - for 'g' format we use isInt check to detect situations when '5.0' is printed as '5'

// in this case we need to override padding and always use ' ', otherwise we'll produce incorrect results

if isInteger then

str.PadRight(w, ' ') // don't pad integer numbers with '0' when 'g' format is specified (may yield incorrect results)

else

str.PadRight(w, padChar) // non-integer => string representation has point => can pad with any character

else

str.PadRight(w, ' ') // pad NaNs with ' '

let inline leftJustifyWithNonGFormat (str : string) isNumber isPositive w (prefixForPositives : string) padChar =

if isNumber then

let str = if isPositive then prefixForPositives + str else str

str.PadRight(w, padChar)

else

str.PadRight(w, ' ') // pad NaNs with ' '

/// processes given string based depending on values isNumber\isPositive

let inline noJustificationCore (str : string) isNumber isPositive prefixForPositives =

if isNumber && isPositive then prefixForPositives + str

else str

/// noJustification handler for f : 'T -> string - basic integer types

let inline noJustification f (prefix : string) isUnsigned =

if isUnsigned then

fun v -> noJustificationCore (f v) true true prefix

else

fun v -> noJustificationCore (f v) true (isPositive v) prefix

/// noJustification handler for f : string -> 'T -> string - floating point types

let inline noJustificationWithFormat f (prefix : string) =

fun (fmt : string) v -> noJustificationCore (f fmt v) true (isPositive v) prefix

/// leftJustify handler for f : 'T -> string - basic integer types

let inline leftJustify isGFormat f (prefix : string) padChar isUnsigned =

if isUnsigned then

if isGFormat then

fun (w : int) v ->

leftJustifyWithGFormat (f v) true (isInteger v) true w prefix padChar

else

fun (w : int) v ->

leftJustifyWithNonGFormat (f v) true true w prefix padChar

else

if isGFormat then

fun (w : int) v ->

leftJustifyWithGFormat (f v) true (isInteger v) (isPositive v) w prefix padChar

else

fun (w : int) v ->

leftJustifyWithNonGFormat (f v) true (isPositive v) w prefix padChar

/// leftJustify handler for f : string -> 'T -> string - floating point types

let inline leftJustifyWithFormat isGFormat f (prefix : string) padChar =

if isGFormat then

fun (fmt : string) (w : int) v ->

leftJustifyWithGFormat (f fmt v) true (isInteger v) (isPositive v) w prefix padChar

else

fun (fmt : string) (w : int) v ->

leftJustifyWithNonGFormat (f fmt v) true (isPositive v) w prefix padChar

/// rightJustify handler for f : 'T -> string - basic integer types

let inline rightJustify f (prefixForPositives : string) padChar isUnsigned =

if isUnsigned then

if padChar = '0' then

fun (w : int) v ->

rightJustifyWithZeroAsPadChar (f v) true true w prefixForPositives

else

System.Diagnostics.Debug.Assert((padChar = ' '))

fun (w : int) v ->

rightJustifyWithSpaceAsPadChar (f v) true true w prefixForPositives

else

if padChar = '0' then

fun (w : int) v ->

rightJustifyWithZeroAsPadChar (f v) true (isPositive v) w prefixForPositives

else

System.Diagnostics.Debug.Assert((padChar = ' '))

fun (w : int) v ->

rightJustifyWithSpaceAsPadChar (f v) true (isPositive v) w prefixForPositives

/// rightJustify handler for f : string -> 'T -> string - floating point types

let inline rightJustifyWithFormat f (prefixForPositives : string) padChar =

if padChar = '0' then

fun (fmt : string) (w : int) v ->

rightJustifyWithZeroAsPadChar (f fmt v) true (isPositive v) w prefixForPositives

else

System.Diagnostics.Debug.Assert((padChar = ' '))

fun (fmt : string) (w : int) v ->

rightJustifyWithSpaceAsPadChar (f fmt v) true (isPositive v) w prefixForPositives

module Float =

let inline noJustification f (prefixForPositives : string) =

fun (fmt : string) v ->

GenericNumber.noJustificationCore (f fmt v) (isNumber v) (isPositive v) prefixForPositives

let inline leftJustify isGFormat f (prefix : string) padChar =

if isGFormat then

fun (fmt : string) (w : int) v ->

GenericNumber.leftJustifyWithGFormat (f fmt v) (isNumber v) (isInteger v) (isPositive v) w prefix padChar

else

fun (fmt : string) (w : int) v ->

GenericNumber.leftJustifyWithNonGFormat (f fmt v) (isNumber v) (isPositive v) w prefix padChar

let inline rightJustify f (prefixForPositives : string) padChar =

if padChar = '0' then

fun (fmt : string) (w : int) v ->

GenericNumber.rightJustifyWithZeroAsPadChar (f fmt v) (isNumber v) (isPositive v) w prefixForPositives

else

System.Diagnostics.Debug.Assert((padChar = ' '))

fun (fmt : string) (w : int) v ->

GenericNumber.rightJustifyWithSpaceAsPadChar (f fmt v) (isNumber v) (isPositive v) w prefixForPositives

let isDecimalFormatSpecifier (spec : FormatSpecifier) =

spec.TypeChar = 'M'

let getPadAndPrefix allowZeroPadding (spec : FormatSpecifier) =

let padChar = if allowZeroPadding && isPadWithZeros spec.Flags then '0' else ' ';

let prefix =

if isPlusForPositives spec.Flags then "+"

elif isSpaceForPositives spec.Flags then " "

else ""

padChar, prefix

let isGFormat(spec : FormatSpecifier) =

isDecimalFormatSpecifier spec || System.Char.ToLower(spec.TypeChar) = 'g'

let inline basicWithPadding (spec : FormatSpecifier) f =

let padChar, _ = getPadAndPrefix false spec

Padding.withPadding spec f (Basic.leftJustify f padChar) (Basic.rightJustify f padChar)

let inline numWithPadding (spec : FormatSpecifier) isUnsigned f =

let allowZeroPadding = not (isLeftJustify spec.Flags) || isDecimalFormatSpecifier spec

let padChar, prefix = getPadAndPrefix allowZeroPadding spec

let isGFormat = isGFormat spec

Padding.withPadding spec (GenericNumber.noJustification f prefix isUnsigned) (GenericNumber.leftJustify isGFormat f prefix padChar isUnsigned) (GenericNumber.rightJustify f prefix padChar isUnsigned)

let inline decimalWithPadding (spec : FormatSpecifier) getFormat defaultFormat f =

let padChar, prefix = getPadAndPrefix true spec

let isGFormat = isGFormat spec

Padding.withPaddingFormatted spec getFormat defaultFormat (GenericNumber.noJustificationWithFormat f prefix) (GenericNumber.leftJustifyWithFormat isGFormat f prefix padChar) (GenericNumber.rightJustifyWithFormat f prefix padChar)

let inline floatWithPadding (spec : FormatSpecifier) getFormat defaultFormat f =

let padChar, prefix = getPadAndPrefix true spec

let isGFormat = isGFormat spec

Padding.withPaddingFormatted spec getFormat defaultFormat (Float.noJustification f prefix) (Float.leftJustify isGFormat f prefix padChar) (Float.rightJustify f prefix padChar)

let inline identity v = v

let inline toString v = (^T : (member ToString : IFormatProvider -> string)(v, invariantCulture))

let inline toFormattedString fmt = fun (v : ^T) -> (^T : (member ToString : string * IFormatProvider -> string)(v, fmt, invariantCulture))

let inline numberToString c spec alt unsignedConv =

if c = 'd' || c = 'i' then

numWithPadding spec false (alt >> toString : ^T -> string)

elif c = 'u' then

numWithPadding spec true (alt >> unsignedConv >> toString : ^T -> string)

elif c = 'x' then

numWithPadding spec true (alt >> toFormattedString "x" : ^T -> string)

elif c = 'X' then

numWithPadding spec true (alt >> toFormattedString "X" : ^T -> string )

elif c = 'o' then

numWithPadding spec true (fun (v : ^T) -> Convert.ToString(int64(unsignedConv (alt v)), 8))

else raise (ArgumentException())

type ObjectPrinter =

static member ObjectToString<'T>(spec : FormatSpecifier) =

basicWithPadding spec (fun (v : 'T) -> match box v with null -> "<null>" | x -> x.ToString())

static member GenericToStringCore(v : 'T, opts : Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions, bindingFlags) =

// printfn %0A is considered to mean 'print width zero'

match box v with

| null -> "<null>"

| _ -> Microsoft.FSharp.Text.StructuredPrintfImpl.Display.anyToStringForPrintf opts bindingFlags v

static member GenericToString<'T>(spec : FormatSpecifier) =

let bindingFlags =

#if FX_RESHAPED_REFLECTION

isPlusForPositives spec.Flags // true - show non-public

if isPlusForPositives spec.Flags then BindingFlags.Public ||| BindingFlags.NonPublic

else BindingFlags.Public

let useZeroWidth = isPadWithZeros spec.Flags

let opts =

let o = Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions.Default

let o =

if useZeroWidth then { o with PrintWidth = 0}

elif spec.IsWidthSpecified then { o with PrintWidth = spec.Width}

else o

if spec.IsPrecisionSpecified then { o with PrintSize = spec.Precision}

else o

match spec.IsStarWidth, spec.IsStarPrecision with

| true, true ->

box (fun (v : 'T) (width : int) (prec : int) ->