ps/types.ps

   1 (in types.ps\n) print
   2
   3 % General functions
   4
   5 % concatenate: concatenate two strings or two arrays
   6 % From Thinking in PostScript 1990 Reid, Example 11.7
   7 % (string1) (string2) concatenate string3
   8 % array1 array2 concatenate array3
   9 /concatenate { %def
  10     dup type 2 index type 2 copy ne { %if
  11         pop pop
  12         errordict begin (concatenate) typecheck end
  13     }{ %else
  14         /stringtype ne exch /arraytype ne and {
  15             errordict begin (concatenate) typecheck end
  16         } if
  17     } ifelse
  18     dup length 2 index length add 1 index type
  19     /arraytype eq { array }{ string } ifelse
  20     % stack: arg1 arg2 new
  21     dup 0 4 index putinterval
  22     % stack: arg1 arg2 new
  23     dup 4 -1 roll length 4 -1 roll putinterval
  24     % stack: new
  25 } bind def
  26
  27 % reverse: array1 -> reverse -> array2
  28 /reverse {
  29     [ exch
  30     aload % push array onto stack
  31     length -1 0 { 1 roll } for % reverse
  32     ]
  33 } bind def
  34
  35 % string1 string2 string3 -> replace -> string4
  36 % Return a string4 with all occurrences of string2 in string1 replaced
  37 % with string3
  38 /replace { 4 dict begin
  39     /repstr exch def
  40     /needle exch def
  41     /haystack exch def
  42     /result () def
  43     { % loop
  44         haystack needle search
  45         { %if found
  46             % stack: post match pre
  47             repstr concatenate 3 1 roll pop % stack: pre+ post
  48             /haystack exch def % stack: pre+
  49             result exch concatenate /result exch def
  50         }{
  51             result exch concatenate /result exch def
  52             exit
  53         } ifelse
  54     } loop
  55     result
  56 end } def
  57
  58
  59 % objA objB -> _equal? -> bool
  60 /_equal? { 6 dict begin
  61     /b exch def
  62     /a exch def
  63     /ota a type def
  64     /otb b type def
  65
  66     a type b type eq
  67     a _sequential? b _sequential? and
  68     or not { %if type mismatch and not sequential
  69         false
  70     }{
  71         a _sequential? { %if list
  72             /ret true def
  73             a _count b _count eq not { %if length mismatch
  74                 /ret false def
  75             }{ %else (length is the same)
  76                 0 1 a _count 1 sub {
  77                     /idx exch def
  78                     a idx _nth b idx _nth _equal? not { %if not items _equal?
  79                         /ret false def
  80                         exit
  81                     } if
  82                 } for
  83             } ifelse
  84             ret
  85         }{ %else not a list
  86             a b eq
  87         } ifelse
  88     } ifelse
  89 end } def
  90
  91
  92 % Low-level sequence operations
  93
  94 /_sequential? { dup _list? exch _vector? or } def
  95
  96 /_count { /data get length } def
  97
  98 /_first {
  99     /data get
 100     dup length 0 gt { 0 get }{ pop null } ifelse
 101 } def
 102
 103 % seq start count -> _slice -> new_seq
 104 /_slice {
 105     3 -1 roll /data get 3 1 roll % stack: array start count
 106     getinterval
 107     _list_from_array
 108 } def
 109
 110 % seq idx -> _nth -> ith_item
 111 /_nth {
 112     exch /data get % stack: idx array
 113     dup length 0 gt { exch get }{ pop pop null } ifelse
 114 } def
 115
 116 % seq -> _rest -> rest_seq
 117 /_rest {
 118     /data get
 119     dup length 0 gt {
 120         dup length 1 sub 1 exch getinterval
 121     }{
 122         pop 0 array
 123     } ifelse
 124     _list_from_array
 125 } def
 126
 127
 128
 129 % Errors/Exceptions
 130
 131 % data -> _throw ->
 132 % Takes arbitrary data and puts it in $error:/errorinfo. Then calls
 133 % stop to transfer control to end of nearest stopped context.
 134 /_throw {
 135     $error exch /errorinfo exch put
 136     $error /command /throw put
 137     stop
 138 } def
 139
 140 /errorinfo? {
 141     $error /errorinfo known { % if set
 142         $error /errorinfo get null ne {
 143             true
 144         }{
 145             false
 146         } ifelse
 147     }{
 148         false
 149     } ifelse
 150 } def
 151
 152 /get_error_data {
 153     errorinfo? { %if
 154         $error /errorinfo get
 155     }{
 156         $error /errorname get 255 string cvs
 157         (: )
 158         $error /command get 99 string cvs
 159         ( at )
 160         $error /position get 10 99 string cvrs
 161         concatenate
 162         concatenate
 163         concatenate
 164         concatenate
 165     } ifelse
 166 } def
 167
 168
 169 % Scalars
 170
 171 /_nil? { null eq } def
 172 /_true? { true eq } def
 173 /_false? { false eq } def
 174
 175
 176 % Symbols
 177
 178 /_symbol? {
 179     type /nametype eq
 180 } def
 181
 182
 183 % Functions
 184
 185 /_mal_function? {
 186     dup type /dicttype eq {
 187         /_maltype_ get /function eq
 188     }{
 189         pop false
 190     } ifelse
 191 } def
 192
 193 % args mal_function -> fload -> ast new_env
 194 % fload: sets up arguments on the stack for an EVAL call
 195 /fload {
 196     dup /ast get 3 1 roll    % stack: ast args mal_function
 197     dup /env get 3 1 roll    % stack: ast env args mal_function
 198     /params get exch         % stack: ast env params args
 199     env_new                  % stack: ast new_env
 200 } def
 201
 202 % function_or_block -> callable -> block
 203 % if this is a user defined mal function, get its executable block
 204 /callable { dup _mal_function? { /data get } if } def
 205
 206
 207 % Lists
 208
 209 % array -> _list_from_array -> mal_list
 210 /_list_from_array {
 211     <<
 212         /data 3 -1 roll  % grab the array argument
 213         /_maltype_ /list
 214         /meta null
 215     >>
 216 } def
 217 % elem... cnt -> _list -> mal_list
 218 /_list {
 219     array astore _list_from_array
 220 } def
 221 /_list? {
 222     dup type /dicttype eq {
 223         /_maltype_ get /list eq
 224     }{
 225         pop false
 226     } ifelse
 227 } def
 228
 229
 230 % Vectors
 231
 232 % array -> _vector_from_array -> mal_vector
 233 /_vector_from_array {
 234     <<
 235         /data 3 -1 roll  % grab the array argument
 236         /_maltype_ /vector
 237         /meta null
 238     >>
 239 } def
 240 % elem... cnt -> _vector -> mal_vector
 241 /_vector {
 242     array astore _vector_from_array
 243 } def
 244 /_vector? {
 245     dup type /dicttype eq {
 246         /_maltype_ get /vector eq
 247     }{
 248         pop false
 249     } ifelse
 250 } def
 251
 252
 253 % Hash Maps
 254
 255 % dict -> _hash_map_from_dict -> mal_hash_map
 256 /_hash_map_from_dict {
 257     <<
 258         /data 3 -1 roll
 259         /_maltype_ /hash_map
 260         /meta null
 261     >>
 262 } def
 263 % array -> _hash_map_from_array -> mal_hash_map
 264 /_hash_map_from_array {
 265     <<
 266         /data <<
 267             4 -1 roll  % grab the array argument
 268             aload pop  % unpack the array
 269         >>
 270         /_maltype_ /hash_map
 271         /meta null
 272     >>
 273 } def
 274 % elem... cnt -> _hash_map -> mal_hash_map
 275 /_hash_map {
 276     array astore _hash_map_from_array
 277 } def
 278 /_hash_map? {
 279     dup type /dicttype eq {
 280         /_maltype_ get /hash_map eq
 281     }{
 282         pop false
 283     } ifelse
 284 } def
 285
 286
 287 % Atoms
 288
 289 % obj -> atom -> new_atom
 290 /_atom {
 291     <<
 292         /data 3 -1 roll
 293         /_maltype_ /atom
 294         /meta null
 295     >>
 296 } def
 297
 298 /_atom? {
 299     dup type /dicttype eq {
 300         /_maltype_ get /atom eq
 301     }{
 302         pop false
 303     } ifelse
 304 } def
 305
 306
 307
 308 % Sequence operations