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 obj abs log ceiling cvi 2 add def
  46         obj 10 slen string cvrs
  47     }{ /stringtype obj type eq { % if string
  48         obj length 0 gt { % if string length > 0
  49             obj 0 get 127 eq { %if starts with 0x7f (keyword)
  50                 obj dup length string copy
  51                 dup 0 58 put % 58 is ':'
  52             }{ print_readably {
  53                 (")
  54                 obj (\\) (\\\\) replace
  55                     (") (\\") replace
  56                     (\n) (\\n) replace
  57                 (") concatenate concatenate
  58             }{
  59                 obj
  60             } ifelse } ifelse
  61         }{ % else empty string
  62             print_readably {
  63                 ("")
  64             }{
  65                 obj
  66             } ifelse
  67         } ifelse
  68     }{ null obj eq { % if nil
  69         (nil)
  70     }{ true obj eq { % if true
  71         (true)
  72     }{ false obj eq { % if false
  73         (false)
  74     }{ /nametype obj type eq { % if symbol
  75         obj dup length string cvs
  76     }{
  77         (<unknown>)
  78     } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
  79 end } def
  80
  81 % array delim print_readably -> _pr_str_args -> new_string
  82 /_pr_str_args { 3 dict begin
  83     /print_readably exch def
  84     /delim exch def
  85     /args exch def
  86     ()
  87     args length 0 gt { %if any elements
  88         [
  89             args { %foreach argument in array
  90                 dup xcheck { %if executable
  91                     255 string cvs
  92                 }{
  93                     print_readably _pr_str
  94                 } ifelse
  95             } forall
  96         ]
  97         { concatenate delim concatenate } forall
  98         dup length delim length sub 0 exch getinterval % strip off final delim
  99     } if
 100 end } def
 101
 102 % utility function
 103 /print_dict {
 104     (DICT contents:\n) print
 105     {
 106         (  - ) print
 107         exch dup length string cvs print % key
 108         (: ) print
 109         ==
 110     } forall
 111 } def
 112