Skip to content

Instantly share code, notes, and snippets.

@ruv ruv/special-words-as-immediate.fth Secret
Last active Nov 7, 2019

Embed
What would you like to do?
Example of a correct implementation of POSTPONE for some standard words that are implemented as immediate STATE-dependent words
\ 2019-09-24 ruv
\ 2019-10-09
\ Common useful factors
: =? ( x1 x2 -- x1 false | true ) over = dup if nip then ;
: state-on ( -- ) ] ;
: state-off ( -- ) postpone [ ;
\ Token translators
: tt-xt ( i*x xt -- j*x ) state @ if compile, else execute then ;
: tt-lit ( x -- x| ) state @ if lit, then ;
: tt-slit ( c-addr u -- | c-addr u -- c-addr2 u ) state @ if slit, then ;
\ Note: separate buffering of the string literal in interpretation state
\ is absent for the sake of this example simplicity.
\ An initial action for a deferred word
: error-np ( -- ) -21 throw ; \ Not Provided, "unsupported operation"
\ Implementing of: 'to', 'is', 'action-of', 's"'
: value create , does> @ ;
: defer create ['] error-np , does> @ execute ;
: defer@ >body @ ;
: defer! >body ! ;
: to ' >body tt-lit ['] ! tt-xt ; immediate
: is postpone to ; immediate
: action-of ' >body tt-lit ['] @ tt-xt ; immediate
: s" [char] " parse tt-slit ; immediate
\ NB: 2VALUE and FVALUE can be easy implemeted too,
\ with a bit modification of TO, VALUE and IS
: execute-compiling-intact ( i*x xt --j*x ) state @ if execute exit then state-on execute state-off ;
\ NB: this word guarantees that interpretation state is intact
\ Support of an additional attribute (boolean in this case) for a word in a very portable manner
variable special-list 0 special-list !
: special-word? ( xt -- flag ) special-list swap begin swap @ dup while tuck cell+ @ =? until true then nip ;
: special ( x -- ) align here special-list @ , special-list ! , ;
: special-words< ( "ccc" -- ) begin >in @ parse-name nip swap >in ! while ' special repeat ;
\ Declare some words as special
special-words< to is action-of s"
\ a helper
: tick-word< ( "name" -- xt imm-flag ) bl word find dup 0= -13 and throw 1 = ;
\ NB: it may return different xt and flag depending on STATE
\ Implementation of "postpone" in the prevailing behavior variant
: postpone ( "name" -- ) tick-word< ( xt imm-flag )
if dup special-word? if lit, ['] execute-compiling-intact then
else lit, ['] compile,
then compile,
; immediate special-words< postpone
\ POSTPONE is special, since a wrapper for POSTPONE should resolve names in compilation state
\ (the same is for [COMPILE]).
\ Another way is to use STATE independent 'tick-word-compiling<' as
\ : tick-word-compiling< bl word ['] find execute-compiling-intact dup 0= -13 and throw 1 = ;
[defined] [compile] [if]
\ Implementation of "[compile]" in the prevailing behavior variant
: [compile] ( "name" -- ) tick-word< ( xt imm-flag )
if dup special-word? if lit, ['] execute-compiling-intact then
then compile,
; immediate special-words< [compile]
[then]
\ NB: a portable implementation of POSTPONE with exactly standard behavior (in place of popular) is simpler,
\ since it does not require an additional attribute (as "special-list" above), the result of FIND is enough.
\ Implementation of the words: 'if', 'else', 'then'
\ as STATE-dependent immediate words
: ?state state @ 0= -14 and throw ; \ "interpreting a compile-only word"
: if ?state postpone if ; immediate
: else ?state postpone else ; immediate
: then ?state postpone then ; immediate
special-words< if else then
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.