\ core-ext 98.10.23 8:32 pm NAB

: VALUE ( x "name" --)
  create  ,  does> @ ;

: TO ( x "name" --)
  ' >body  state @
  if  postpone literal  postpone !
  else  !  then ; immediate

: 2R>  r> r> swap ; inline
: 2>R  swap >r >r ; inline
: 2R@  2r> 2dup 2>r ; inline

: ?DO
   postpone 2dup  postpone =
   postpone if  postpone 2drop
   postpone else  1  postpone do ;
immediate

: DO  0  postpone do ; immediate

: ?resolve-do \ factor of loop & +loop
  if  postpone then  then ;

: LOOP
  postpone loop  ?resolve-do
; immediate

: +LOOP
  postpone +loop  ?resolve-do
; immediate

:  C"  [char] " parse dup c,
  postpone sliteral  postpone drop
  postpone 1- ; immediate

: ERASE  0 fill ;

: PAD  here 84 + aligned ;

: WITHIN  over -  >r - r>  u< ;

: D>S  drop ; inline

: .R  swap s>d rot d.r ;

: U>  swap u< ;

: U.R  swap 0 <# #s #> rot
  over -  dup 0> and  spaces type ;

: WITHIN ( test low high -- flag)
  over -  >r - r>  u< ;

: [COMPILE]  ' compile, ; immediate