\ Copyright (c) 2008, Samuel A. Falvo II
\ All rights reserved.
\ 
\ Redistribution and use in source and binary forms, with or
\ without modification, are permitted provided that the
\ following conditions are met:
\  
\     * Redistributions of source code must retain the above
\       copyright notice, this list of conditions and the
\       following disclaimer.
\ 
\     * Redistributions in binary form must reproduce the
\       above copyright notice, this list of conditions and
\       the following disclaimer in the documentation and/or
\       other materials provided with the distribution.
\ 
\     * Neither the name of the Falvotech nor the names
\       of its contributors may be used to endorse or promote
\       products derived from this software without specific
\       prior written permission.
\ 
\ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
\ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
\ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
\ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
\ DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
\ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
\ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
\ NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
\ LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
\ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
\ OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
\ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ 
\  This tokenizer works for blocks and arbitrary strings or
\  for blocks.  You can define your own input source types
\  as well.
\ 
\  Use as follows:
\   5 blok evl
\   S" foo far baz" string evl


( tokenizer state )
variable src ( meaning depends on current handler )
variable #src ( meaning depends on current handler )
variable 'start
variable 'nbr
variable inp ( really named >in in the target environment )
: start ( of current input buffer ) 'start @ execute ;
: nbr ( of characters in input buffer ) 'nbr @ execute ;
: src>r r> inp @ >r src @ >r #src @ >r 'start @ >r 'nbr @ >r >r ;
: r>src r> r> 'nbr ! r> 'start ! r> #src ! r> src ! r> inp ! >r ;


( tokenizer source modes )
: sstart ( of the string buffer ) src @ ;
: bstart ( of the block ) src @ block ;
: snbr ( of valid input characters in the buffer ) #src @ ;
: bnbr ( of characters in the block ) 1024 ;

: string #src ! src ! ['] sstart 'start ! ['] snbr 'nbr ! ;
: blok src ! ['] bstart 'start ! ['] bnbr 'nbr ! ;


( tokenizer driver )
: adr ( of next input character ) start inp @ + ;
: ws adr c@ 33 <  inp @ nbr < and ;
: -ws adr c@ 32 >  inp @ nbr < and ;
: skip ( whitespace ) begin ws while 1 inp +! repeat ;
: seek ( whitespace ) begin -ws while 1 inp +! repeat ;
: token ( of length zero if at end of input buffer )
  skip adr seek adr over - ;


( tokenizer testing )
: text ." Hello" ;
: setup   S" text cr" ;
: text2 ." World" ;
: setup2  S" text2 setup str cr" ;
: evl ( stupid-simple interpreter )
  inp off begin token dup while sfind if execute then repeat 2drop ;
: ld ( a block and interpret it! ) src>r blok evl r>src ;
: str ( evaluate a string! ) src>r string evl r>src ;
: iniblk  5 block 32 fill S" blort" 5 block swap move update ;
: blort   setup str setup2 str cr ;
: blktst  5 ld ;