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 /_string? {
 206     dup type /stringtype eq {
 207         dup length 0 eq { % if length == 0
 208             pop true
 209         }{
 210             0 get 127 eq not
 211         } ifelse
 212     }{
 213         pop false
 214     } ifelse
 215 } def
 216
 217
 218 % Symbols
 219
 220 /_symbol {
 221     dup length string copy cvn
 222 } def
 223
 224 /_symbol? {
 225     type /nametype eq
 226 } def
 227
 228
 229 % Keywords
 230
 231 /_keyword { 1 dict begin
 232     /str exch def
 233     str length 1 add string % str2
 234     dup 1 str putinterval
 235     dup 0 127 put % TODO: something like (\x029e) would be better
 236 end } def
 237
 238 /_keyword? {
 239     dup type /stringtype eq {
 240         dup length 0 eq { % if length == 0
 241             pop false
 242         }{
 243             0 get 127 eq
 244         } ifelse
 245     }{
 246         pop false
 247     } ifelse
 248 } def
 249
 250
 251
 252 % Functions
 253
 254 % block -> _function -> boxed_function
 255 /_function {
 256     <<
 257         /_maltype_ /function
 258         %/data 5 -1 roll cvlit
 259         /data 5 -1 roll
 260     >>
 261     %%dup length dict copy
 262 } def
 263
 264 % ast env params -> _mal_function -> boxed_mal_function
 265 /_mal_function {
 266     <<
 267         /_maltype_ /mal_function % user defined function
 268         /macro? false % macro flag, false by default
 269         /params null % close over parameters
 270         /ast null    % close over ast
 271         /env null    % close over environment
 272         /data { __self__ fload EVAL }  % forward reference to EVAL
 273               dup length array copy cvx % actual copy/new instance of block
 274     >>
 275     % make an actual copy/new instance of dict
 276     dup length dict copy % stack: ast env params mal_fn
 277     % "Close over" parameters
 278     dup 3 -1 roll     % stack: ast env mal_fn mal_fn params
 279     /params exch put  % stack: ast env mal_fn
 280     dup 3 -1 roll     % stack: ast mal_fn mal_fn env
 281     /env exch put     % stack: ast mal_fn
 282     dup 3 -1 roll     % stack: mal_fn mal_fn ast
 283     /ast exch put     % stack: mal_fn
 284
 285     % insert self reference into position 0 of data
 286     dup /data get     % stack: mal_fn data
 287     1 index           % stack: mal_fn data mal_fn
 288     0 exch            % stack: mal_fn data 0 mal_fn
 289     put               % stack: mal_fn
 290 } def
 291
 292 /_function? {
 293     dup type /dicttype eq {
 294         /_maltype_ get /function eq
 295     }{
 296         pop false
 297     } ifelse
 298 } def
 299
 300 /_mal_function? {
 301     dup type /dicttype eq {
 302         /_maltype_ get /mal_function eq
 303     }{
 304         pop false
 305     } ifelse
 306 } def
 307
 308 % args mal_function -> fload -> ast new_env
 309 % fload: sets up arguments on the stack for an EVAL call
 310 /fload {
 311     dup /ast get 3 1 roll    % stack: ast args mal_function
 312     dup /env get 3 1 roll    % stack: ast env args mal_function
 313     /params get exch         % stack: ast env params args
 314     env_new                  % stack: ast new_env
 315 } def
 316
 317 % function_or_mal_function -> callable -> block
 318 % if this is a function or mal_function, get its executable block
 319 /callable {
 320     dup _mal_function? { %if mal_function
 321         /data get
 322     }{ dup _function? { %else if function
 323         /data get
 324     }{ %else something invalid
 325         (callable called on non-function!\n) print quit
 326         cvx
 327     } ifelse } ifelse
 328 } def
 329
 330
 331 % Lists
 332
 333 % array -> _list_from_array -> mal_list
 334 /_list_from_array {
 335     <<
 336         /data 3 -1 roll  % grab the array argument
 337         /_maltype_ /list
 338         /meta null
 339     >>
 340 } def
 341 % elem... cnt -> _list -> mal_list
 342 /_list {
 343     array astore _list_from_array
 344 } def
 345 /_list? {
 346     dup type /dicttype eq {
 347         /_maltype_ get /list eq
 348     }{
 349         pop false
 350     } ifelse
 351 } def
 352
 353
 354 % Vectors
 355
 356 % array -> _vector_from_array -> mal_vector
 357 /_vector_from_array {
 358     <<
 359         /data 3 -1 roll  % grab the array argument
 360         /_maltype_ /vector
 361         /meta null
 362     >>
 363 } def
 364 % elem... cnt -> _vector -> mal_vector
 365 /_vector {
 366     array astore _vector_from_array
 367 } def
 368 /_vector? {
 369     dup type /dicttype eq {
 370         /_maltype_ get /vector eq
 371     }{
 372         pop false
 373     } ifelse
 374 } def
 375
 376
 377 % Hash Maps
 378
 379 % dict -> _hash_map_from_dict -> mal_hash_map
 380 /_hash_map_from_dict {
 381     <<
 382         /data 3 -1 roll
 383         /_maltype_ /hash_map
 384         /meta null
 385     >>
 386 } def
 387 % array -> _hash_map_from_array -> mal_hash_map
 388 /_hash_map_from_array {
 389     <<
 390         /data <<
 391             4 -1 roll  % grab the array argument
 392             aload pop  % unpack the array
 393         >>
 394         /_maltype_ /hash_map
 395         /meta null
 396     >>
 397 } def
 398 % elem... cnt -> _hash_map -> mal_hash_map
 399 /_hash_map {
 400     array astore _hash_map_from_array
 401 } def
 402 /_hash_map? {
 403     dup type /dicttype eq {
 404         /_maltype_ get /hash_map eq
 405     }{
 406         pop false
 407     } ifelse
 408 } def
 409
 410
 411 % Atoms
 412
 413 % obj -> atom -> new_atom
 414 /_atom {
 415     <<
 416         /data 3 -1 roll
 417         /_maltype_ /atom
 418         /meta null
 419     >>
 420 } def
 421
 422 /_atom? {
 423     dup type /dicttype eq {
 424         /_maltype_ get /atom eq
 425     }{
 426         pop false
 427     } ifelse
 428 } def
 429
 430
 431
 432 % Sequence operations