(       Title:  String Arrays
         File:  sarray.fs
      Version:  0.1.1
       Author:  David N. Williams
      License:  LGPL
Last revision:  March 30, 2007
)
\ Copyright (C) 2002, 2004  David N. Williams
(
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or at your option any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
MA 02111-1307 USA.

Please see the file POLITENESS included with this distribution.

ANS Forth compatible except for:
- Case sensitivity.
- REQUIRED loads Forth source if it's not already loaded.

"Forth string" is short for "ANS Forth string", represented by
[addr len].

The last revision date may reflect cosmetic changes not recorded
below.

Version 0.1.1
29Nov04 * Renamed:
          Old   New
          S,"   C,"
          S{    S[
          }S    ]S
          }S#   ]S#
          ]S@   }S@
          ]S!   }S!
        * Revised comments.
        * New syntax examples.

Version 0.1.0
 8Apr02 * Start and release.
)
decimal

[UNDEFINED] start-depth  \ starting depth of current stack frame
[IF] variable start-depth [THEN]

-2 cells constant -2cells

: s[  ( -- )
(
Set START-DEPTH to DEPTH.
)
  depth start-depth ! ;

: ]s#  ( addr_1 len_1 ... addr_n len_n -- 'array n )
(
Make a data-space array of Forth strings from the data stack
frame started by the most recently executed S[, storing the
element pairs in the format of 2! in the order 1...n.  Leave the
array address and number of strings n.
)
  depth start-depth @ - ( 2*n) >r
  r@ 0< ( neg?) r@ 1 and ( odd?) or
      ABORT" ***Improper string data frame."
  r@ ( 2*n) align here ( 'array) >r
  ( 2*n) cells allot
  r@ ( 'first)   here -2cells + ( 'last)
  DO i 2! -2cells +LOOP
  r> ( 'arrray) r> ( 2*n) 2/ ;

: ]s  ( addr_1 len_1 ... addr_n len_n -- array.addr )
  ]s# drop ;

: c,"  ( "ccc<quote>" -- addr len )
(
Parse ccc delimited by the <quote> character, store ccc into
data space without alignment, and leave the Forth string.
)
  here >r
  [char] " parse ( addr len) >r ( r: here len)
  r@ ( len) allot
  ( addr) 2r@ move 2r> ;

: }s@  ( 'array u -- addr len )
(
Leave the u-th Forth string in the array with layout like
S[ ... ]S.  No array bounds check.
)
  2* cells + 2@ ;

: }s!  ( addr len 'array u -- )
(
Store the Forth string as the u-th element in the array with
layout like S[ ... ]S.  No array bounds check.
)
  2* cells + 2! ;

0 [IF]  \ syntax examples

s[ c," El"   c," que"   c," es"   c," perico"
   c," dondequiera"   c," es"   c," verde"
]s# constant #perico
    constant perico{

: .ith-perico  ( u -- )  perico{ swap }s@ type ;

: .perico  ( -- )  cr space
  #perico 0 DO
    space i .ith-perico
    perico{ i }s@ s" perico" compare 0=
    IF [char] , emit THEN
  LOOP [char] . emit cr ;

.perico

\ String bodies are stored coalesced.  In fact, the total space
\ used would be the same for a measured string reprensention.

.( Here is how the string bodies are stored:)
perico{ 0 }s@ drop 32 dump

[THEN]