20d71b6840
FossilOrigin-Name: 64666568dec02f6900c053557be9adc73c3cdf7a8a2fa6d5730001e852fd7fe0
45 lines
1,016 B
Forth
45 lines
1,016 B
Forth
# New Words
|
|
|
|
This contains a variety of words from my more recent systems.
|
|
|
|
Notes:
|
|
|
|
`aa:` is a new set of array words. These will be replacing the
|
|
existing set in the future.
|
|
|
|
~~~
|
|
:aa:make (...n-a) here [ dup comma &comma times ] dip ;
|
|
|
|
:aa:map
|
|
swap [ fetch-next [ [ fetch over call ] sip
|
|
&store sip n:inc ] times
|
|
drop-pair ] sip ;
|
|
|
|
:aa:contains? (an-f)
|
|
swap #0 swap [ swap [ over eq? ] dip or ] a:for-each nip ;
|
|
|
|
:aa:first (a-n) #0 a:fetch ;
|
|
:aa:last (a-n) dup a:length n:dec a:fetch ;
|
|
|
|
|
|
:aa:hash (a-n) #5381 swap [ swap #33 n:mul n:add ] a:for-each ;
|
|
|
|
:aa:eq? (aa-f) aa:hash swap aa:hash eq? ;
|
|
:aa:-eq? (aa-f) aa:hash swap aa:hash -eq? ;
|
|
|
|
:a:dup here [ dup a:length comma &comma a:for-each ] dip ;
|
|
~~~
|
|
|
|
~~~
|
|
:d:use-hashes
|
|
&eq? &d:lookup #5 - store
|
|
[ d:hash fetch ] &d:lookup #8 - store
|
|
#2049 &d:lookup store
|
|
&s:hash &d:lookup n:inc store ;
|
|
|
|
:d:use-strings
|
|
&s:eq? &d:lookup #5 - store
|
|
&d:name &d:lookup #8 - store
|
|
#0 &d:lookup store
|
|
#0 &d:lookup n:inc store ;
|
|
~~~
|