requires: {#Root. #Mixin. #Stream. #PositionableStream. #WrapperStream. #Integer. #Float. #Collection. #Array. #String}.
provides: {#PrettyPrinterMixin. #PrettyPrinter}.

Mixins addPrototype: #PrettyPrinterMixin derivedFrom: {Mixin}.

PrettyPrinterMixin addSlot: #numberRadix valued: 10.
PrettyPrinterMixin addSlot: #numberPrecision valued: 6.
PrettyPrinterMixin addSlot: #floatMinimum valued: 1e-6.
PrettyPrinterMixin addSlot: #floatMaximum valued: 1e6.
PrettyPrinterMixin addSlot: #columnsPerLine valued: 4.
PrettyPrinterMixin addSlot: #collectionLimit valued: 16.
PrettyPrinterMixin addSlot: #stringLimit valued: 200.
PrettyPrinterMixin addSlot: #nestingLimit valued: 2.
PrettyPrinterMixin addSlot: #level valued: 0.
PrettyPrinterMixin addSlot: #column valued: 0.

o@(PrettyPrinterMixin traits) indentString
"Answer the String to insert for each indentation level."
[
  '\t'
].

o@(PrettyPrinterMixin traits) newLine
"Append a newLine and indent to the current level. TODO: rename this method?"
[
  o ; '\n'.
  o level timesRepeat: [o ; o indentString].
  o resetLine
].

o@(PrettyPrinterMixin traits) resetLine
"Set the position to the beginning of the current line."
[
  o column: 0
].

o@(PrettyPrinterMixin traits) newColumn
"Increment the current column, using wrap-around semantics based on the
number of columnsPerLine."
[
  o column: o column + 1.
  o column >= o columnsPerLine
    ifTrue: [o newLine]
    ifFalse: [o ; ' ']
].

o@(PrettyPrinterMixin traits) indent
"Increment the indentation level."
[
  o level: o level + 1
].

o@(PrettyPrinterMixin traits) unindent
"Decrement the indentation level."
[
  o level: o level - 1
].

Stream traits addPrototype: #PrettyPrinter derivedFrom: {Stream WrapperStream. PrettyPrinterMixin}.
PositionableStream traits addPrototype: #PrettyPrinter derivedFrom: {PositionableStream WrapperStream. PrettyPrinterMixin}.

c@(Collection traits) prettyPrinter
"Answer a new PrettyPrinter on the argument."
[| stream |
  stream: c writer.
  stream PrettyPrinter newOn: stream
].

"Ensure the Console writer is a PrettyPrinter."
Console atSlotNamed: #writeStream put: (Stream PrettyPrinter newOn: Console writer).

x@(Root traits) printString
"Utility for pretty-printing to a String."
[
  (x printOn: '' prettyPrinter) contents
].

x@(Root traits) print
"Alias for printString."
[
  x printString
].

"Default print methods."

x printOn: o@(PrettyPrinterMixin traits)
[
  o ; '<"Unprintable">'
].

x@(Root traits) printOn: o
"Handle the (non-dispatchable) NoRole case, then print whatever suitable
defined name along in braces and followed by the slot names and values,
indented."
[| index |
  x == NoRole
    ifTrue: [^ (o ; 'NoRole')].
  o ; '<'.
  (#name findOn: {o})
    ifNotNil:
      [o ; '"' ; x name ; '"'].
  x slotNames isEmpty
    ifTrue:
      [^ (o ; '>')].
  (#name findOn: {o})
    ifNotNil:
      [o ; ' '].
  o level >= o nestingLimit
    ifTrue: 
      [^ (o ; '...>')].
  o indent.
  index: 0.
  x slotNames do:
    [| :each |
      o ; (each as: String)
        ; ': '.
      (x atSlotNamed: each) printOn: o]
    separatedBy: 
      [o ; '.'. 
        o newColumn.
        index: index + 1.
        index >= o collectionLimit
          ifTrue: 
            [o ; '...>'.
              o unindent.
              ^ o]].
  o unindent.
  o ; '>'
].

ns@(Namespace traits) printOn: o
"Print out only the slot names, since these tend to be really large and have
unprintable prototypes in them."
[| index |
  o ; '<'.
  (#name findOn: {o})
    ifNotNil: [o ; '"' ; ns name ; '"'].
  ns slotNames isEmpty
    ifTrue: [^ (o ; '>')].
  (#name findOn: {o})
    ifNotNil: [o ; ' '].
  o level >= o nestingLimit
    ifTrue: [^ (o ; '...>')].
  o indent.
  index: 0.
  ns slotNames
    do: [| :each | o ; (each as: String) ; ' ']
    separatedBy:
      [o ; '.'.
       o newColumn.
       index: index + 1.
       index >= o collectionLimit
         ifTrue:
           [o ; '...>'.
            o unindent.
            ^ o]].
  o unindent.
  o ; '>'
].

s@(Symbol traits) printOn: o
"Print the Symbol readably, so that highlighting and evaluating answers the
original argument."
[| name |
  name: (s as: String).
  o ; '#'.
  (name allSatisfy: [| :c | c isAlphanumeric or: [':&_' includes: c]])
    ifTrue: [o ; name]
    ifFalse: [name printOn: o]
].

n@(Integer traits) printOn: o radix: radix
"Print the Integer in any given basis between 2 and 36 (alphanumeric limit),
with sign. This works by collecting the digits and a "
[| digits x |
  (radix < 2 or: [radix > 36])
    ifTrue: [^ Nil].
  n isNegative
    ifTrue: 
      [o ; '-'.
       n negated printOn: o radix: radix.
       ^ o].
  n isZero
    ifTrue: [^ (o ; '0')].
  digits: '' writer.
  x: n.
  [x isPositive]
    whileTrue:
      [| d |
        d: x \\ radix.
        digits nextPut:
          ((d >= 10
            ifTrue: [($A as: Integer) + d - 10]
            ifFalse: [($0 as: Integer) + d]) as: ASCIICharacter).
        x: x // radix].
  o ; digits contents reversed
].

n@(Integer traits) printOn: o
[
  n printOn: o radix: o numberRadix
].

n@(Integer traits) as: _@(String traits)
[
  n print
].

_@Nil printOn: o
[o ; 'Nil'].

_@True printOn: o
[o ; 'True'].

_@False printOn: o
[o ; 'False'].

m@(Method traits) printOn: o
"A simple print-out of brackets and the selector name if there is one."
[
  o ; '['.
  m selector
    ifNotNil: [o ; m selector name].
  o ; ']'
].

f@(Float traits) printOn: o radix: radix precision: precision
"Taken from 'Printing Floating-Point Numbers Quickly and Accurately',
 Robert G. Burger and R. Kent Dybvig, PLDI '96."
[| digits significand exponent k b r s mUp mDown d decimal |
  significand: f significand.
  exponent: f exponent.
  exponent = (f bias * 2 + 1)
    ifTrue: 
      [
        significand isZero
          ifTrue: 
            [f isNegative
              ifTrue: [^ (o ; '-Inf')] 
              ifFalse: [^ (o ; '+Inf')]].
        f isNegative
          ifTrue: [^ (o ; '-NaN')]
          ifFalse: [^ (o ; '+NaN')]
      ].
  exponent isZero
    ifTrue:
      [significand isZero
         ifTrue:
           [f isNegative
             ifTrue: [^ (o ; '-0.0')]
             ifFalse: [^ (o ; '0.0')]].
        exponent: 1]
    ifFalse:
      [significand: ((1 bitShift: f significandSize) bitOr: significand)].
  exponent: exponent - f bias - f significandSize.
  b: 2.
  exponent isNegative
    ifTrue:
      [
        mDown: 1.
        (exponent > (1 - f bias - f significandSize) and: [significand = (1 bitShift: f significandSize)])
          ifTrue:
            [r: significand * b * 2.
              s: (1 bitShift: 1 - exponent) * 2.
              mUp: b]
          ifFalse:
            [r: significand * 2.
              s: (1 bitShift: exponent negated) * 2.
              mUp: 1]
      ]
    ifFalse:
      [| be |
        be: (1 bitShift: exponent).
        significand = (1 bitShift: f significandSize)
          ifTrue:
            [r: significand * be * b * 2.
              s: b * 2.
              mUp: be * b.
              mDown: b]
          ifFalse:
            [r: significand * be * 2.
              s: 2.
              mUp: be.
              mDown: be]
      ].
  k: (((significand + 1) ln + (exponent * b ln)) / radix ln) ceiling.
  [k >= 0 
    ifTrue: [r + mUp > ((radix raisedTo: k) * s)]
    ifFalse: [(radix raisedTo: k negated) * (r + mUp) > s]]
    whileTrue:
      [k: k + 1].
  k >= 0
    ifTrue:
      [s: s * (radix raisedTo: k)]
    ifFalse:
      [| bk |
        bk: (radix raisedTo: k negated).
        r: r * bk.
        mUp: mUp * bk.
        mDown: mDown * bk].
  digits: '' writer.
  [
    d: (r * radix // s).
    r: (r * radix \\ s).
    mUp: mUp * radix.
    mDown: mDown * radix.
    (r + mUp > s
      and: [r >= mDown or: [r * 2 >= s]])
      ifTrue: [d: d + 1].
    d printOn: digits radix: radix.
    r < mDown or: [r + mUp > s]
  ] whileFalse.
  digits: digits contents.
  f isNegative
    ifTrue: [o ; '-'].
  (f abs < o floatMinimum or: [f abs > o floatMaximum])
    ifTrue: [decimal: 1]
    ifFalse: [decimal: (k max: 0)].
  o next: (decimal min: digits size) putAll: digits.
  (decimal - digits size max: 0)
    timesRepeat: [o ; '0'].
  decimal <= 0 
    ifTrue: 
      [o ; '0.'.
        (k negated max: 0)
          timesRepeat: [o ; '0']]
    ifFalse:
      [o ; '.'].
  decimal >= digits size 
    ifTrue: [o ; '0']
    ifFalse:
      [o next: (precision min: digits size - decimal)
         putAll: digits
         startingAt: decimal].
  (k = decimal or: [decimal <= 0])
    ifFalse:
      [o ; 'e'. 
        k - decimal printOn: o radix: radix].
  o
].

f@(Float traits) printOn: o
"Print with the stream default settings."
[
  f printOn: o radix: o numberRadix precision: o numberPrecision
].

f@(Float traits) as: _@(String traits)
[
  f print
].

c@(Collection traits) printContentsOn: o separatedBy: block
"A generic iteration through the elements, with printing of each."
[| index tally |
  tally: c size.
  index: 0.
  c do:
    [| :each |
     each printOn: o.
     index: index + 1.
     index < tally
       ifTrue: [block do]].
  o
].

c@(Collection traits) printOn: o
"The template for all collection object printing; this is only valid Slate
input if the argument is a literal collection, such as an Array."
[| index |
  index: 0.
  o ; '{'.
  ((c isSameAs: Array)
    or: [(#name findOn: {o}) isNil])
    ifFalse: 
      [o ; '"' ; c name ; '"']. 
  c isEmpty
    ifTrue: 
      [^ (o ; '}')].
  ((c isSameAs: Array)
    or: [(#name findOn: {o}) isNil])
    ifFalse:
      [o ; ' '].
  o level >= o nestingLimit
    ifTrue:
      [^ (o ; '...}')].
  o indent.
  c printContentsOn: o separatedBy:
    [
      o ; '.'.
      o newColumn.
      index: index + 1.
      index >= o collectionLimit
        ifTrue:
          [o ; '...}.'.
            o unindent.
            ^ o]
    ].  
  o unindent.
  o ; '}'
].

c@(Sequence traits) printContentsOn: o separatedBy: block
"A basis for other printing methods."
[
  c do:
    [| :each |
      each printOn: o]
    separatedBy: [block do].
  o
].

c@(Repetition traits) printContentsOn: o separatedBy: block
"Print out the element and occurrences like a faux multiplication."
[
  c element printOn: o.
  o ; ' x '.
  c number printOn: o.
  o
].

c@(Range traits) printContentsOn: o separatedBy: block
"Print the start to end with ellipses and a fancy step indicator."
[
  c start printOn: o.
  c end = PositiveInfinity
    ifTrue: 
      [o ; ' ...']
    ifFalse:
      [o ; ' .. '.
        c end printOn: o].
  c step = 1
    ifFalse: 
      [o ; ' by '.
        c step printOn: o].
  o
].

c@(LogicRange traits) printContentsOn: o separatedBy: block
"Print the start to end with ellipses."
[
  c start printOn: o.
  o ; ' ...'
].

c@(Dictionary traits) printContentsOn: o separatedBy: block
"Print out the keys and values as Association constructors."
[| index tally |
  index: 0.
  tally: 0.
  c keysAndValuesDo: [| :key :val | tally: tally + 1].
  c keysAndValuesDo:
    [| :key :val |
      key printOn: o.
      o ; ' -> '.
      val printOn: o.
      index: index + 1.
      index < tally
        ifTrue:
          [block do]
    ].
  o
].

c@(Bag traits) printContentsOn: o separatedBy: block
"Print the element and number of occurrences like a Repetition."
[| index tally |
  index: 0.
  tally: 0.
  c elementsAndOccurrencesDo: [| :each :count | tally: tally + 1].
  c elementsAndOccurrencesDo:
    [| :each :count |
      each printOn: o.
      o ; ' x '.
      count printOn: o.
      index: index + 1.
      index < tally
        ifTrue:
          [block do]
    ].
  o
].
  
c@(ASCIICharacter traits) printOn: o
"Consult the table of escapes, then handle normal printing."
[
  o ; '$'.
  c caseOf:
    {
      $' -> [o ; '\\\''].
      $\t -> [o ; '\\t'].
      $\n -> [o ; '\\n'].
      $\v -> [o ; '\\v'].
      $\f -> [o ; '\\f'].
      $\r -> [o ; '\\r'].
      $\b -> [o ; '\\b'].
      $\a -> [o ; '\\a'].
      $\e -> [o ; '\\e'].
      $\0 -> [o ; '\\0']
    }
    otherwise:
      [c isPrintable
        ifTrue: [o nextPut: c]
        ifFalse: 
          [o ; '\\x'.
            (c as: Integer) // 16 printOn: o radix: 16.
            (c as: Integer) \\ 16 printOn: o radix: 16]].
  o
].
 
s@(String traits) printOn: o
"Print the String readably, using escapes to preserve the contents."
[
  o ; '\''.
  s doWithIndex:
    [| :c :index |
      index >= o stringLimit
        ifTrue: [o ; '...\''. ^ o].
      c caseOf:
        {
          $" -> [o ; '\\"'].
          $\t -> [o ; '\\t'].
          $\n -> [o ; '\\n'].
          $\v -> [o ; '\\v'].
          $\f -> [o ; '\\f'].
          $\r -> [o ; '\\r'].
          $\b -> [o ; '\\b'].
          $\a -> [o ; '\\a'].
          $\e -> [o ; '\\e'].
          $\0 -> [o ; '\\0'].
        }
        otherwise:
          [c isPrintable
            ifTrue: [o nextPut: c]
            ifFalse: 
              [o ; '\\x'.
                (c as: Integer) // 16 printOn: o radix: 16.
                (c as: Integer) \\ 16 printOn: o radix: 16]]
    ].
  o ; '\''.
  o
].