retroforth/interface/future.retro

# 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.)

~~~
:gc (q-) &Heap swap v:preserve ;

'NextArray var
'Arrays d:create
  #513 #12 n:mul allot


: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