Add crude locals.
This commit is contained in:
@ -3,4 +3,5 @@ include common/utils.fs
|
||||
include common/base_tests.fs
|
||||
include common/utils_tests.fs
|
||||
include common/vocabulary_tests.fs
|
||||
include common/locals_tests.fs
|
||||
run-tests
|
||||
|
||||
@ -1,3 +1,29 @@
|
||||
( Local Variables )
|
||||
|
||||
( NOTE: These are not yet gforth compatible )
|
||||
|
||||
internals definitions
|
||||
|
||||
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 ! ;
|
||||
: scope-create ( a n -- )
|
||||
dup >r $place r> , ( name )
|
||||
scope @ , 0 , here scope ! ( link, flags )
|
||||
['] scope-template dup @ , cell+ @ ,
|
||||
cell negate scope-depth +! scope-depth @ , ;
|
||||
|
||||
( NOTE: This is not ANSForth compatible )
|
||||
: (local) ( a n -- )
|
||||
>r >r postpone >r postpone ahead r> r> scope-create postpone then ;
|
||||
: }? ( a n -- ) 1 <> if drop 0 exit then c@ [char] } = ;
|
||||
|
||||
also forth definitions
|
||||
|
||||
: { begin bl parse 2dup }? if 2drop exit then (local) again ; immediate
|
||||
: ; scope-clear postpone ; ; immediate
|
||||
|
||||
only forth definitions
|
||||
|
||||
14
ueforth/common/locals_tests.fs
Normal file
14
ueforth/common/locals_tests.fs
Normal file
@ -0,0 +1,14 @@
|
||||
( Testing Locals )
|
||||
|
||||
e: test-locals-one
|
||||
: test { a } a a * ;
|
||||
4 test 16 = assert
|
||||
;e
|
||||
|
||||
e: test-locals-two
|
||||
: test { a b } a a a b b ;
|
||||
7 8 test .s
|
||||
out: <5> 7 7 7 8 8
|
||||
sp0 sp!
|
||||
;e
|
||||
|
||||
Reference in New Issue
Block a user