Fixing do + for loops with locals + see for them.

ueforth/common/boot.fs

@@ -121,15 +121,18 @@ sp@ constant sp0
 rp@ constant rp0
 : depth ( -- n ) sp@ sp0 - cell/ ;
 
+( Rstack nest depth )
+variable nest-depth
+
 ( FOR..NEXT )
-: for   postpone >r postpone begin ; immediate
+: for   1 nest-depth +! postpone >r postpone begin ; immediate
-: next   postpone donext , ; immediate
+: next   -1 nest-depth +! postpone donext , ; immediate
 
 ( DO..LOOP )
 variable leaving
 : leaving,   here leaving @ , leaving ! ;
-: leaving(   leaving @ 0 leaving ! ;
+: leaving(   leaving @ 0 leaving !   2 nest-depth +! ;
-: )leaving   leaving @ swap leaving !
+: )leaving   leaving @ swap leaving !  -2 nest-depth +!
              begin dup while dup @ swap here swap ! repeat drop ;
 : (do) ( n n -- .. ) swap r> -rot >r >r >r ;
 : do ( lim s -- ) leaving( postpone (do) here ; immediate

ueforth/common/locals.fs

@@ -18,29 +18,39 @@
 
 internals definitions
 
+( Leave a region for locals definitions )
+1024 constant locals-capacity  128 constant locals-gap
+create locals-area locals-capacity allot
+variable locals-here  locals-area locals-here !
+: <>locals   locals-here @ here locals-here ! here - allot ;
+
 variable scope-depth
-: scope-doer   create does> @ rp@ + @ ;
-scope-doer scope-template
 : scope-clear
    begin scope-depth @ while postpone rdrop cell scope-depth +! repeat
-   0 scope ! ;
+   0 scope !   locals-area locals-here ! ;
+: local@ ( n -- ) rp@ + @ ;
+: do-local ( n -- ) nest-depth @ 1+ cells - aliteral ['] local@ , ;
 : scope-create ( a n -- )
    dup >r $place align r> , ( name )
-   scope @ , 0 , here scope ! ( link, flags )
+   scope @ , 1 , ( IMMEDIATE ) here scope ! ( link, flags )
-   ['] scope-template dup @ , cell+ @ ,
+   ['] scope-clear @ ( docol) ,
-   cell negate scope-depth +!   scope-depth @ , ;
+   scope-depth @ aliteral postpone do-local ['] exit ,
+   cell negate scope-depth +!
+;
+
+: ?room   locals-here @ locals-area - locals-capacity locals-gap - >
+          if scope-clear -1 throw then ;
 
 ( NOTE: This is not ANSForth compatible )
-: (local) ( a n -- )
+: (local) ( a n -- ) ?room <>locals scope-create <>locals postpone >r ;
-   >r >r postpone >r postpone ahead r> r> scope-create postpone then ;
 : }? ( a n -- ) 1 <> if drop 0 exit then c@ [char] } = ;
 : --? ( a n -- ) s" --" str= ;
-: eat}   begin bl parse }? until ;
 
 also forth definitions
 
 : {   begin bl parse
-        2dup --? if 2drop eat} exit then
+        dup 0= if scope-clear -1 throw then
+        2dup --? if 2drop [char] } parse 2drop exit then
         2dup }? if 2drop exit then
       (local) again ; immediate
 : ;   scope-clear postpone ; ; immediate

ueforth/common/locals_tests.fs

@@ -41,3 +41,21 @@ e: test-dash
   : test { a b c -- a a b b c c } a a b b c c ;
   1 2 3 test * + * + * 23 = assert
 ;e
+
+e: test-for-loop
+  : test { a b } 5 for a . b . next cr ;
+  1 2 test
+  out: 1 2 1 2 1 2 1 2 1 2 1 2 
+;e
+
+e: test-do-loop
+  : test { a b } 5 0 do a . b . loop cr ;
+  1 2 test
+  out: 1 2 1 2 1 2 1 2 1 2 
+;e
+
+e: test-do-+loop
+  : test { a b } 10 0 do i . a . b . 2 +loop cr ;
+  99 999 test
+  out: 0 99 999 2 99 999 4 99 999 6 99 999 8 99 999 
+;e