extra/fuel/pprint/pprint.factor

   1 ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3
   4 USING: accessors arrays classes.tuple combinators continuations io
   5 kernel lexer math prettyprint quotations sequences source-files
   6 source-files.errors strings words ;
   7
   8 IN: fuel.pprint
   9
  10 GENERIC: fuel-pprint ( obj -- )
  11
  12 <PRIVATE
  13
  14 : fuel-maybe-scape ( ch -- seq )
  15     dup "\\\"?#()[]'`;." member? [ CHAR: \ swap 2array ] [ 1array ] if ;
  16
  17 SYMBOL: :restarts
  18
  19 : fuel-restarts ( obj -- seq )
  20     compute-restarts :restarts prefix ; inline
  21
  22 : fuel-pprint-sequence ( seq open close -- )
  23     [ write ] dip swap [ bl ] [ fuel-pprint ] interleave write ; inline
  24
  25 PRIVATE>
  26
  27 M: object fuel-pprint pprint ; inline
  28
  29 M: word fuel-pprint
  30     name>> V{ } clone [ fuel-maybe-scape append ] reduce >string write ;
  31
  32 M: f fuel-pprint drop "nil" write ; inline
  33
  34 M: integer fuel-pprint pprint ; inline
  35
  36 M: string fuel-pprint pprint ; inline
  37
  38 M: sequence fuel-pprint "(" ")" fuel-pprint-sequence ; inline
  39
  40 M: quotation fuel-pprint "[" "]" fuel-pprint-sequence ; inline
  41
  42 M: tuple fuel-pprint tuple>array fuel-pprint ; inline
  43
  44 M: continuation fuel-pprint drop ":continuation" write ; inline
  45
  46 M: restart fuel-pprint name>> fuel-pprint ; inline
  47
  48 M: condition fuel-pprint
  49     [ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
  50
  51 M: lexer-error fuel-pprint
  52     {
  53         [ line>> ]
  54         [ column>> ]
  55         [ line-text>> ]
  56         [ fuel-restarts ]
  57     } cleave 4array lexer-error prefix fuel-pprint ;
  58
  59 M: source-file-error fuel-pprint
  60     [ path>> ] [ error>> ] bi 2array source-file-error prefix
  61     fuel-pprint ;
  62
  63 M: source-file fuel-pprint path>> fuel-pprint ;