Refactor hiding, \ comments, still working on DOES> fix.

This commit is contained in:
Brad Nelson
2021-02-15 18:32:14 -08:00
parent 528c8e560f
commit aa92746992
5 changed files with 51 additions and 15 deletions

View File

@ -66,3 +66,17 @@ e: test-value-to
bar foo . cr bar foo . cr
out: 99 out: 99
;e ;e
e: test-comments-interp
123 ( Interpretered comment ) 456
789 \ Interpretered comment )
789 = assert 456 = assert 123 = assert
;e
e: test-comments-compiled
: foo 123 ( Compiled comment ) 456
789 \ Interpretered comment )
999 ;
foo 999 = assert 789 = assert 456 = assert 123 = assert
;e

View File

@ -26,6 +26,9 @@
: 4* 4 * ; : 4/ 4 / ; : 4* 4 * ; : 4/ 4 / ;
: +! ( n a -- ) swap over @ + swap ! ; : +! ( n a -- ) swap over @ + swap ! ;
( Line Comments )
: \ nl parse drop drop ; immediate
( Cells ) ( Cells )
: cell+ ( n -- n ) cell + ; : cell+ ( n -- n ) cell + ;
: cells ( n -- n ) cell * ; : cells ( n -- n ) cell * ;

View File

@ -9,6 +9,7 @@ var revision = process.argv[4];
source = source.replace('{{VERSION}}', version); source = source.replace('{{VERSION}}', version);
source = source.replace('{{REVISION}}', revision); source = source.replace('{{REVISION}}', revision);
source = source.replace(/\\/g, '\\\\');
source = source.replace(/["]/g, '\\"'); source = source.replace(/["]/g, '\\"');
source = '"' + source.split('\n').join('\\n"\n"') + '\\n"'; source = '"' + source.split('\n').join('\\n"\n"') + '\\n"';
source = source.replace(/["] ["]/g, ''); source = source.replace(/["] ["]/g, '');

View File

@ -7,12 +7,13 @@ current @ constant forth-wordlist
: definitions context @ current ! ; : definitions context @ current ! ;
( Make it easy to transfer words between vocabularies ) ( Make it easy to transfer words between vocabularies )
: transfer-xt ( xt -- ) context @ begin 2dup @ <> while @ >link& repeat nip : xt-find& ( xt -- xt& ) context @ begin 2dup @ <> while @ >link& repeat nip ;
dup @ swap dup @ >link swap ! current @ @ over >link& ! current @ ! ; : xt-hide ( xt -- ) xt-find& dup @ >link swap ! ;
: transfer ( "name" ) ' transfer-xt ; : xt-transfer ( xt -- ) dup xt-hide current @ @ over >link& ! current @ ! ;
: ?transfer ( "name" ) bl parse find dup if transfer-xt else drop then ; : transfer ( "name" ) ' xt-transfer ;
: ?transfer ( "name" ) bl parse find dup if xt-transfer else drop then ;
: }transfer ; : }transfer ;
: transfer{ begin ' dup ['] }transfer = if drop exit then transfer-xt again ; : transfer{ begin ' dup ['] }transfer = if drop exit then xt-transfer again ;
( Watered down versions of these ) ( Watered down versions of these )
: only forth 0 context cell+ ! ; : only forth 0 context cell+ ! ;
@ -26,17 +27,9 @@ vocabulary internals internals definitions
( Vocabulary chain for current scope, place at the -1 position ) ( Vocabulary chain for current scope, place at the -1 position )
variable scope scope context cell - ! variable scope scope context cell - !
( Make DOES> switch to compile mode when interpreted )
(
vocabulary partial-does partial-does definitions
transfer does>
only forth definitions also partial-does
: does> postpone does> ; immediate
only internals definitions
)
transfer{ transfer{
transfer-xt voc-stack-end forth-wordlist xt-find& xt-hide xt-transfer
voc-stack-end forth-wordlist
last-vocabulary last-vocabulary
branch 0branch donext dolit branch 0branch donext dolit
'context 'notfound notfound 'context 'notfound notfound
@ -49,3 +42,14 @@ transfer{
tib-setup input-limit tib-setup input-limit
}transfer }transfer
forth definitions forth definitions
( Make DOES> switch to compile mode when interpreted )
(
forth definitions internals
' does>
: does> state @ if postpone does> exit then
['] constant @ current @ @ dup >r !
here r> cell+ ! postpone ] ; immediate
xt-hide
forth definitions
)

View File

@ -87,3 +87,17 @@ e: test-sealed
out: b out: b
only forth definitions only forth definitions
;e ;e
e: test-fixed-does>-normal
: adder create , does> @ + ;
3 adder foo
4 foo 7 = assert
4 ' foo execute 7 = assert
;e
(
e: test-fixed-does>-interp
create hi 123 , does> @ + ;
7 hi 130 = assert
;e
)