add two new examples from Kiyoshi
FossilOrigin-Name: 4f930733947c1331f846262d820152b2a6276dc9cd7cf1fa307129dbff71157c
This commit is contained in:
parent
8d0d4b8a0b
commit
8e0c4dd16b
3 changed files with 85 additions and 0 deletions
|
@ -97,9 +97,12 @@ June 2019.
|
|||
|
||||
## Examples
|
||||
|
||||
- add Abort.forth
|
||||
- add Buffer.forth
|
||||
- add CaptureOutput.forth
|
||||
- add DisplayNames.forth
|
||||
- add EvaluateString.forth
|
||||
- add Forget.forth
|
||||
- add HTML.forth
|
||||
- add KeyValueStore.forth
|
||||
- add Marker.forth
|
||||
|
|
15
example/EvaluateString.forth
Normal file
15
example/EvaluateString.forth
Normal file
|
@ -0,0 +1,15 @@
|
|||
## s:(evaluate)
|
||||
|
||||
Show string being evaluated
|
||||
|
||||
~~~
|
||||
:s:() (s-) nl '(_ s:prepend '_) s:append s:put nl ;
|
||||
:s:(evaluate) (s-) dup s:() s:evaluate nl ;
|
||||
~~~
|
||||
|
||||
```
|
||||
:s:testing (s--) 'Testing_ s:prepend s:put nl ;
|
||||
's:(evaluate) s:testing
|
||||
'#2_#3_#136_dump-stack s:(evaluate)
|
||||
'reset_dump-stack s:(evaluate)
|
||||
```
|
67
example/Forget.forth
Normal file
67
example/Forget.forth
Normal file
|
@ -0,0 +1,67 @@
|
|||
# Forget
|
||||
|
||||
This is an alternative to `mark`.
|
||||
|
||||
As a byproduct you get `hide` which hides a word from later
|
||||
dictionary search.
|
||||
|
||||
~~~
|
||||
:d:exists? d:lookup n:zero? ;
|
||||
'abort d:exists? [ 'example/Abort.forth include ] if
|
||||
's:(evaluate) d:exists? [ 'example/EvaluateString.forth include ] if
|
||||
~~~
|
||||
|
||||
## EOC (end-of-code)
|
||||
|
||||
~~~
|
||||
:d:size (-) #0 [ d:name drop #1 + ] d:for-each ;
|
||||
:d:words.last (n-)
|
||||
&Dictionary swap [ fetch dup d:name s:put sp d:link ] times drop ;
|
||||
:EOC (-) 'EOC_(end-of-code) s:shout
|
||||
d:size '%n_words_defined s:format s:put nl
|
||||
#4 [ '%n_last_defined_words: s:format s:put sp ] sip d:words.last listen ;
|
||||
~~~
|
||||
|
||||
## d:hide
|
||||
|
||||
~~~
|
||||
{{
|
||||
'This 'Newer [ var ] bi@
|
||||
:names-match? (a-f) d:name here s:eq? ;
|
||||
:word-exists?continue (s-s) [ dup d:lookup ] assert ;
|
||||
:d:newer-older (s-aa)_newer_older word-exists?continue
|
||||
here s:copy d:last #0 !Newer [ dup names-match?
|
||||
[ @Newer TRUE ] [ dup !Newer d:link fetch FALSE ] choose
|
||||
] until (this_newer) swap d:link fetch (older) ;
|
||||
:exist?continue (aa-aa) [ dup-pair [ n:-zero? ] bi@ and ] assert ;
|
||||
---reveal---
|
||||
:d:newer (s-a) d:newer-older drop ;
|
||||
:d:hide (s-) d:newer-older exist?continue swap d:link store ;
|
||||
}}
|
||||
~~~
|
||||
|
||||
|
||||
```
|
||||
:a ; :b ; :c ;
|
||||
'b d:hide
|
||||
'#5_d:words.last s:(evaluate)
|
||||
```
|
||||
|
||||
# Forget
|
||||
|
||||
~~~
|
||||
:d:forget.a (a-) dup n:-zero? [ dup !Heap d:link fetch !Dictionary ]
|
||||
[ drop 'tried_to_d:forget_a_word_that_doesn't_exist. s:shout ] choose ;
|
||||
:d:forget (s-) d:lookup d:forget.a ;
|
||||
:f:reset (-|float:?-) f:depth [ f:drop ] times ;
|
||||
:reset.nf (?-|float:?-) reset f:reset ;
|
||||
:d:wipe (-) reset.nf '---wipe--- d:newer d:forget.a ;
|
||||
~~~
|
||||
|
||||
```
|
||||
:---wipe--- ;
|
||||
:a ; :b ; :c ; nl
|
||||
'#5_d:words.last s:(evaluate)
|
||||
d:wipe nl
|
||||
'#5_d:words.last s:(evaluate) nl
|
||||
```
|
Loading…
Reference in a new issue