Refactor hiding, \ comments, still working on DOES> fix.
This commit is contained in:
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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 * ;
|
||||||
|
|||||||
@ -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, '');
|
||||||
|
|||||||
@ -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
|
||||||
|
)
|
||||||
|
|||||||
@ -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
|
||||||
|
)
|
||||||
|
|||||||
Reference in New Issue
Block a user