( locals day 06.05.2001 )

\ usage:
\ : test { a b c \ f g e -- }
\   a to f f .
\   at f @ . ;
\ you  can use any names for
\ local variables:
\ { asd dke s;w -- }

create locarr 128 allot
variable lochere
variable locdepth
variable ilocs
variable ulocs
variable ulocs?
variable loc_c
variable comment?

: rp+@ ( offs -- x )
    cell+ rp@ + @
;
: rp+ ( offs -- addr )
    cell+ rp@ +
;
: rp+! ( x offs -- )
    cell+ rp@ + !
;
: rallot ( n -- )
    r> swap
    begin dup
    while 0 >r 1-
    repeat drop >r
;

: drmove ( i*x i -- ) ( r: -- i*x )
    begin  dup
    while  swap r> 2>r 1-
    repeat drop
;

: addlocal ( addr u -- )
   dup >r lochere @ tuck c!
   1+ r@ cmove r> 1+ lochere +!
;

: initlocals
   locarr lochere !
   0 locdepth !
   0 ulocs !
   0 ilocs !
   0 ulocs? !
   0 comment? !
;

initlocals

: findlocal ( addr u -- offs -1 | 0 )
   2>r 0 loc_c !
   lochere @ locarr
   begin
     2dup >
   while
     dup count 2r@ compare 0=
     if 2r> 2drop 2drop loc_c @ 
        2 + cells locdepth @ +  \ calc offs
        state @ exit
     then
     1 loc_c +! dup c@ + 1+
   repeat 2r> 2drop 2drop 0
;

: localexit
   r> rp@ + rp!
;

: compilelocals
   ulocs @ ?dup if [compile] literal 
                   postpone rallot 
                then
   ilocs @ ?dup if [compile] literal 
                   postpone drmove 
                then
   ulocs @ ilocs @ + ?dup
           if cells [compile] literal 
              ['] localexit >tcode [compile] literal 
              postpone 2>r
           then
;

: {
    initlocals
    begin
      nextword 2dup s" }" compare
      over 0= if -22 throw then
    while ( addr u )
      2dup s" --" compare 0= 
      if comment? on then
      comment? @ 
      if 2drop
      else
        2dup s" \" compare 0=
        if ulocs? on 2drop
        else addlocal
             1 ulocs? @ 
             if ulocs else ilocs then +!
        then
      then
    repeat 2drop
    compilelocals
; immediate

warning off

: >r     cell locdepth +! 
         postpone >r 
; immediate
: r>     [ cell negate ] literal 
         locdepth +! postpone r> 
; immediate
: do     [ 3 cells ] literal 
         locdepth +! postpone do 
; immediate
: loop   [ 3 cells negate ] literal 
         locdepth +! postpone loop 
; immediate
: ?do    [ 3 cells ] literal 
         locdepth +! postpone ?do 
; immediate
: +loop  [ 3 cells negate ] literal 
         locdepth +! postpone +loop 
; immediate

: at ( "name" )
   nextword findlocal
   if [compile] literal postpone rp+
   else -13 throw
   then
; immediate

: to  ( "name" )
   >in @ nextword findlocal
   if [compile] literal postpone rp+! drop
   else >in ! [compile] to
   then
; immediate

: notfound ( addr u - ... )
  2dup 2>r
  ['] notfound catch
  if 2drop 2r>
     findlocal
     if [compile] literal postpone rp+@
     else -13 throw
     then
  else 2r> 2drop
  then
;

: ; locarr lochere ! postpone ; 
; immediate

warning on
