Last active
June 25, 2020 09:44
-
-
Save ruv/dbe99ace903b86063610dbae81f3c69f to your computer and use it in GitHub Desktop.
An example of implementation the dual-semantics words via Resolver and via Recognizer mechanism
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| \ 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 | |
| ; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| \ 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
Short URL: https://git.io/JvcGL