199 lines
6.9 KiB
Forth
199 lines
6.9 KiB
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.
|
|
|
|
`as:` is a new set of string words. These will be replacing the
|
|
existing set in the future. (In the current system, strings are
|
|
null terminated. The `as` strings are length-prefixed instead.)
|
|
|
|
~~~
|
|
'NextArray var
|
|
:arrays FREE #513 #12 n:mul n:sub ;
|
|
|
|
|
|
:aa:temp (a-a) @NextArray dup #12 [ drop #0 dup !NextArray ] if
|
|
#513 n:mul arrays n:add over a:length n:inc copy
|
|
@NextArray #513 n:mul arrays n:add
|
|
&NextArray v:inc ;
|
|
|
|
: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 ;
|
|
|
|
:as:map aa:map ;
|
|
|
|
:as:left a:left ;
|
|
:as:right a:right ;
|
|
:as:middle a:middle ;
|
|
|
|
{{
|
|
'Count var
|
|
:prepare #0 &Count store ;
|
|
:reserve swap #0 comma ;
|
|
:patch here over n:sub n:dec over store ;
|
|
:cleanup dup s:temp swap &Free store ;
|
|
:match? over eq? ;
|
|
:record &Count fetch comma ;
|
|
:iterate [ match? &record if &Count v:inc ] a:for-each ;
|
|
---reveal---
|
|
:aa:indices (av-a)
|
|
prepare here [ reserve iterate drop ] dip patch cleanup ;
|
|
}}
|
|
|
|
:aa:index (av-n) [ aa:indices #0 a:fetch ] gc ;
|
|
|
|
:aa:contains? (an-f)
|
|
swap #0 swap [ swap [ over eq? ] dip or ] a:for-each nip ;
|
|
|
|
:as:contains? aa:contains? ;
|
|
|
|
:aa:filter (aq-)
|
|
[ over &call dip swap &comma &drop choose ] curry
|
|
here [ over fetch comma a:for-each ] dip
|
|
here over n:sub n:dec over store ;
|
|
|
|
:as:filter aa:filter ;
|
|
|
|
:as:length fetch ;
|
|
|
|
:aa:th n:inc n:add ;
|
|
:as:th n:inc n:add ;
|
|
:aa:fetch aa:th fetch ;
|
|
:as:fetch as:th fetch ;
|
|
:aa:store aa:th store ;
|
|
:as:store as:th store ;
|
|
|
|
:aa:first (a-n) #0 a:fetch ;
|
|
:aa:last (a-n) dup a:length n:dec aa:fetch ;
|
|
|
|
:as:first aa:first ;
|
|
:as:last aa:last ;
|
|
:as:index/c aa:index ;
|
|
|
|
|
|
:aa:dup a:dup ;
|
|
:as:dup a:dup ;
|
|
:aa:last aa:last ;
|
|
:as:temp aa:dup ;
|
|
|
|
:as:trim-right (s-s)
|
|
as:temp [ dup v:dec [ as:last #32 lteq? ] sip swap ] while
|
|
dup v:inc ;
|
|
|
|
{{
|
|
'Start var
|
|
'End var
|
|
'Len var
|
|
:find-end dup as:length dup !Len over n:add n:inc !End n:inc ;
|
|
:new-size @Start over swap n:sub @Len swap n:sub ;
|
|
:patch over store ;
|
|
---reveal---
|
|
:as:trim-left (s-s)
|
|
as:dup dup #0 as:fetch #32 eq?
|
|
[ dup !Start find-end
|
|
[ fetch-next #32 -eq? over @End -eq? and ] while
|
|
new-size patch ] if ;
|
|
}}
|
|
|
|
:as:trim (s-s) as:trim-left as:trim-right ;
|
|
|
|
:sigil:" (s-a) here [ dup s:length comma &comma s:for-each ] dip ; immediate
|
|
|
|
:aa:for-each (aq-) a:for-each ;
|
|
:as:for-each (sq-) a:for-each ;
|
|
|
|
:aa:hash (a-n) #5381 swap [ swap #33 n:mul n:add ] aa:for-each ;
|
|
:as:hash (s-n) aa:hash ;
|
|
|
|
:aa:eq? (aa-f) aa:hash swap aa:hash eq? ;
|
|
:aa:-eq? (aa-f) aa:hash swap aa:hash -eq? ;
|
|
:as:eq? (ss-f) aa:eq? ;
|
|
:as:-eq? (ss-f) aa:-eq? ;
|
|
|
|
:aa:dup here [ dup a:length comma &comma a:for-each ] dip ;
|
|
:as:dup aa:dup ;
|
|
|
|
:as:temp ;
|
|
:as:keep ;
|
|
|
|
:as:to-upper (s-s) [ as:dup &c:to-upper as:map as:temp ] gc ;
|
|
:as:to-lower (s-s) [ as:dup &c:to-lower as:map as:temp ] gc ;
|
|
~~~
|
|
|
|
a:append aa-a Create a new array with the contents of a1
|
|
a:behead a-a Remove first item from an array
|
|
a:chop a-a Remove last item from an array
|
|
* a:contains? an-f True if array contains n. False otherwise
|
|
a:copy sd- Copy array from s to d
|
|
* a:dup a-a Make a copy of an array
|
|
* a:eq? aa-f Compare two arrays for equality
|
|
* a:-eq? aa-f Compare two arrays for inequality
|
|
* a:fetch an-v Fetch value stored at index n in array
|
|
a:filter aq-a Run q once for each value in a. If it returns
|
|
a:first a-n Return the first value in an array
|
|
* a:for-each aq- Run q once for each value in the array. Pushes
|
|
* a:hash a-n Return the hash of an array
|
|
* a:indices av-a Return array of indices for v in source array
|
|
* a:index av-n Return first index of n in a
|
|
a:last a-n Return the last value in an array
|
|
* a:left an-a Return left n values from array
|
|
* a:length a-n Return the length of an array
|
|
* a:make ...n-a Create a new permanent array from the provided values
|
|
a:make/temp ...n-a Create a new temporary array from the
|
|
* a:map aq-a Run q once for each value in the array. Takes the
|
|
* a:middle afl-a Return new array from f to l, inclusive
|
|
a:prepend aa-a Create a new array with the contents of a2
|
|
a:reduce anq-n Takes an array, a starting value, and a quote.
|
|
a:reverse a-a Reverse the order of items in an array
|
|
* a:right an-a Return right n values from array
|
|
* a:store van- Store value v into array at index n
|
|
a:temp a-a Make a copy of the array in the temporary string/array
|
|
* a:th an-p Return the address of a specific index into the array
|
|
|
|
|
|
s:append ss-s Append s2 to s1, returning new temporary string
|
|
s:behead s-s Remove first item from a string
|
|
s:chop s-s Remove last item from a string
|
|
* s:contains? sc-f True if string contains c. False otherwise
|
|
s:copy sd- Copy string s to memory at d
|
|
* s:dup s-s Make a copy of string
|
|
* s:eq? ss-f Compare two strings for equality
|
|
* s:-eq? ss-f Compare two strings for inequality
|
|
s:evaluate s-? Interpret each token in a string
|
|
* s:fetch sn-c Return character at index n in the string
|
|
* s:filter sq-s Run q once for each value in s If it returns
|
|
s:first s-c Return the first character in a string
|
|
s:for-each sq- Run q once for each character in s. Pushes
|
|
s:get/line '-s Read a line of input until enter is
|
|
s:get/token -s Read a string from the keyboard ending when
|
|
* s:hash s-n Return the hash of the string
|
|
* s:index/c sc-f True if string contains c, false otherwise
|
|
s:keep s-s Move string to here, allocating space and returning
|
|
s:last s-c Return the last character in a string
|
|
* s:left sn-s Return left n characters of string
|
|
* s:length s-n Return the length of a string
|
|
* s:middle sfl-s Return substring from f to l, inclusive
|
|
s:pool -p Return the starting address of the temporary string/array
|
|
s:prepend ss-s Create a new string with the contents of s2
|
|
s:put s- Display a string
|
|
s:reverse s-s Reverse the order of values in the string.
|
|
s:rewrite s-s Replace underscores in string with spaces
|
|
* s:right sn-s Return right n characters of string
|
|
* s:store csn- Store character into string at index n
|
|
s:temp s-s Put a copy of a string in the temporary buffers.
|
|
* s:th sn-a Given a string and index, return the address
|
|
* s:to-lower s-s Make all characters in string lowercase
|
|
s:to-n s-n Convert a string to a number
|
|
* s:to-upper s-s Make all characters in a string uppercase
|
|
* s:trim s-s Trim both leading and trailing whitespace from a string
|
|
* s:trim-right s-s Trim trailing whitespace from a string
|
|
* s:trim-left s-s Trim leading whitespace from a string
|
|
|