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 | |
\ Some well known but yet non standard words | |
[undefined] lit, [if] : lit, postpone literal ; [then] | |
[undefined] slit, [if] : slit, postpone sliteral ; [then] | |
\ Common useful factors | |
: =? ( x1 x2 -- x1 false | true ) over = dup if nip then ; | |
: xt, compile, ; \ ensure default interpretation semantics | |
: state-on ( -- ) ] ; | |
: state-off ( -- ) postpone [ ; \ [ ' [ xt, ] | |
\ Token translators | |
: tt-xt ( i*x xt -- j*x ) state @ if xt, 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 ! ; | |
: is ' >body tt-lit ['] ! tt-xt ; immediate | |
: to [ ' is xt, ] ; immediate \ synonym; don't use postpone | |
: 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 and VALUE | |
: execute-compiling-intact ( i*x xt --j*x ) state @ if execute exit then state-on execute state-off ; | |
\ NB: this word guarantees interpretation state after execution if it was before execution | |
\ 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, ['] xt, | |
then xt, | |
; 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 xt, | |
; 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
This comment has been minimized.
short link: https://git.io/JvctZ
see also a more complete implementation: https://git.io/JUE8L (postpone), https://git.io/JU1JO (dual words)