Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
An example of implementation the dual-semantics words via Resolver and via Recognizer mechanism
\ Definition of the following words:
\ VALUE TO S"
\ via Recognizer API v4
\ http://amforth.sourceforge.net/pr/Recognizer-rfc-D.html
wordlist constant markup
: rec-markup ( c-addr u -- rectype-markup-word | rectype-null )
markup search-wordlist if execute exit then rectype-null
;
: value ( x "name" -- ) create , does> @ ;
get-current markup set-current
:noname ( -- c-addr u ) '"' parse ;
:noname ( -- ) '"' parse slit, ;
'noop
rectype: s"
:noname ( x -- ) ' >body ! ;
:noname ( -- ) ' >body lit, '! compile, ;
'noop
rectype: to
set-current
forth-recognizer get-recognizer
'rec-markup swap 1+ forth-recognizer set-recognizer
\ Appending at the top to use the new definitions
\ instead of the old 'TO' and 'S"'
\ If we need to distinguish these markup words from other types,
\ we can use additional rectype wrapper as:
: execute-rectype ( i*x rectype -- j*x ) rectype>int execute ;
: compile-rectype ( i*x rectype -- j*x ) rectype>comp execute ;
'execute-rectype 'compile-rectype 'lit, rectype: rectype-markup
: rec-markup-ext ( c-addr u -- rectype rectype-markup | rectype-null )
markup search-wordlist if execute rectype-markup exit then
rectype-null
;
\ Definition of the following words:
\ VALUE TO S"
\ via Resolver API v1
\ https://github.com/ruv/forth-design-exp/blob/master/docs/resolver-api.md
\ NB: POSTPONE should be tweaked to explicitly support the markup words
wordlist constant markup
: tt-markup ( i*x xt -- j*x ) execute ;
: resolve-markup ( c-addr u -- xt tt-markup | c-addr u 0 )
markup sfind-wordlist ?E0 'tt-markup
;
: value ( x "name" -- ) create , does> @ ;
markup push-current
: s" ( -- c-addr u | ) '"' parse tt-slit ;
: to ( x | -- ) ' >body tt-lit '! tt-xt ;
: postpone
parse-lexeme resolve-lexeme dup ?NF
'tt-markup =? if tt-lit 'execute-compiling tt-xt exit then
\ ... other variants
-32 throw \ "invalid name argument"
;
drop-current
'resolve-markup preempt-resolver
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.