diff --git a/ueforth/common/locals.fs b/ueforth/common/locals.fs index 5a12d9f..ad96c1c 100644 --- a/ueforth/common/locals.fs +++ b/ueforth/common/locals.fs @@ -31,36 +31,37 @@ variable locals-here locals-area locals-here ! variable scope-depth variable local-op ' local@ local-op ! : scope-clear + scope-depth @ negate nest-depth +! scope-depth @ for aft postpone rdrop then next 0 scope-depth ! 0 scope ! locals-area locals-here ! ; -: do-local ( n -- ) nest-depth @ + 1+ cells negate aliteral +: do-local ( n -- ) nest-depth @ + cells negate aliteral local-op @ , ['] local@ local-op ! ; : scope-create ( a n -- ) dup >r $place align r> , ( name ) scope @ , 1 , ( IMMEDIATE ) here scope ! ( link, flags ) ['] scope-clear @ ( docol) , - scope-depth @ aliteral postpone do-local ['] exit , - 1 scope-depth +! + nest-depth @ negate aliteral postpone do-local ['] exit , + 1 scope-depth +! 1 nest-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 -- ) ?room <>locals scope-create <>locals postpone >r ; : }? ( a n -- ) 1 <> if drop 0 exit then c@ [char] } = ; : --? ( a n -- ) s" --" str= ; - : (to) ( xt -- ) ['] local! local-op ! execute ; : (+to) ( xt -- ) ['] local+! local-op ! execute ; also forth definitions -: { begin bl parse - dup 0= if scope-clear -1 throw then - 2dup --? if 2drop [char] } parse 2drop exit then - 2dup }? if 2drop exit then - (local) again ; immediate +: (local) ( a n -- ) + dup 0= if 2drop exit then + ?room <>locals scope-create <>locals postpone >r ; +: { bl parse + dup 0= if scope-clear -1 throw then + 2dup --? if 2drop [char] } parse 2drop exit then + 2dup }? if 2drop exit then + recurse (local) ; immediate ( TODO: Hide the words overriden here. ) : ; scope-clear postpone ; ; immediate : to ( n -- ) ' dup >flags @ if (to) else ['] ! value-bind then ; immediate diff --git a/ueforth/common/locals_tests.fs b/ueforth/common/locals_tests.fs index dd4ab71..1b03bda 100644 --- a/ueforth/common/locals_tests.fs +++ b/ueforth/common/locals_tests.fs @@ -71,3 +71,15 @@ e: test-to-loop test out: 0 1 4 9 16 ;e + +e: test-multi + : test { a b } 9 99 { c d } a . b . c . d . ; + 1 2 test cr + out: 1 2 9 99 +;e + +e: test-multi-to + : test { a b } 9 99 { c d } 5 to c a . b . c . d . ; + 1 2 test cr + out: 1 2 5 99 +;e