ps/types.ps

   1 % General functions
   2
   3 % concatenate: concatenate two strings or two arrays
   4 % From Thinking in PostScript 1990 Reid, Example 11.7
   5 % (string1) (string2) concatenate string3
   6 % array1 array2 concatenate array3
   7 /concatenate { %def
   8     dup type 2 index type 2 copy ne { %if
   9         pop pop
  10         errordict begin (concatenate) typecheck end
  11     }{ %else
  12         /stringtype ne exch /arraytype ne and {
  13             errordict begin (concatenate) typecheck end
  14         } if
  15     } ifelse
  16     dup length 2 index length add 1 index type
  17     /arraytype eq { array }{ string } ifelse
  18     % stack: arg1 arg2 new
  19     dup 0 4 index putinterval
  20     % stack: arg1 arg2 new
  21     dup 4 -1 roll length 4 -1 roll putinterval
  22     % stack: new
  23 } bind def
  24
  25 % reverse: array1 -> reverse -> array2
  26 /reverse {
  27     [ exch
  28     aload % push array onto stack
  29     length -1 0 { 1 roll } for % reverse
  30     ]
  31 } bind def
  32
  33 % string1 string2 string3 -> replace -> string4
  34 % Return a string4 with all occurrences of string2 in string1 replaced
  35 % with string3
  36 /replace { 4 dict begin
  37     /repstr exch def
  38     /needle exch def
  39     /haystack exch def
  40     /result () def
  41     { % loop
  42         haystack needle search
  43         { %if found
  44             % stack: post match pre
  45             repstr concatenate 3 1 roll pop % stack: pre+ post
  46             /haystack exch def % stack: pre+
  47             result exch concatenate /result exch def
  48         }{
  49             result exch concatenate /result exch def
  50             exit
  51         } ifelse
  52     } loop
  53     result
  54 end } def
  55
  56
  57 % objA objB -> _equal? -> bool
  58 /_equal? { 6 dict begin
  59     /b exch def
  60     /a exch def
  61
  62     a type b type eq
  63     a _sequential? b _sequential? and
  64     or not { %if type mismatch and not sequential
  65         false
  66     }{
  67         a _sequential? b _sequential? and { %if list/vector
  68             /ret true def
  69             a _count b _count eq not { %if length mismatch
  70                 /ret false def
  71             }{ %else (length is the same)
  72                 0 1 a _count 1 sub {
  73                     /idx exch def
  74                     a idx _nth b idx _nth _equal? not { %if not items _equal?
  75                         /ret false def
  76                         exit
  77                     } if
  78                 } for
  79             } ifelse
  80             ret
  81         }{ %else not list/vector
  82             a _hash_map? b _hash_map? and { %if hash_map
  83                 /ret true def
  84                 /a_keys a _keys def
  85                 a_keys _count b _keys _count eq not {
  86                     /ret false def
  87                 }{
  88                     a_keys /data get { %foreach key in a_keys
  89                         /key exch def
  90                         a key _hash_map_get b key _hash_map_get _equal? not { %if not items _equal?
  91                             /ret false def
  92                             exit
  93                         } if
  94                     } forall
  95                 } ifelse
  96                 ret
  97             }{ %else not hash_map
  98                 a b eq
  99             } ifelse
 100         } ifelse
 101     } ifelse
 102 end } def
 103
 104
 105 % Low-level sequence operations
 106
 107 /_sequential? { dup _list? exch _vector? or } def
 108
 109 /_count { /data get length } def
 110
 111 /_first {
 112     /data get
 113     dup length 0 gt { 0 get }{ pop null } ifelse
 114 } def
 115
 116 % seq start count -> _slice -> new_seq
 117 /_slice {
 118     3 -1 roll /data get 3 1 roll % stack: array start count
 119     getinterval
 120     _list_from_array
 121 } def
 122
 123 % seq idx -> _nth -> ith_item
 124 /_nth {
 125     exch /data get % stack: idx array
 126     dup length 0 gt { exch get }{ pop pop null } ifelse
 127 } def
 128
 129 % seq -> _rest -> rest_seq
 130 /_rest {
 131     /data get
 132     dup length 0 gt {
 133         dup length 1 sub 1 exch getinterval
 134     }{
 135         pop 0 array
 136     } ifelse
 137     _list_from_array
 138 } def
 139
 140 % hashmap -> _keys -> key_list
 141 /_keys {
 142     /data get
 143     [ exch { pop dup length string cvs } forall ]
 144     _list_from_array
 145 } def
 146
 147 % hashmap key -> _hash_map_get -> val
 148 /_hash_map_get {
 149     exch % stack: key hashmap
 150     /data get % stack: key dict
 151     exch % stack: dict key
 152     2 copy known { %if has key
 153         get
 154     }{
 155         pop pop null
 156     } ifelse
 157 } def
 158
 159
 160 % Errors/Exceptions
 161
 162 % data -> _throw ->
 163 % Takes arbitrary data and puts it in $error:/errorinfo. Then calls
 164 % stop to transfer control to end of nearest stopped context.
 165 /_throw {
 166     $error exch /errorinfo exch put
 167     $error /command /throw put
 168     stop
 169 } def
 170
 171 /errorinfo? {
 172     $error /errorinfo known { % if set
 173         $error /errorinfo get null ne {
 174             true
 175         }{
 176             false
 177         } ifelse
 178     }{
 179         false
 180     } ifelse
 181 } def
 182
 183 /get_error_data {
 184     errorinfo? { %if
 185         $error /errorinfo get
 186     }{
 187         $error /errorname get 255 string cvs
 188         (: )
 189         $error /command get 99 string cvs
 190         ( at )
 191         $error /position get 10 99 string cvrs
 192         concatenate
 193         concatenate
 194         concatenate
 195         concatenate
 196     } ifelse
 197 } def
 198
 199
 200 % Scalars
 201
 202 /_nil? { null eq } def
 203 /_true? { true eq } def
 204 /_false? { false eq } def
 205
 206
 207 % Symbols
 208
 209 /_symbol {
 210     dup length string copy cvn
 211 } def
 212
 213 /_symbol? {
 214     type /nametype eq
 215 } def
 216
 217
 218 % Keywords
 219
 220 /_keyword { 1 dict begin
 221     /str exch def
 222     str length 1 add string % str2
 223     dup 1 str putinterval
 224     dup 0 127 put % TODO: something like (\x029e) would be better
 225 end } def
 226
 227 /_keyword? {
 228     dup type /stringtype eq {
 229         0 get 127 eq
 230     }{
 231         pop false
 232     } ifelse
 233 } def
 234
 235
 236
 237 % Functions
 238
 239 % block -> _function -> boxed_function
 240 /_function {
 241     <<
 242         /_maltype_ /function
 243         %/data 5 -1 roll cvlit
 244         /data 5 -1 roll
 245     >>
 246     %%dup length dict copy
 247 } def
 248
 249 % ast env params -> _mal_function -> boxed_mal_function
 250 /_mal_function {
 251     <<
 252         /_maltype_ /mal_function % user defined function
 253         /macro? false % macro flag, false by default
 254         /params null % close over parameters
 255         /ast null    % close over ast
 256         /env null    % close over environment
 257         /data { __self__ fload EVAL }  % forward reference to EVAL
 258               dup length array copy cvx % actual copy/new instance of block
 259     >>
 260     % make an actual copy/new instance of dict
 261     dup length dict copy % stack: ast env params mal_fn
 262     % "Close over" parameters
 263     dup 3 -1 roll     % stack: ast env mal_fn mal_fn params
 264     /params exch put  % stack: ast env mal_fn
 265     dup 3 -1 roll     % stack: ast mal_fn mal_fn env
 266     /env exch put     % stack: ast mal_fn
 267     dup 3 -1 roll     % stack: mal_fn mal_fn ast
 268     /ast exch put     % stack: mal_fn
 269
 270     % insert self reference into position 0 of data
 271     dup /data get     % stack: mal_fn data
 272     1 index           % stack: mal_fn data mal_fn
 273     0 exch            % stack: mal_fn data 0 mal_fn
 274     put               % stack: mal_fn
 275 } def
 276
 277 /_function? {
 278     dup type /dicttype eq {
 279         /_maltype_ get /function eq
 280     }{
 281         pop false
 282     } ifelse
 283 } def
 284
 285 /_mal_function? {
 286     dup type /dicttype eq {
 287         /_maltype_ get /mal_function eq
 288     }{
 289         pop false
 290     } ifelse
 291 } def
 292
 293 % args mal_function -> fload -> ast new_env
 294 % fload: sets up arguments on the stack for an EVAL call
 295 /fload {
 296     dup /ast get 3 1 roll    % stack: ast args mal_function
 297     dup /env get 3 1 roll    % stack: ast env args mal_function
 298     /params get exch         % stack: ast env params args
 299     env_new                  % stack: ast new_env
 300 } def
 301
 302 % function_or_mal_function -> callable -> block
 303 % if this is a function or mal_function, get its executable block
 304 /callable {
 305     dup _mal_function? { %if mal_function
 306         /data get
 307     }{ dup _function? { %else if function
 308         /data get
 309     }{ %else something invalid
 310         (callable called on non-function!\n) print quit
 311         cvx
 312     } ifelse } ifelse
 313 } def
 314
 315
 316 % Lists
 317
 318 % array -> _list_from_array -> mal_list
 319 /_list_from_array {
 320     <<
 321         /data 3 -1 roll  % grab the array argument
 322         /_maltype_ /list
 323         /meta null
 324     >>
 325 } def
 326 % elem... cnt -> _list -> mal_list
 327 /_list {
 328     array astore _list_from_array
 329 } def
 330 /_list? {
 331     dup type /dicttype eq {
 332         /_maltype_ get /list eq
 333     }{
 334         pop false
 335     } ifelse
 336 } def
 337
 338
 339 % Vectors
 340
 341 % array -> _vector_from_array -> mal_vector
 342 /_vector_from_array {
 343     <<
 344         /data 3 -1 roll  % grab the array argument
 345         /_maltype_ /vector
 346         /meta null
 347     >>
 348 } def
 349 % elem... cnt -> _vector -> mal_vector
 350 /_vector {
 351     array astore _vector_from_array
 352 } def
 353 /_vector? {
 354     dup type /dicttype eq {
 355         /_maltype_ get /vector eq
 356     }{
 357         pop false
 358     } ifelse
 359 } def
 360
 361
 362 % Hash Maps
 363
 364 % dict -> _hash_map_from_dict -> mal_hash_map
 365 /_hash_map_from_dict {
 366     <<
 367         /data 3 -1 roll
 368         /_maltype_ /hash_map
 369         /meta null
 370     >>
 371 } def
 372 % array -> _hash_map_from_array -> mal_hash_map
 373 /_hash_map_from_array {
 374     <<
 375         /data <<
 376             4 -1 roll  % grab the array argument
 377             aload pop  % unpack the array
 378         >>
 379         /_maltype_ /hash_map
 380         /meta null
 381     >>
 382 } def
 383 % elem... cnt -> _hash_map -> mal_hash_map
 384 /_hash_map {
 385     array astore _hash_map_from_array
 386 } def
 387 /_hash_map? {
 388     dup type /dicttype eq {
 389         /_maltype_ get /hash_map eq
 390     }{
 391         pop false
 392     } ifelse
 393 } def
 394
 395
 396 % Atoms
 397
 398 % obj -> atom -> new_atom
 399 /_atom {
 400     <<
 401         /data 3 -1 roll
 402         /_maltype_ /atom
 403         /meta null
 404     >>
 405 } def
 406
 407 /_atom? {
 408     dup type /dicttype eq {
 409         /_maltype_ get /atom eq
 410     }{
 411         pop false
 412     } ifelse
 413 } def
 414
 415
 416
 417 % Sequence operations