src/core/print.slate

   1 Mixins define: #StructuredPrinterMixin &parents: {LineNumberedWriteStreamMixin}
   2  &slots: {#level -> 0. #columnsPerLine -> 80}.
   3
   4 StructuredPrinterMixin traits define: #indentString -> '    '.
   5 "The String to insert for each indentation level."
   6
   7 o@(StructuredPrinterMixin traits) newLineAndIndent
   8 "Append a newLine and indent to the current level."
   9 [
  10   o nextPut: $\n.
  11   o level timesRepeat: [o ; o indentString].
  12   o
  13 ].
  14
  15 o@(StructuredPrinterMixin traits) newLine
  16 "Obsolete; change senders to use newLineAndIndent."
  17 [o newLineAndIndent].
  18
  19 o@(StructuredPrinterMixin traits) newColumn
  20 "Increment the current column, using wrap-around semantics based on the
  21 number of columnsPerLine."
  22 [
  23   o currentColumn > o columnsPerLine
  24     ifTrue: [o newLineAndIndent]
  25     ifFalse: [o nextPut: $\s]
  26 ].
  27
  28 o@(StructuredPrinterMixin traits) indent
  29 "Increment the indentation level."
  30 [
  31   o level += 1.
  32 ].
  33
  34 o@(StructuredPrinterMixin traits) unindent
  35 "Decrement the indentation level."
  36 [
  37   o level -= 1.
  38 ].
  39
  40 o@(StructuredPrinterMixin traits) indentedDo: block
  41 [
  42   o indent.
  43   [block do] ensure: [o unindent].
  44 ].
  45
  46 o@(StructuredPrinterMixin traits) print: str paddingUntil: length
  47 "Print the given string and make sure the cursor is at least at the given column."
  48 [
  49   padding ::= length - str size max: 0.
  50   o nextPutAll: str.
  51   o next: padding put: $\s.
  52   o
  53 ].
  54
  55 Mixins define: #PrettyPrinterMixin &parents: {StructuredPrinterMixin} &slots: {
  56   #numberRadix -> 10.
  57   #numberPrecision -> 6.
  58   #floatMinimum -> 1e-6.
  59   #floatMaximum -> 1e6.
  60   #collectionLimit -> 32.
  61   #stringLimit -> 200.
  62   #nestingLimit -> 1.
  63   #preferDense -> True.
  64 }.
  65
  66 o@(PrettyPrinterMixin traits) newElement
  67 [
  68   o preferDense
  69     ifTrue: [o newColumn]
  70     ifFalse: [o newLineAndIndent]
  71 ].
  72
  73 Stream traits define: #PrettyPrinter &parents: {PrettyPrinterMixin. Stream WrapperStream}.
  74
  75 s@(WriteStream traits) prettyPrinter
  76 [s PrettyPrinter newOn: s].
  77
  78 c@(Collection traits) prettyPrinter
  79 "Answer a new PrettyPrinter on the argument."
  80 [c writer prettyPrinter].
  81
  82 x@(Root traits) prettyPrintOn: s &depth: depth
  83 [x printOn: s writer prettyPrinter &depth: depth].
  84
  85 x@(Root traits) prettyPrinted &depth: depth
  86 [(x prettyPrintOn: '') contents &depth: depth].
  87
  88 "Ensure the Console writer and DebugConsole writer are PrettyPrinter objects."
  89 "Only do this once during bootstrap"
  90 (Console writeStream is: Stream PrettyPrinter)
  91   ifFalse: [Console atSlotNamed: #writeStream put: (Stream PrettyPrinter newOn: Console writer)].
  92 (DebugConsole writeStream is: Stream PrettyPrinter)
  93   ifFalse: [DebugConsole atSlotNamed: #writeStream put: (Stream PrettyPrinter newOn: DebugConsole writer)].
  94
  95 x@(Root traits) printString &radix: radix &precision: prec &forceSign: forceSign &depth: depth
  96 "Utility for pretty-printing to a String."
  97 [
  98   [printer ::= '' prettyPrinter.
  99    x printOn: printer &radix: radix &precision: prec &forceSign: forceSign &depth: depth.
 100    printer contents] on: Error do: [| :c | ^ '<Printing failed>']
 101 ].
 102
 103 x@(Root traits) printOn: out &radix: radix &precision: prec &forceSign: forceSign &depth: depth
 104 "Print the object on the Console. Always answers the object back."
 105 [
 106   x printOn: out writer &radix: radix &precision: prec &forceSign: forceSign &depth: depth
 107 ].
 108
 109 x@(Root traits) print &radix: radix &precision: prec &forceSign: forceSign &depth: depth
 110 "Print the object on the Console. Always answers the object back."
 111 [
 112   x printOn: Console writer &radix: radix &precision: prec &forceSign: forceSign &depth: depth.
 113   x
 114 ].
 115
 116 "Default print methods."
 117
 118 x printOn: o@(PrettyPrinterMixin traits)
 119 [
 120   o ; '#("Unprintable")'
 121 ].
 122
 123 x@(Root traits) printOn: o@(PrettyPrinterMixin traits) &depth: depth
 124 "Handle the (non-dispatchable) NoRole case, then print whatever suitable
 125 defined name along in braces and followed by the slot names and values,
 126 indented."
 127 [
 128   x == NoRole ifTrue:
 129     [^ (o ; 'NoRole')].
 130   (depth `defaultsTo: 3) isZero ifTrue:
 131     [^ Nil].
 132   o ; '#('.
 133   (doPrintName ::= #printName isFoundOn: {x}) ifTrue:
 134     [o ; x printName].
 135   x slotNames isEmpty ifFalse:
 136     [doPrintName ifTrue:
 137        [o ; ' '].
 138      o level >= o nestingLimit
 139        ifTrue: [o ; '...']
 140        ifFalse:
 141          [o indentedDo:
 142             [| index |
 143              index := 0.
 144              o preferDense ifFalse:
 145                [o newLineAndIndent].
 146              (x slotNames copyWithout: #traitsWindow) do:
 147                [| :each |
 148                 o ; (each as: String) ; ': '.
 149                 (x atSlotNamed: each) printOn: o &depth: depth - 1]
 150                separatedBy:
 151                  [o ; '.'.
 152                   o newElement.
 153                   (index += 1) >= o collectionLimit ifTrue:
 154                     [^ (o ; '...)')]]]]].
 155   o ; ')'
 156 ].
 157
 158 ns@(Namespace traits) printOn: o@(PrettyPrinterMixin traits) &depth: depth
 159 "Print out only the slot names, since these tend to be really large and have
 160 unprintable prototypes in them."
 161 [
 162   (depth `defaultsTo: 3) isZero ifTrue:
 163     [^ Nil].
 164   o ; '#('.
 165   (doPrintName ::= #name isFoundOn: {ns}) ifTrue:
 166     [o ; ns name].
 167   ns slotNames isEmpty ifFalse:
 168     [doPrintName ifTrue:
 169        [o ; ' '].
 170      o level >= o nestingLimit
 171        ifTrue: [o ; '...']
 172        ifFalse:
 173          [o indentedDo:
 174             [| index |
 175              index := 0.
 176              ns slotNames
 177                do: [| :each | o ; (each as: String)]
 178                separatedBy:
 179                  [o ; '.'.
 180                   o newElement.
 181                   (index += 1) >= o collectionLimit ifTrue:
 182                     [^ (o ; '...)')]]]]].
 183   o ; ')'
 184 ].
 185
 186 s@(Symbol traits) printOn: o@(PrettyPrinterMixin traits)
 187 "Print the Symbol readably, so that highlighting and evaluating answers the
 188 original argument."
 189 [
 190   o ; '#'.
 191   `conditions: (
 192     [s isEmpty] -> [o ; '\'\''].
 193     [s allSatisfy: [| :c | c isAlphanumeric \/ [':&_' includes: c]]] -> [o ; s name]
 194   ) otherwise: [s name printOn: o]
 195 ].
 196
 197 n@(Integer traits) printOn: o@(PrettyPrinterMixin traits) &radix: radix &forceSign: forceSign &groupSeparator: groupSeparator &groupSize: groupSize
 198 "Print the Integer in any given basis between 2 and 36 (alphanumeric limit),
 199 with sign. This works by collecting the digits and a "
 200 [| digits x |
 201   n == SmallInteger ifTrue:
 202     [^ (o ; n printName)].
 203   radix `defaultsTo: o numberRadix.
 204   radix < 2 \/ [radix > 36] ifTrue:
 205     [^ Nil].
 206   n isNegative
 207     ifTrue:
 208       [o ; '-'.
 209        n negated printOn: o &radix: radix.
 210        ^ o]
 211     ifFalse:
 212       [forceSign isNotNil /\ [forceSign]
 213          ifTrue: [o ; '+']].
 214   n isZero ifTrue:
 215     [^ (o ; '0')].
 216   digits := '' prettyPrinter.
 217   x := n.
 218   [x isPositive]
 219     whileTrue:
 220       [| qr d |
 221        qr := x quoRem: radix.
 222        d := qr second.
 223        x := qr first.
 224        digits nextPut:
 225          ((d >= 10
 226             ifTrue: [($A as: Integer) + d - 10]
 227             ifFalse: [($0 as: Integer) + d]) as: ASCIIString Character)].
 228   o ; (groupSeparator
 229          ifNil: [digits contents reversed]
 230          ifNotNil: [((digits contents splitIntoSize: (groupSize ifNil: [3]))
 231                        join &separator: groupSeparator reversed) reversed])
 232 ].
 233
 234 n@(Integer traits) as: _@(String traits)
 235 [
 236   n printString
 237 ].
 238
 239 _@Nil printOn: o@(PrettyPrinterMixin traits)
 240 [o ; 'Nil'].
 241
 242 _@True printOn: o@(PrettyPrinterMixin traits)
 243 [o ; True printName].
 244
 245 _@False printOn: o@(PrettyPrinterMixin traits)
 246 [o ; False printName].
 247
 248 m@(Method traits) printOn: o@(PrettyPrinterMixin traits)
 249 "A simple print-out of brackets and the selector name if there is one."
 250 [
 251   o ; '[' ; (m selector
 252                ifNil: ['(arity: ' ; m arity printString ; ')']
 253                ifNotNilDo: #name `er).
 254   m optionalKeywords do: [| :kw | o ; ' ' ; kw name].
 255   o ; ']'.
 256 ].
 257
 258 m@(Method Converse traits) printOn: o@(PrettyPrinterMixin traits)
 259 [m method printOn: o. o ; ' converse'].
 260
 261 f@(Float traits) printOn: o@(PrettyPrinterMixin traits)
 262   &radix: radix &precision: precision &forceSign: forceSign
 263   &groupSeparator: groupSeparator &decimal: decimalSep
 264 "Taken from 'Printing Floating-Point Numbers Quickly and Accurately',
 265  Robert G. Burger and R. Kent Dybvig, PLDI '96."
 266 [| digits significand exponent k b r s mUp mDown d decimal |
 267   radix `defaultsTo: o numberRadix.
 268   precision `defaultsTo: o numberPrecision.
 269   decimalSep `defaultsTo: '.'.
 270   significand := f significand.
 271   (exponent := f exponent) = (f bias * 2 + 1)
 272     ifTrue:
 273       [^ (o ; (f isNegative ifTrue: ['-'] ifFalse: ['+'])
 274             ; (significand isZero ifTrue: ['Inf'] ifFalse: ['NaN']))].
 275   exponent isZero
 276     ifTrue:
 277       [significand isZero ifTrue:
 278          [^ (o ; (f first isZero ifTrue: [''] ifFalse: ['-']) ; '0.0')].
 279        exponent := 1]
 280     ifFalse:
 281       [significand := (1 bitShift: f significandSize) bitOr: significand].
 282   b := 2.
 283   (exponent := exponent - f bias - f significandSize) isNegative
 284     ifTrue:
 285       [mDown := 1.
 286        exponent > (1 - f bias - f significandSize)
 287          /\ [significand = (1 bitShift: f significandSize)]
 288          ifTrue:
 289            [r := significand * b * 2.
 290             s := (1 bitShift: 1 - exponent) * 2.
 291             mUp := b]
 292          ifFalse:
 293            [r := significand * 2.
 294             s := (1 bitShift: exponent negated) * 2.
 295             mUp := 1]]
 296     ifFalse:
 297       [| be |
 298        be := 1 bitShift: exponent.
 299        significand = (1 bitShift: f significandSize)
 300          ifTrue:
 301            [r := significand * be * b * 2.
 302             s := b * 2.
 303             mUp := be * b.
 304             mDown := b]
 305          ifFalse:
 306            [r := significand * be * 2.
 307             s := 2.
 308             mUp := be.
 309             mDown := be]].
 310   k := (((significand + 1) ln + (exponent * b ln)) / radix ln) ceiling.
 311   [k >= 0
 312      ifTrue: [r + mUp > ((radix raisedTo: k) * s)]
 313      ifFalse: [(radix raisedTo: k negated) * (r + mUp) > s]]
 314     whileTrue:
 315       [k += 1].
 316   k >= 0
 317     ifTrue:
 318       [s *= (radix raisedTo: k)]
 319     ifFalse:
 320       [| bk |
 321        bk := radix raisedTo: k negated.
 322        r *= bk.
 323        mUp *= bk.
 324        mDown *= bk].
 325   digits := '' prettyPrinter.
 326   [d := r * radix // s.
 327    r := r * radix \\ s.
 328    mUp *= radix.
 329    mDown *= radix.
 330    r + mUp > s
 331      /\ [r >= mDown \/ [r * 2 >= s]]
 332      ifTrue: [d += 1].
 333    d printOn: digits &radix: radix.
 334    r < mDown \/ [r + mUp > s]
 335   ] whileFalse.
 336   digits := digits contents.
 337   f isNegative
 338     ifTrue: [o ; '-']
 339     ifFalse: [forceSign isNotNil /\ [forceSign] ifTrue: [o ; '+']].
 340   decimal := f abs < o floatMinimum \/ [f abs > o floatMaximum]
 341     ifTrue: [1]
 342     ifFalse: [k max: 0].
 343   o next: (decimal min: digits size) putAll: digits.
 344   (decimal - digits size max: 0)
 345     timesRepeat: [o ; '0'].
 346   decimal <= 0
 347     ifTrue:
 348       [o ; '0.'.
 349        (k negated max: 0)
 350          timesRepeat: [o ; '0']]
 351     ifFalse:
 352       [o ; decimalSep].
 353   decimal >= digits size
 354     ifTrue: [o ; '0']
 355     ifFalse:
 356       [o next: (precision min: digits size - decimal)
 357          putAll: digits
 358          startingAt: decimal].
 359   k = decimal \/ [decimal <= 0]
 360     ifFalse:
 361       [o ; 'e'.
 362        k - decimal printOn: o &radix: radix].
 363   o
 364 ].
 365
 366 f@(Float traits) as: _@(String traits)
 367 [
 368   f printString
 369 ].
 370
 371 x@(Association traits) printOn: o@(PrettyPrinterMixin traits)
 372 [
 373   x key printOn: o.
 374   o ; ' -> '.
 375   x value printOn: o.
 376 ].
 377
 378 c@(Collection traits) printContentsOn: o@(PrettyPrinterMixin traits) separatedBy: block &depth: depth
 379 "A generic iteration through the elements, with printing of each."
 380 [| index tally |
 381   (depth `defaultsTo: 3) isZero ifTrue:
 382     [^ Nil].
 383   tally := c size.
 384   index := 0.
 385   c do:
 386     [| :each |
 387      each printOn: o &depth: depth - 1.
 388      (index += 1) < tally
 389        ifTrue: [block do]].
 390   o
 391 ].
 392
 393 c@(Collection traits) printOn: o@(PrettyPrinterMixin traits) &depth: depth
 394 "The template for all collection object printing; this is only valid Slate
 395 input if the argument is a literal collection, such as an Array."
 396 [
 397   (depth `defaultsTo: 3) isZero ifTrue:
 398     [^ Nil].
 399   o ; '#('.
 400   (doPrintName ::= #printName isFoundOn: {c}) ifTrue:
 401     [o ; c printName].
 402   c isEmpty ifFalse:
 403     [doPrintName ifTrue:
 404        [o ; ' '].
 405      o level >= o nestingLimit ifTrue:
 406        [^ (o ; '...)')].
 407      o indentedDo:
 408        [| index |
 409         index := 0.
 410         c printContentsOn: o separatedBy:
 411           [o ; '.'.
 412            o newElement.
 413            index += 1.
 414            index >= o collectionLimit ifTrue:
 415              [o ; '...)'. ^ o]] &depth: depth - 1]].
 416   o ; ')'
 417 ].
 418
 419 c@(Array traits) printOn: o@(PrettyPrinterMixin traits) &depth: depth
 420 "The template for all collection object printing; this is only valid Slate
 421 input if the argument is a literal collection, such as an Array."
 422 [
 423   (depth `defaultsTo: 3) isZero ifTrue:
 424     [^ Nil].
 425   o ; '{'.
 426   (doPrintName ::= (c isSameAs: Array) not) ifTrue:
 427     [o ; c printName].
 428   c isEmpty ifFalse:
 429     [doPrintName ifTrue:
 430        [o ; ' '].
 431      o level >= o nestingLimit ifTrue:
 432        [^ (o ; '...}')].
 433      o indentedDo:
 434        [| index |
 435         index := 0.
 436         c printContentsOn: o separatedBy:
 437           [o ; '.'.
 438            o newElement.
 439            index += 1.
 440            index >= o collectionLimit ifTrue:
 441              [o ; '...}'. ^ o]] &depth: depth - 1]].
 442   o ; '}'
 443 ].
 444
 445 c@(Sequence traits) printContentsOn: o@(PrettyPrinterMixin traits) separatedBy: block &depth: depth
 446 "A basis for other printing methods."
 447 [
 448   (depth `defaultsTo: 3) isZero ifTrue:
 449     [^ Nil].
 450   c do: [| :each | each printOn: o &depth: depth] separatedBy: [block do].
 451   o
 452 ].
 453
 454 c@(Range traits) printContentsOn: o@(PrettyPrinterMixin traits) separatedBy: block
 455 "Print the start to end with ellipses and a fancy step indicator."
 456 [
 457   c start printOn: o.
 458   c end = PositiveInfinity
 459     ifTrue:
 460       [o ; ' ...']
 461     ifFalse:
 462       [o ; ' .. '.
 463        c end printOn: o].
 464   c step = 1
 465     ifFalse:
 466       [o ; ' by '.
 467        c step printOn: o].
 468   o
 469 ].
 470
 471 c@(LogicRange traits) printContentsOn: o@(PrettyPrinterMixin traits) separatedBy: block
 472 "Print the start to end with ellipses."
 473 [
 474   c start printOn: o.
 475   o ; ' ...'
 476 ].
 477
 478 c@(Dictionary traits) printContentsOn: o@(PrettyPrinterMixin traits) separatedBy: block
 479 "Print out the keys and values as Association constructors."
 480 [| index tally |
 481   index := 0.
 482   tally := 0.
 483   c keysAndValuesDo: [| :key :val | tally += 1].
 484   c keysAndValuesDo:
 485     [| :key :val |
 486      key printOn: o.
 487      o ; ' -> '.
 488      val printOn: o.
 489      (index += 1)
 490        < tally ifTrue: [block do]].
 491   o
 492 ].
 493
 494 c@(String Character traits) printOn: o@(PrettyPrinterMixin traits)
 495 "Consult the table of escapes, then handle normal printing."
 496 [
 497   o ; '$'.
 498   c caseOf:
 499     {
 500       $\' -> [o ; '\\\''].
 501       $\" -> [o ; '\\"'].
 502       $\t -> [o ; '\\t'].
 503       $\n -> [o ; '\\n'].
 504       $\v -> [o ; '\\v'].
 505       $\s -> [o ; '\\s'].
 506       $\f -> [o ; '\\f'].
 507       $\r -> [o ; '\\r'].
 508       $\b -> [o ; '\\b'].
 509       $\a -> [o ; '\\a'].
 510       $\e -> [o ; '\\e'].
 511       $\0 -> [o ; '\\0']
 512     }
 513     otherwise:
 514       [c isPrintable
 515          ifTrue: [o nextPut: c]
 516          ifFalse: "TODO: this is ASCII specific here. See below, too."
 517            [o ; '\\x'.
 518             (c as: Integer) // 16 printOn: o &radix: 16.
 519             (c as: Integer) \\ 16 printOn: o &radix: 16]].
 520   o
 521 ].
 522
 523 _@String printOn: o ['' printOn: o].
 524
 525 s@(String traits) printOn: o@(PrettyPrinterMixin traits)
 526 "Print the String readably, using escapes to preserve the contents."
 527 [
 528   o ; '\''.
 529   s doWithIndex:
 530     [| :c :index |
 531      o stringLimit ifNotNil:
 532        [index >= o stringLimit ifTrue: [o ; '...\''. ^ o]].
 533      c caseOf: {
 534        $\' -> [o ; '\\\''].
 535        $\t -> [o ; '\\t'].
 536        $\n -> [o ; '\\n'].
 537        $\v -> [o ; '\\v'].
 538        $\f -> [o ; '\\f'].
 539        $\r -> [o ; '\\r'].
 540        $\b -> [o ; '\\b'].
 541        $\a -> [o ; '\\a'].
 542        $\e -> [o ; '\\e'].
 543        $\0 -> [o ; '\\0'].
 544      } otherwise:
 545        [c isPrintable
 546           ifTrue: [o nextPut: c]
 547           ifFalse: "TODO: this is ASCII specific here"
 548             [o ; '\\x'.
 549              (c as: Integer) // 16 printOn: o &radix: 16.
 550              (c as: Integer) \\ 16 printOn: o &radix: 16]]].
 551   o ; '\''.
 552   o
 553 ].