forth/printer.fs

   1 require str.fs
   2 require types.fs
   3
   4 \ === printer protocol and implementations === /
   5
   6 def-protocol-method pr-buf ( readably? str-addr str-len this -- str-addr str-len )
   7 def-protocol-method pr-seq-buf ( readably? str-addr str-len this -- str-addr str-len )
   8
   9 : pr-str { obj }
  10     true new-str obj pr-buf rot drop ;
  11
  12 \ Examples of extending existing protocol methods to existing type
  13 MalDefault
  14   extend pr-buf
  15     { this }
  16     s" #<" str-append
  17     this mal-type @ type-name str-append
  18     a-space
  19     this int>str str-append
  20     s" >" str-append ;;
  21 drop
  22
  23 MalNil   extend pr-buf drop s" nil"   str-append ;; drop
  24 MalTrue  extend pr-buf drop s" true"  str-append ;; drop
  25 MalFalse extend pr-buf drop s" false" str-append ;; drop
  26
  27 MalList
  28   extend pr-buf
  29     -rot s" (" str-append ( list str-addr str-len )
  30     rot pr-seq-buf
  31     s" )" str-append ;;
  32   extend pr-seq-buf { list }
  33     list MalList/count @ 0 > if
  34         list MalList/start @ { start }
  35         start @ pr-buf
  36         list MalList/count @ 1 ?do
  37             a-space
  38             start i cells + @ pr-buf
  39         loop
  40     endif ;;
  41 drop
  42
  43 MalVector
  44   extend pr-buf
  45     MalVector/list @
  46     -rot s" [" str-append ( list str-addr str-len )
  47     rot pr-seq-buf
  48     s" ]" str-append ;;
  49 drop
  50
  51 MalMap
  52   extend pr-buf
  53     MalMap/list @
  54     -rot s" {" str-append ( list str-addr str-len )
  55     rot { list }
  56     list MalList/count @ { count }
  57     count 0 > if
  58         list MalList/start @ { start }
  59         start @ pr-buf a-space start cell+ @ pr-buf
  60         count 2 / 1 ?do
  61             a-space
  62             start i 2 * cells + @ pr-buf a-space
  63             start i 2 * 1+ cells + @ pr-buf
  64         loop
  65     endif
  66     s" }" str-append ;;
  67 drop
  68
  69 MalInt
  70   extend pr-buf
  71     MalInt/int @ int>str str-append ;;
  72 drop
  73
  74 MalSymbol
  75   extend pr-buf
  76     unpack-sym str-append ;;
  77 drop
  78
  79 MalKeyword
  80   extend pr-buf { kw }
  81     s" :" str-append
  82     kw unpack-keyword str-append ;;
  83 drop
  84
  85 : escape-str { addr len }
  86     s\" \"" str-append
  87     addr len +  addr  ?do
  88         i c@ case
  89             [char] " of s\" \\\"" str-append endof
  90             [char] \ of s\" \\\\" str-append endof
  91             10 of s\" \\n" str-append endof
  92             13 of s\" \\r" str-append endof
  93             -rot i 1 str-append rot
  94         endcase
  95     loop
  96     s\" \"" str-append ;
  97
  98 MalString
  99   extend pr-buf
 100     dup MalString/str-addr @
 101     swap MalString/str-len @
 102     4 pick if
 103         escape-str
 104     else
 105         str-append
 106     endif ;;
 107 drop
 108
 109 Atom
 110   extend pr-buf { this }
 111     s" (atom " str-append
 112     this Atom/val @ pr-buf
 113     s" )" str-append ;;
 114 drop