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
@ruv

This comment has been minimized.

Copy link
Owner Author

@ruv ruv commented Jun 25, 2020

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.