dict.fth

[UNDEFINED] 1place    [IF] : 1place     swap rot drop ; [THEN]
[UNDEFINED] 2pick     [IF] : 2pick      2 pick        ; [THEN]
[UNDEFINED] addi      [IF] : addi       over +        ; [THEN]
[UNDEFINED] cell-     [IF] : cell-      -1 cells +    ; [THEN]
[UNDEFINED] char-     [IF] : char-      -1 chars +    ; [THEN]
[UNDEFINED] dropdrop0 [IF] : dropdrop0  drop drop 0   ; [THEN]
[UNDEFINED] neqn      [IF] : neqn       2dup <>       ; [THEN]
[UNDEFINED] 1cells/   [IF] : 1cells/    1 cells /     ; [THEN]


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\
\  Memory-based stacks are useful for many things.  Here are
\  some words for handling them:
\
\ stack format:
\
\   pStk+0c:  data pointer
\   pStk+1c:  initial pointer (only required for stk.{bottom,
\                              clear,depth,empty?,full?})
\   pStk+2c:  allocated size  (only used in stk.{free,full?})
\
\  pStk+3c+:  data region     (optional... may reside elsewhere,
\                              starting at wherever "initial pointer"
\                              (pStk+1c) points but stk.create
\                              puts it here)
\
\  Rudimentary stacks could just have a data pointer (pStk+0c),
\  so long as only the words stk.{next,top,set,push,pull,pop,drop}
\  are used.  Including the initial pointer (pStk+1c) allows for
\  using the words stk.{bottom,clear,depth,empty?}.  Such stacks
\  could be created at "here" with "dup , ,"  ( pInit -- ). [see
\  stk.bounds_checking caveats, below]

: stk._aus    3 + cells      ; ( size -- cells )    \ number of address units needed by a stack of the given size

: stk.next    @              ; ( pStk -- pNext )    \ Next address for the stack
: stk.bottom  cell+ @        ; ( pStk -- pBottom )  \ Address of the first data pushed
: stk.size    2 cells + @    ; ( pStk -- cells )    \ Number of cells allocated for the stack

: stk._set    !              ; ( pNext pStk -- )    \ Set the stack pointer to the given value
: stk.top     stk.next cell- ; ( pStk -- pTop )     \ Address of the last data pushed

: stk.reset   dup stk.bottom swap stk._set    ; ( pStk -- ) \ Empty the stack

: stk.depth   dup stk.next  swap stk.bottom - 1cells/ ; ( pStk -- depth ) \ Number of elements in the stack
: stk.empty?  dup stk.next  swap stk.bottom =         ; ( pStk -- -1|0 )  \ Whether or not the stack is empty
: stk.full?   dup stk.depth swap stk.size   =         ; ( pStk -- -1|0 )  \ Whether or not the stack is full

: stk.push    dup stk.next tuck cell+ swap stk._set ! ; ( data pStk -- )  \ Push data on the stack
: stk.pull    dup stk.next tuck cell+ swap stk._set @ ; ( pStk -- data )  \ Pull from stk.next and increment pointer, as though it's really a queue tail
: stk.pop     dup stk.top  tuck       swap stk._set @ ; ( pStk -- data )  \ Pop data off the stack and return the value popped
: stk.drop    dup stk.top  swap            stk._set   ; ( pStk -- )       \ Drop data off the stack without returning it
: stk.pick    stk.top swap negate cells + @           ; ( u pStk -- d )   \ Pick the u'th element from the top of stack
: stk.place   stk.top swap negate cells + !           ; ( d u pStk -- )   \ Place d as the u'th element from the top of stack

\ initialize the stack at memory pStk to the given size
: stk._init   ( size pStk -- )
  dup 3 cells + 2dup over ! cell+ ! 2 cells + !
;

\ Create a stack of the specified size at "here", and return what "here" was
: stk.allot   ( size -- pStk )
  align here tuck over stk._aus allot stk._init
;

\ Create a stack of the specified size at "here", store the stack in <name>
: stk.create  ( size "<name>" -- )
  stk.allot constant
;

\ Create a stack of the specified size in dynamic memory or throw an exception
: stk.allocate   ( size -- pStk )
  dup stk._aus allocate throw tuck stk._init
;

\ Deallot the space for this stack if it's at the top of the data space
: stk.deallot  ( pStk -- )
  dup stk.size 3 + cells
  swap addi here <> abort" stk.deallot: can't free stack"
  negate allot
;

\ Deallocate the space for this stack
: stk.free  ( pStk -- )
  free throw
;

\ Execute xt ( n -- ) for each element, n, on the stack, from deepest to topmost.
: stk.foreach  ( xt pStk -- )
  swap >r
  dup  stk.next
  swap stk.bottom
  begin
    neqn
  while
    dup @ r@ execute
    cell+
  repeat
  2drop
  r> drop
