extra/cursors/cursors.factor

   1 ! Copyright (C) 2010 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs combinators.short-circuit fry
   4 generalizations hash-sets hashtables kernel macros math
   5 math.functions math.order sequences sets ;
   6 FROM: sequences.private => nth-unsafe set-nth-unsafe ;
   7 FROM: hashtables.private => tombstone? ;
   8 IN: cursors
   9
  10 !
  11 ! basic cursor protocol
  12 !
  13
  14 MIXIN: cursor
  15
  16 GENERIC: cursor-compatible? ( cursor cursor -- ? )
  17 GENERIC: cursor-valid? ( cursor -- ? )
  18 GENERIC: cursor= ( cursor cursor -- ? )
  19 GENERIC: cursor<= ( cursor cursor -- ? )
  20 GENERIC: cursor>= ( cursor cursor -- ? )
  21 GENERIC: cursor-distance-hint ( cursor cursor -- n )
  22
  23 M: cursor cursor<= cursor= ; inline
  24 M: cursor cursor>= cursor= ; inline
  25 M: cursor cursor-distance-hint 2drop 0 ; inline
  26
  27 !
  28 ! cursor iteration
  29 !
  30
  31 MIXIN: forward-cursor
  32 INSTANCE: forward-cursor cursor
  33
  34 GENERIC: inc-cursor ( cursor -- cursor' )
  35
  36 MIXIN: bidirectional-cursor
  37 INSTANCE: bidirectional-cursor forward-cursor
  38
  39 GENERIC: dec-cursor ( cursor -- cursor' )
  40
  41 MIXIN: random-access-cursor
  42 INSTANCE: random-access-cursor bidirectional-cursor
  43
  44 GENERIC#: cursor+ 1 ( cursor n -- cursor' )
  45 GENERIC#: cursor- 1 ( cursor n -- cursor' )
  46 GENERIC: cursor-distance ( cursor cursor -- n )
  47 GENERIC: cursor<  ( cursor cursor -- ? )
  48 GENERIC: cursor>  ( cursor cursor -- ? )
  49
  50 M: random-access-cursor inc-cursor  1 cursor+ ; inline
  51 M: random-access-cursor dec-cursor -1 cursor+ ; inline
  52 M: random-access-cursor cursor- neg cursor+ ; inline
  53 M: random-access-cursor cursor<= { [ cursor= ] [ cursor< ] } 2|| ; inline
  54 M: random-access-cursor cursor>= { [ cursor= ] [ cursor> ] } 2|| ; inline
  55 M: random-access-cursor cursor-distance-hint cursor-distance ; inline
  56
  57 !
  58 ! input cursors
  59 !
  60
  61 ERROR: invalid-cursor cursor ;
  62
  63 MIXIN: input-cursor
  64
  65 GENERIC: cursor-key-value ( cursor -- key value )
  66 <PRIVATE
  67 GENERIC: cursor-key-value-unsafe ( cursor -- key value )
  68 PRIVATE>
  69 M: input-cursor cursor-key-value-unsafe cursor-key-value ; inline
  70 M: input-cursor cursor-key-value
  71     dup cursor-valid?
  72     [ cursor-key-value-unsafe ]
  73     [ invalid-cursor ] if ; inline
  74
  75 : cursor-key ( cursor -- key ) cursor-key-value drop ;
  76 : cursor-value ( cursor -- key ) cursor-key-value nip ;
  77
  78 : cursor-key-unsafe ( cursor -- key ) cursor-key-value-unsafe drop ;
  79 : cursor-value-unsafe ( cursor -- key ) cursor-key-value-unsafe nip ;
  80
  81 !
  82 ! output cursors
  83 !
  84
  85 MIXIN: output-cursor
  86
  87 GENERIC: set-cursor-value ( value cursor -- )
  88 <PRIVATE
  89 GENERIC: set-cursor-value-unsafe ( value cursor -- )
  90 PRIVATE>
  91 M: output-cursor set-cursor-value-unsafe set-cursor-value ; inline
  92 M: output-cursor set-cursor-value
  93     dup cursor-valid?
  94     [ set-cursor-value-unsafe ]
  95     [ invalid-cursor ] if ; inline
  96
  97 !
  98 ! stream cursors
  99 !
 100
 101 MIXIN: stream-cursor
 102 INSTANCE: stream-cursor forward-cursor
 103
 104 M: stream-cursor cursor-compatible? 2drop f ; inline
 105 M: stream-cursor cursor-valid? drop t ; inline
 106 M: stream-cursor cursor= 2drop f ; inline
 107
 108 MIXIN: infinite-stream-cursor
 109 INSTANCE: infinite-stream-cursor stream-cursor
 110
 111 M: infinite-stream-cursor inc-cursor ; inline
 112
 113 MIXIN: finite-stream-cursor
 114 INSTANCE: finite-stream-cursor stream-cursor
 115
 116 SINGLETON: end-of-stream
 117
 118 GENERIC: cursor-stream-ended? ( cursor -- ? )
 119
 120 M: finite-stream-cursor inc-cursor
 121     dup cursor-stream-ended? [ drop end-of-stream ] when ; inline
 122
 123 INSTANCE: end-of-stream finite-stream-cursor
 124
 125 M: end-of-stream cursor-compatible? drop finite-stream-cursor? ; inline
 126 M: end-of-stream cursor-valid? drop f ; inline
 127 M: end-of-stream cursor= eq? ; inline
 128 M: end-of-stream inc-cursor ; inline
 129 M: end-of-stream cursor-stream-ended? drop t ; inline
 130
 131 !
 132 ! basic iterators
 133 !
 134
 135 : -each ( ... begin end quot: ( ... cursor -- ... ) -- ... )
 136     [ '[ dup _ cursor>= ] ]
 137     [ '[ _ keep inc-cursor ] ] bi* until drop ; inline
 138
 139 : -find ( ... begin end quot: ( ... cursor -- ... ? ) -- ... cursor )
 140     '[ dup _ cursor>= [ t ] [ dup @ ] if ] [ inc-cursor ] until ; inline
 141
 142 : -in- ( quot -- quot' )
 143     '[ cursor-value-unsafe @ ] ; inline
 144
 145 : -out- ( quot -- quot' )
 146     '[ _ keep set-cursor-value-unsafe ] ; inline
 147
 148 : -out ( ... begin end quot: ( ... cursor -- ... value ) -- ... )
 149     -out- -each ; inline
 150
 151 !
 152 ! numeric cursors
 153 !
 154
 155 TUPLE: numeric-cursor
 156     { value read-only } ;
 157
 158 M: numeric-cursor cursor-valid? drop t ; inline
 159
 160 M: numeric-cursor cursor=  [ value>> ] bi@ =  ; inline
 161
 162 M: numeric-cursor cursor<= [ value>> ] bi@ <= ; inline
 163 M: numeric-cursor cursor<  [ value>> ] bi@ <  ; inline
 164 M: numeric-cursor cursor>  [ value>> ] bi@ >  ; inline
 165 M: numeric-cursor cursor>= [ value>> ] bi@ >= ; inline
 166
 167 INSTANCE: numeric-cursor input-cursor
 168
 169 M: numeric-cursor cursor-key-value value>> dup ; inline
 170
 171 !
 172 ! linear cursor
 173 !
 174
 175 TUPLE: linear-cursor < numeric-cursor
 176     { delta read-only } ;
 177 C: <linear-cursor> linear-cursor
 178
 179 INSTANCE: linear-cursor random-access-cursor
 180
 181 M: linear-cursor cursor-compatible?
 182     [ linear-cursor? ] both? ; inline
 183
 184 M: linear-cursor inc-cursor
 185     [ value>> ] [ delta>> ] bi [ + ] keep <linear-cursor> ; inline
 186 M: linear-cursor dec-cursor
 187     [ value>> ] [ delta>> ] bi [ - ] keep <linear-cursor> ; inline
 188 M: linear-cursor cursor+
 189     [ [ value>> ] [ delta>> ] bi ] dip [ * + ] keep <linear-cursor> ; inline
 190 M: linear-cursor cursor-
 191     [ [ value>> ] [ delta>> ] bi ] dip [ * - ] keep <linear-cursor> ; inline
 192
 193 GENERIC: up/i ( distance delta -- distance' )
 194 M: integer up/i [ 1 - + ] keep /i ; inline
 195 M: real up/i / ceiling >integer ; inline
 196
 197 M: linear-cursor cursor-distance
 198     [ [ value>> ] bi@ - ] [ nip delta>> ] 2bi up/i ; inline
 199
 200 !
 201 ! quadratic cursor
 202 !
 203
 204 TUPLE: quadratic-cursor < numeric-cursor
 205     { delta read-only }
 206     { delta2 read-only } ;
 207
 208 C: <quadratic-cursor> quadratic-cursor
 209
 210 INSTANCE: quadratic-cursor bidirectional-cursor
 211
 212 M: quadratic-cursor cursor-compatible?
 213     [ linear-cursor? ] both? ; inline
 214
 215 M: quadratic-cursor inc-cursor
 216     [ value>> ] [ delta>> [ + ] keep ] [ delta2>> [ + ] keep ] tri <quadratic-cursor> ; inline
 217
 218 M: quadratic-cursor dec-cursor
 219     [ value>> ] [ delta>> ] [ delta2>> ] tri [ - [ - ] keep ] keep <quadratic-cursor> ; inline
 220
 221 !
 222 ! collections
 223 !
 224
 225 MIXIN: collection
 226
 227 GENERIC: begin-cursor ( collection -- cursor )
 228 GENERIC: end-cursor ( collection -- cursor )
 229
 230 : all ( collection -- begin end )
 231     [ begin-cursor ] [ end-cursor ] bi ; inline
 232
 233 : all- ( collection quot -- begin end quot )
 234     [ all ] dip ; inline
 235
 236 !
 237 ! containers
 238 !
 239
 240 MIXIN: container
 241 INSTANCE: container collection
 242
 243 : in- ( container quot -- begin end quot' )
 244     all- -in- ; inline
 245
 246 : each ( ... container quot: ( ... x -- ... ) -- ... ) in- -each ; inline
 247
 248 INSTANCE: finite-stream-cursor container
 249
 250 M: finite-stream-cursor begin-cursor ; inline
 251 M: finite-stream-cursor end-cursor drop end-of-stream ; inline
 252
 253 !
 254 ! sequence cursor
 255 !
 256
 257 TUPLE: sequence-cursor
 258     { seq read-only }
 259     { n fixnum read-only } ;
 260 C: <sequence-cursor> sequence-cursor
 261
 262 INSTANCE: sequence container
 263
 264 M: sequence begin-cursor 0 <sequence-cursor> ; inline
 265 M: sequence end-cursor dup length <sequence-cursor> ; inline
 266
 267 INSTANCE: sequence-cursor random-access-cursor
 268
 269 M: sequence-cursor cursor-compatible?
 270     {
 271         [ [ sequence-cursor? ] both? ]
 272         [ [ seq>> ] bi@ eq? ]
 273     } 2&& ; inline
 274
 275 M: sequence-cursor cursor-valid?
 276     [ n>> ] [ seq>> ] bi bounds-check? ; inline
 277
 278 M: sequence-cursor cursor=  [ n>> ] bi@ =  ; inline
 279 M: sequence-cursor cursor<= [ n>> ] bi@ <= ; inline
 280 M: sequence-cursor cursor>= [ n>> ] bi@ >= ; inline
 281 M: sequence-cursor cursor<  [ n>> ] bi@ <  ; inline
 282 M: sequence-cursor cursor>  [ n>> ] bi@ >  ; inline
 283 M: sequence-cursor inc-cursor [ seq>> ] [ n>> ] bi 1 + <sequence-cursor> ; inline
 284 M: sequence-cursor dec-cursor [ seq>> ] [ n>> ] bi 1 - <sequence-cursor> ; inline
 285 M: sequence-cursor cursor+ [ [ seq>> ] [ n>> ] bi ] dip + <sequence-cursor> ; inline
 286 M: sequence-cursor cursor- [ [ seq>> ] [ n>> ] bi ] dip - <sequence-cursor> ; inline
 287 M: sequence-cursor cursor-distance ( cursor cursor -- n )
 288     [ n>> ] bi@ - ; inline
 289
 290 INSTANCE: sequence-cursor input-cursor
 291
 292 M: sequence-cursor cursor-key-value-unsafe [ n>> dup ] [ seq>> ] bi nth-unsafe ; inline
 293 M: sequence-cursor cursor-key-value [ n>> dup ] [ seq>> ] bi nth ; inline
 294
 295 INSTANCE: sequence-cursor output-cursor
 296
 297 M: sequence-cursor set-cursor-value-unsafe [ n>> ] [ seq>> ] bi set-nth-unsafe ; inline
 298 M: sequence-cursor set-cursor-value [ n>> ] [ seq>> ] bi set-nth ; inline
 299
 300 !
 301 ! hash-set cursor
 302 !
 303
 304 TUPLE: hash-set-cursor
 305     { hash-set hash-set read-only }
 306     { n fixnum read-only } ;
 307 <PRIVATE
 308 C: <hash-set-cursor> hash-set-cursor
 309 PRIVATE>
 310
 311 INSTANCE: hash-set-cursor forward-cursor
 312
 313 M: hash-set-cursor cursor-compatible?
 314     {
 315         [ [ hash-set-cursor? ] both? ]
 316         [ [ hash-set>> ] bi@ eq? ]
 317     } 2&& ; inline
 318
 319 M: hash-set-cursor cursor-valid? ( cursor -- ? )
 320     [ n>> ] [ hash-set>> array>> ] bi bounds-check? ; inline
 321
 322 M: hash-set-cursor cursor= ( cursor cursor -- ? )
 323     [ n>> ] bi@ = ; inline
 324 M: hash-set-cursor cursor-distance-hint ( cursor cursor -- n )
 325     nip hash-set>> cardinality ; inline
 326
 327 <PRIVATE
 328 : (inc-hash-set-cursor) ( array n -- n' )
 329     [ 2dup swap { [ length < ] [ nth-unsafe tombstone? ] } 2&& ] [ 1 + ] while nip ; inline
 330 PRIVATE>
 331
 332 M: hash-set-cursor inc-cursor ( cursor -- cursor' )
 333     [ hash-set>> dup array>> ] [ n>> 1 + ] bi
 334     (inc-hash-set-cursor) <hash-set-cursor> ; inline
 335
 336 INSTANCE: hash-set-cursor input-cursor
 337
 338 M: hash-set-cursor cursor-key-value-unsafe
 339     [ n>> dup ] [ hash-set>> array>> ] bi nth-unsafe ; inline
 340
 341 INSTANCE: hash-set container
 342
 343 M: hash-set begin-cursor
 344     dup array>> 0 (inc-hash-set-cursor) <hash-set-cursor> ; inline
 345 M: hash-set end-cursor
 346     dup array>> length <hash-set-cursor> ; inline
 347
 348 !
 349 ! map cursor
 350 !
 351
 352 TUPLE: map-cursor
 353     { from read-only }
 354     { to read-only } ;
 355 C: <map-cursor> map-cursor
 356
 357 INSTANCE: map-cursor forward-cursor
 358
 359 M: map-cursor cursor-compatible? [ from>> ] bi@ cursor-compatible? ; inline
 360 M: map-cursor cursor-valid? [ from>> ] [ to>> ] bi [ cursor-valid? ] both? ; inline
 361 M: map-cursor cursor= [ from>> ] bi@ cursor= ; inline
 362 M: map-cursor inc-cursor [ from>> inc-cursor ] [ to>> inc-cursor ] bi <map-cursor> ; inline
 363
 364 INSTANCE: map-cursor output-cursor
 365
 366 M: map-cursor set-cursor-value-unsafe to>> set-cursor-value-unsafe ; inline
 367 M: map-cursor set-cursor-value        to>> set-cursor-value        ; inline
 368
 369 : -map- ( begin end quot to -- begin' end' quot' )
 370     swap [ '[ _ <map-cursor> ] bi@ ] dip '[ from>> @ ] -out- ; inline
 371
 372 : -map ( begin end quot to -- begin' end' quot' )
 373     -map- -each ; inline
 374
 375 !
 376 ! pusher cursor
 377 !
 378
 379 TUPLE: pusher-cursor
 380     { growable read-only } ;
 381 C: <pusher-cursor> pusher-cursor
 382
 383 INSTANCE: pusher-cursor infinite-stream-cursor
 384 INSTANCE: pusher-cursor output-cursor
 385
 386 M: pusher-cursor set-cursor-value growable>> push ; inline
 387
 388 !
 389 ! Create cursors into new sequences
 390 !
 391
 392 : new-growable-cursor ( begin end exemplar -- cursor result )
 393     [ swap cursor-distance-hint ] dip new-resizable [ <pusher-cursor> ] keep ; inline
 394
 395 GENERIC#: new-sequence-cursor 1 ( begin end exemplar -- cursor result )
 396
 397 M: random-access-cursor new-sequence-cursor
 398     [ swap cursor-distance ] dip new-sequence [ begin-cursor ] keep ; inline
 399 M: forward-cursor new-sequence-cursor
 400     new-growable-cursor ; inline
 401
 402 : -into-sequence- ( begin end quot exemplar -- begin' end' quot' cursor result )
 403     [ 2over ] dip new-sequence-cursor ; inline
 404
 405 : -into-growable- ( begin end quot exemplar -- begin' end' quot' cursor result )
 406     [ 2over ] dip new-growable-cursor ; inline
 407
 408 !
 409 ! map combinators
 410 !
 411
 412 ! XXX generalize exemplar
 413 : -map-as ( ... begin end quot: ( ... cursor -- ... value ) exemplar -- ... newseq )
 414     [ -into-sequence- [ -map ] dip ] keep like ; inline
 415
 416 : map! ( ... container quot: ( ... x -- ... newx ) -- ... container )
 417     [ in- -out ] keep ; inline
 418 : map-as ( ... container quot: ( ... x -- ... newx ) exemplar -- ... newseq )
 419     [ in- ] dip -map-as ; inline
 420 : map ( ... container quot: ( ... x -- ... newx ) -- ... newcontainer )
 421     over map-as ; inline
 422
 423 !
 424 ! assoc combinators
 425 !
 426
 427 : -assoc- ( quot -- quot' )
 428     '[ cursor-key-value @ ] ; inline
 429
 430 : assoc- ( assoc quot -- begin end quot' )
 431     all- -assoc- ; inline
 432
 433 : assoc-each ( ... assoc quot: ( ... k v -- ... ) -- ... )
 434     assoc- -each ; inline
 435 : assoc>map ( ... assoc quot: ( ... k v -- ... newx ) exemplar -- ... newcontainer )
 436     [ assoc- ] dip -map-as ; inline
 437
 438 !
 439 ! hashtable cursor
 440 !
 441
 442 TUPLE: hashtable-cursor
 443     { hashtable hashtable read-only }
 444     { n fixnum read-only } ;
 445 <PRIVATE
 446 C: <hashtable-cursor> hashtable-cursor
 447 PRIVATE>
 448
 449 INSTANCE: hashtable-cursor forward-cursor
 450
 451 M: hashtable-cursor cursor-compatible?
 452     {
 453         [ [ hashtable-cursor? ] both? ]
 454         [ [ hashtable>> ] bi@ eq? ]
 455     } 2&& ; inline
 456
 457 M: hashtable-cursor cursor-valid? ( cursor -- ? )
 458     [ n>> ] [ hashtable>> array>> ] bi bounds-check? ; inline
 459
 460 M: hashtable-cursor cursor= ( cursor cursor -- ? )
 461     [ n>> ] bi@ = ; inline
 462 M: hashtable-cursor cursor-distance-hint ( cursor cursor -- n )
 463     nip hashtable>> assoc-size ; inline
 464
 465 <PRIVATE
 466 : (inc-hashtable-cursor) ( array n -- n' )
 467     [ 2dup swap { [ length < ] [ nth-unsafe tombstone? ] } 2&& ] [ 2 + ] while nip ; inline
 468 PRIVATE>
 469
 470 M: hashtable-cursor inc-cursor ( cursor -- cursor' )
 471     [ hashtable>> dup array>> ] [ n>> 2 + ] bi
 472     (inc-hashtable-cursor) <hashtable-cursor> ; inline
 473
 474 INSTANCE: hashtable-cursor input-cursor
 475
 476 M: hashtable-cursor cursor-key-value-unsafe
 477     [ n>> ] [ hashtable>> array>> ] bi
 478     [ nth-unsafe ] [ [ 1 + ] dip nth-unsafe ] 2bi ; inline
 479
 480 INSTANCE: hashtable container
 481
 482 M: hashtable begin-cursor
 483     dup array>> 0 (inc-hashtable-cursor) <hashtable-cursor> ; inline
 484 M: hashtable end-cursor
 485     dup array>> length <hashtable-cursor> ; inline
 486
 487 !
 488 ! zip cursor
 489 !
 490
 491 TUPLE: zip-cursor
 492     { keys   read-only }
 493     { values read-only } ;
 494 C: <zip-cursor> zip-cursor
 495
 496 INSTANCE: zip-cursor forward-cursor
 497
 498 M: zip-cursor cursor-compatible? ( cursor cursor -- ? )
 499     {
 500         [ [ zip-cursor? ] both? ]
 501         [ [ keys>> ] bi@ cursor-compatible? ]
 502         [ [ values>> ] bi@ cursor-compatible? ]
 503     } 2&& ; inline
 504
 505 M: zip-cursor cursor-valid? ( cursor -- ? )
 506     [ keys>> ] [ values>> ] bi [ cursor-valid? ] both? ; inline
 507 M: zip-cursor cursor= ( cursor cursor -- ? )
 508     {
 509         [ [ keys>> ] bi@ cursor= ]
 510         [ [ values>> ] bi@ cursor= ]
 511     } 2|| ; inline
 512
 513 M: zip-cursor cursor-distance-hint ( cursor cursor -- n )
 514     [ [ keys>> ] bi@ cursor-distance-hint ]
 515     [ [ values>> ] bi@ cursor-distance-hint ] 2bi min ; inline
 516
 517 M: zip-cursor inc-cursor ( cursor -- cursor' )
 518     [ keys>> inc-cursor ] [ values>> inc-cursor ] bi <zip-cursor> ; inline
 519
 520 INSTANCE: zip-cursor input-cursor
 521
 522 M: zip-cursor cursor-key-value
 523     [ keys>> cursor-value-unsafe ] [ values>> cursor-value-unsafe ] bi ; inline
 524
 525 : zip-cursors ( a-begin a-end b-begin b-end -- begin end )
 526     [ <zip-cursor> ] bi-curry@ bi* ; inline
 527
 528 : 2all ( a b -- begin end )
 529     [ all ] bi@ zip-cursors ; inline
 530
 531 : 2all- ( a b quot -- begin end quot )
 532     [ 2all ] dip ; inline
 533
 534 ALIAS: -2in- -assoc-
 535
 536 : 2in- ( a b quot -- begin end quot' )
 537     2all- -2in- ; inline
 538
 539 : 2each ( ... a b quot: ( ... x y -- ... ) -- ... )
 540     2in- -each ; inline
 541
 542 : 2map-as ( ... a b quot: ( ... x y -- ... z ) exemplar -- ... c )
 543     [ 2in- ] dip -map-as ; inline
 544
 545 : 2map ( ... a b quot: ( ... x y -- ... z ) -- ... c )
 546     pick 2map-as ; inline
 547
 548 !
 549 ! generalized zips
 550 !
 551
 552 : -unzip- ( quot -- quot' )
 553     '[ [ keys>> cursor-value-unsafe ] [ values>> ] bi @ ] ; inline
 554
 555 MACRO: nzip-cursors ( n -- quot ) 1 - [ zip-cursors ] n*quot ;
 556
 557 : nall ( seqs... n -- begin end ) [ [ all ] swap napply ] [ nzip-cursors ] bi ; inline
 558
 559 : nall- ( seqs... quot n -- begin end quot ) swap [ nall ] dip ; inline
 560
 561 MACRO: -nin- ( n -- quot )
 562     1 - [ -unzip- ] n*quot [ -in- ] prepend ;
 563
 564 : nin- ( seqs... quot n -- begin end quot ) [ nall- ] [ -nin- ] bi ; inline
 565
 566 : neach ( seqs... quot n -- ) nin- -each ; inline
 567 : nmap-as ( seqs... quot exemplar n -- newseq )
 568     swap [ nin- ] dip -map-as ; inline
 569 : nmap ( seqs... quot n -- newseq )
 570     dup [ npick ] curry [ dip swap ] curry dip nmap-as ; inline
 571
 572 !
 573 ! utilities
 574 !
 575
 576 : -with- ( invariant begin end quot -- begin end quot' )
 577     [ rot ] dip '[ [ _ ] dip @ ] ; inline
 578
 579 : -2with- ( invariant invariant begin end quot -- begin end quot' )
 580     -with- -with- ; inline
 581
 582 MACRO: -nwith- ( n -- quot )
 583     [ -with- ] n*quot ;