ps/printer.ps

   1 % requires types.ps to be included first
   2
   3 % ast print_readably -> _pr_str -> string
   4 /_pr_str { 4 dict begin
   5     /print_readably exch def
   6     dup xcheck { (Cannot print proc: ) print dup == quit } if % assert
   7     /obj exch def
   8     obj _sequential? {
   9         obj _list? { (\() (\)) }{ ([) (]) } ifelse
  10         obj /data get ( ) print_readably _pr_str_args
  11         exch concatenate concatenate
  12     }{ obj _hash_map? {
  13         ({)
  14         % get array of contents with keys stringified
  15         [ obj /data get { exch dup length string cvs exch } forall ]
  16         ( ) print_readably _pr_str_args
  17         concatenate
  18         (}) concatenate
  19     }{ obj _function? { % if builtin function
  20         (<\(builtin_fn* {)
  21         obj /data get dup length array copy cvlit
  22         ( ) print_readably _pr_str_args
  23         (}>)
  24         concatenate concatenate
  25     }{ obj _mal_function? { % if user defined mal_function
  26         (<\(fn* )
  27         obj /params get print_readably _pr_str
  28         ( )
  29         obj /ast get print_readably _pr_str
  30         (\)>)
  31         concatenate concatenate concatenate concatenate
  32     }{ obj _atom? { % if atom
  33         (\(atom )
  34         obj /data get print_readably _pr_str
  35         (\))
  36         concatenate concatenate
  37     }{ /arraytype obj type eq { % if list or code block
  38         % accumulate an array of strings
  39         (\()
  40         obj ( ) print_readably _pr_str_args
  41         concatenate
  42         (\))
  43         concatenate
  44     }{ /integertype obj type eq { % if number
  45         /slen
  46           obj abs 1 max log floor cvi 1 add % positive size
  47           obj 0 lt { 1 add } if % account for sign
  48         def
  49         obj 10 slen string cvrs
  50     }{ /stringtype obj type eq { % if string
  51         obj length 0 gt { % if string length > 0
  52             obj 0 get 127 eq { %if starts with 0x7f (keyword)
  53                 obj dup length string copy
  54                 dup 0 58 put % 58 is ':'
  55             }{ print_readably {
  56                 (")
  57                 obj (\\) (\\\\) replace
  58                     (") (\\") replace
  59                     (\n) (\\n) replace
  60                 (") concatenate concatenate
  61             }{
  62                 obj
  63             } ifelse } ifelse
  64         }{ % else empty string
  65             print_readably {
  66                 ("")
  67             }{
  68                 obj
  69             } ifelse
  70         } ifelse
  71     }{ null obj eq { % if nil
  72         (nil)
  73     }{ true obj eq { % if true
  74         (true)
  75     }{ false obj eq { % if false
  76         (false)
  77     }{ /nametype obj type eq { % if symbol
  78         obj dup length string cvs
  79     }{
  80         (<unknown>)
  81     } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
  82 end } def
  83
  84 % array delim print_readably -> _pr_str_args -> new_string
  85 /_pr_str_args { 3 dict begin
  86     /print_readably exch def
  87     /delim exch def
  88     /args exch def
  89     ()
  90     args length 0 gt { %if any elements
  91         [
  92             args { %foreach argument in array
  93                 dup xcheck { %if executable
  94                     255 string cvs
  95                 }{
  96                     print_readably _pr_str
  97                 } ifelse
  98             } forall
  99         ]
 100         { concatenate delim concatenate } forall
 101         dup length delim length sub 0 exch getinterval % strip off final delim
 102     } if
 103 end } def
 104
 105 % utility function
 106 /print_dict {
 107     (DICT contents:\n) print
 108     {
 109         (  - ) print
 110         exch dup length string cvs print % key
 111         (: ) print
 112         ==
 113     } forall
 114 } def
 115