;

\ Show the stack elements
: stk.emit  ( pStk -- )
  [char] < emit
  dup stk.depth 0 .r
  ." > "
  ['] . swap stk.foreach
;

\  When stk.bounds_checking is enabled, stk.{pop,drop} also need
\  pStk+1c to be properly initialized, and stk.{push,pull} need
\  pStk+1c and pStk+2c to be properly initialized, since they will
\  call stk.empty? and stk.full?, respectively.

[DEFINED] stk.bounds_checking [IF]
: stk.not_empty dup stk.empty?  abort" stk.not_empty: stack empty" ;
: stk.not_full  dup stk.full?   abort" stk.not_full: stack full"   ;
: stk.index?    stk.depth u< 0= abort" stk.index?: stack index out of range" ;

: stk.push stk.not_full  stk.push ;
: stk.pull stk.not_full  stk.pull ;
: stk.pop  stk.not_empty stk.pop  ;
: stk.drop stk.not_empty stk.drop ;

: stk.pick  2dup stk.index? stk.pick  ;
: stk.place 2dup stk.index? stk.place ;
[THEN]



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\   A small, general-purpose temporary stack to be used when
\   needed, particularly to help support re-entrancy of functions.
\   The value tmp_stack is adjustable, in case the user wishes to
\   make a larger stack (even temporarily) for their purposes:
\
\     tmp_stack
\       256 stk.allocate to tmp_stack
\     >t
\     [... use ">t", "t>", etc., with larger stack... ]
\     t>
\       tmp_stack stk.free
\     to tmp_stack

0 value tmp_stack
16 stk.allot to tmp_stack
: >t tmp_stack stk.push  ;
: t> tmp_stack stk.pop   ;
: t@ tmp_stack stk.top @ ;
: t! tmp_stack stk.top ! ;
: .t tmp_stack stk.emit  ;



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\   The 'str' objects represent reduced string capabilities.
\   They are not guaranteed to support lengths greater than 255
\   nor to allow nul characters.  Their implementation is not
\   specified to be any particular form, just that the following
\   methods are supported:
\
\     str.aus     ( u -- aus )
\     str.place   ( c-addr u str -- )
\
\     str.cpy     ( c-addr u -- str )
\     str.dup     ( str1 -- str2 )
\     str.tail    ( str1 u -- str2 )
\     str.head    ( str1 u -- str2 )
\     str.cat     ( str1 str2 -- str3 )
\     str.deallot ( str -- )
\
\     str.chars   ( str -- c-addr )
\     str.len     ( str -- len )
\     str.cmp     ( str1 str2 -- -1|0|1 )
\     str.=       ( str1 str2 -- 0|-1 )
\     str.<       ( str1 str2 -- 0|-1 )
\     str.foreach ( xt str -- )
\     str.emit    ( str -- )
\     str.c,      ( str -- )
\
\   The words str.{cpy,dup,tail,head,cat} create new 'str' objects
\   at "here", calling "allot" to create space.  The word
\   str.deallot attempts to free a 'str' object, but may silently
\   fail if "here" is different from the time just after the
\   object was created, leaving the memory to leak.

\   [The implmentation below uses null-terminated strings, yet
\    there is still no general guarantee that a 'str' object
\    can store more than 255 characters, since other implementations
\    may opt for counted-string formats.]

\ the number of address units (aus) needed to store a string
\ with the specified number of characters
: str.aus  ( u -- aus )
  1+ chars
;

\ initialize the 'str' object with the 'u' non-nul characters
\ found starting at 'c-addr'.  'str' must be an address for a
\ memory region of at least size "u str.aus".  any previous
\ data in the region will be lost.
: str.place  ( c-addr u str -- )
  >r chars tuck r@ swap move
  r> + 0 swap c!
;

\ make a 'str' object, possibly at "here", with the 'u' non-nul
\ characters found starting at 'c-addr'
: str.cpy  ( c-addr u -- str )
  here swap chars dup allot

  ( c-addr str uc )
  >r tuck r>
  move 0 c,
;

\ get a pointer to the first character in 'str'.  subsequent
\ characters are at char+, etc. writing to the given character
\ positions will change the contents of the string.  use str.dup
\ to get a private copy for adjusting.
: str.chars  ( str -- c-addr )
;

\ return the length of the string 'str' (may be expensive)
: str.len  ( str -- len )
  0 swap
  begin
    dup c@
  while
    char+ swap 1+ swap
  repeat
  drop
;

\ create a new str object with contents duplicating 'str1' possibly at "here"
: str.dup  ( str1 -- str2 )
\ dup str.chars swap str.len str.cpy
  here swap
  char-
  begin
    char+
    dup c@
    dup c,
    0=
  until
  drop
;

\ create a new str object with the trailing characters of 'str1', having
\ dropped the first 'u' characters in 'str1'.  if 'u' is greater than
\ the value str.len would return, the result may be garbage.
: str.tail ( str1 u -- str2 ) chars + str.dup ;

\ create a new str object having the first 'u' characters in 'str1',
\ possibly at "here".  if 'u' is greater than the value str.len
\ would return, the result may be garbage.
: str.head ( str1 u -- str2 ) str.cpy ;

\ create a new str object that is the concatenation of 'str1' and
\ 'str2'.  if the sum of the lengths of the two input strings is
\ greater than 255, the result may be garbage.
: str.cat ( str1 str2 -- str3 )
  swap str.dup swap
  here char- \ assumes str.dup put it at "here" and left "here"
             \ pointing past the terminating nul
  over str.len chars dup allot
  char+ move
;

\ attempt to return the storage allocated for the given 'str' back to
\ the system for use.  no indication of success will be returned.  if
\ 'str' objects are passed to str.deallot in the reverse order from
\ their generation via str.dup/str.cpy/str.head/str.tail/str.cat, and
\ "here" has not moved via some other means, success is more likely.
: str.deallot ( str -- )
  dup
  begin
    dup c@
  while
    char+
  repeat
  char+
  dup here = if
    - allot exit
  then
  2drop
;

\ compare 'str1' and 'str2'
: str.cmp  ( str1 str2 -- -1|0|1 )
  begin
    over c@ over c@ dup
  while
    neqn if
      < 1 or nip nip exit
    then
    drop drop
    char+ swap char+ swap
  repeat
  drop
  nip
  nip
  0<>
  1 and
;

: str.=  ( str1 str2 -- -1|0 )  str.cmp 0= ;  \ are 'str1' and 'str2' equal?
: str.<  ( str1 str2 -- -1|0 )  str.cmp 0< ;  \ is 'str1' less than 'str2'?

\ call xt ( c -- ) for each character, 'c', in the string
: str.foreach ( xt str -- )
  swap >r
  begin
    dup c@ dup
  while
    swap r@ swap >r execute
    r> char+
  repeat
  2drop
  r> drop
;

: str.emit    ( str -- )  ['] emit swap  str.foreach ;
: str.c,      ( str -- )  ['] c,   swap  str.foreach ;
: str." ( "..." -- str )  [char] " parse str.cpy     ;



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\   A list object is a singly-linked list of aligned addresses.
\   Pointers to list elements, ple, have the following (very
\   simple) format:
\
\     ple+0c: pNext  \ the next entry in the list (or 0 for end of list)
\
\   Lists are most useful when data is stored at fixed offsets
\   around this pointer, such as ple+1c or ple-1c, etc.
\
\   The base data in a list object is a single cell, which is
\   simply a pointer to the first ple.  This pointer may
\   be null (0), indicating an empty list.

: list._ini   (      pList -- )  0 swap !                      ; \ initialize a list, losing any previous data
: list._del   (       pple -- )  dup @ @ swap !                ; \ delete the next entry.  dangerous if there is no next entry
: list.push   (  ple pList -- )  dup @ 2pick ! !               ; \ push an entry on the front of a list
: list.pop    (  pList -- ple )  dup @ if dup list._del then @ ; \ pop the first element off the list, if it isn't already empty
: list.end    (  pList -- ple )  begin dup @ while @ repeat    ; \ find the last element in a list (may be expensive)
: list.app    (  ple pList -- )  list.end list.push            ; \ add an entry to the back of a list (may be expensive)
: list.next   (   ple -- ple' )  @                             ; \ next element in list
: list.empty? ( pList -- -1|0 )  list.next 0=                  ; \ is the list empty?

\ count the length of the list (expensive)
: list.length ( pList -- len )
  0
  begin
    swap list.next dup
  while
    swap 1+
  repeat
  drop
;


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\  Call xt ( ple -- -1|0 ) for each element in the list until
\  non-zero is returned.  Return either -1 or 0 indicating
\  whether a non-zero was ever returned, along with the list
\  entry *right*before* the one for which xt returned non-zero,
\  or a pointer to the last element in the list.
\
: list.find ( xt pList -- pple -1 | pend 0 )
  swap >r
  begin
    dup list.next
  while
    >r
    2r@ list.next swap execute if
      2r> nip
      true
      exit
    then
    r> list.next
  repeat
  r> drop
  false
;


\  Call xt ( ple -- ) for each element in the list.
: list.foreach ( xt pList -- )
  swap >r
  begin
    list.next
    dup
  while
    >r
    2r@ swap execute
    r>
  repeat
  drop
  r> drop
;


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\   Unlike Python, this dict is purely a map from 'str'
\   objects to 'pde's.  The format for a pointer to a dict
\   entry, 'pde' (an aligned address), is as follows:
\
\     pde+0c: pNext  \ the next entry in the dict
\     pde+1c: str    \ the 'str' object with this entry's name
\
\   Typically, users will store data at pde-1c,
\   pde-2c, etc., since the 'str' object may be variable length
\   and tedious to get past, though this is not required.
\
\   The base data in a dict object is a single cell which is
\   simply a pointer to the first pde.  This pointer may be
\   null (0), indicating an empty dict.  Null also indicates
\   the end of the list of entries.
\
\   The data format is generally compatible with the 'list'
\   object format.
\
: dict._ini    ( dict -- )      list._ini    ;
: dict.add     ( pde dict -- )  list.push    ;
: dict.foreach ( xt dict -- )   list.foreach ;
: pde.str      ( pde -- str )   cell+        ;

\ Either find the 'str' in the given dict or return a
\ pointer to the last entry in the dict.  This routine uses
\ global storage to save 'str', and so is neither re-entrant
\ nor thread-safe. The entry returned is the one most
\ recently added with either dict.add or dict.xadd
variable _pName
: _key_cmp pde.str _pName @ str.= ;
: dict.find ( str dict -- ppde -1 | pend 0 )
  swap _pName ! ['] _key_cmp swap list.find
;


\ "Exclusive add" the given entry to the 'dict'.  The first
\ matching entry is removed as with dict.del, and the new
\ entry is either inserted at that position or put at the
\ end of the 'dict' (if no previous entry was found).  If
\ a previous entry was removed, it's returned as 'orig'.
\ Otherwise, 0 is returned.
: dict.xadd ( pde dict -- orig | 0 )
  over pde.str swap dict.find
  drop dup list.next >r
  dup list.pop drop
  list.push
  r>
;

\ Remove an entry named by the given 'str', if found.
\ Return the removed entry, 'orig', or 0, if none was
\ found.
: dict.del  ( str dict -- orig | 0 )
  dict.find
  drop dup
  list.pop
  list.next
;


0 [IF] \ unfinished:
: ??? ." unimplemented" abort ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\   The 'string' object stores a sequence of characters.  It
\   is much like the 'str' object, except that it is guaranteed
\   to be able to store INT_MAX characters, if there's enough
\   system memory, and null characters are allowed.
\
: string.new     (                 -- string )   ??? ; \ make an empty array of characters
: string.zeros   (               u -- string )   ??? ; \ make an array of 'u' characters initialized to 0
: string.cpy     (        c-addr u -- string )   ??? ; \ copy u characters from addr into an "array-of-characters" object
: string.data    (         string  -- c-addr )   ??? ; \ obtain a pointer to the first character
: string.size    (         string  -- size )     ??? ; \ get number of characters in string.data
: string.resize  (    size string  -- string' )  ??? ; \ resize the array of characters
: string.dup     (         string  -- string' )  ??? ; \ duplicate the array of characters
: string.cmp     ( string1 string2 -- -1|0|1 )   ??? ; \ compare two arrays of characters
: string.cat     ( string1 string2 -- string3 )  ??? ; \ concatenate two arrays of characters
: string.delete  (         string  -- )          ??? ; \ destroy the array and release the memory used
: string.foreach (      xt string  -- )          ??? ; \ call xt ( c -- ) for each character in the string
: string.emit    (         string  -- ) ['] emit swap string.foreach ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\   The 'array' object stores a sequence of cells.  It
\   is much like the 'string' object, except that it works
\   on cells, not characters.
\
: array.new     (               -- array )   ??? ; \ make an empty array of cells
: array.zeros   (            u  -- array )   ??? ; \ make an array of 'u' cells initialized to 0
: array.cpy     (     a-addr u  -- array )   ??? ; \ copy u cells from addr into an "array-of-cells" object
: array.data    (        array  -- a-addr )  ??? ; \ obtain a pointer to the first cell
: array.index   (    idx array  -- a-addr )  ??? ; \ obtain a pointer to cell 'idx' of the data
: array.size    (        array  -- size )    ??? ; \ get number of cells in array.data
: array.resize  (   size array  -- array' )  ??? ; \ resize the array of cells
: array.dup     (        array  -- array' )  ??? ; \ duplicate the array of cells
: array.cmp     ( array1 array2 -- -1|0|1 )  ??? ; \ compare two arrays of cells
: array.cat     ( array1 array2 -- array3 )  ??? ; \ concatenate two arrays of cells
: array.delete  (        array  -- )         ??? ; \ destroy the array and release the memory used
: array.foreach (     xt array  -- )         ??? ; \ call xt ( x -- ) for each cell in the array

[THEN]