lsparrish

( tokens in a linked list )

variable last
: new ( "- ) 32 accept     ( "-   Get a little text )
  tib keepString           (  -$  Make a permanent string of it )
  here last @ , last !     (  -   Link in last, set the pointer as the new last )
  , ;                      ( $-   compile in the text address after the link )
: access ( a-$ ) 1+ @ ;    ( a-$  From the link, go to string pointer and access it )
: next   ( a-a )
  dup access type @ ;      ( a-a  Type the text by the current link, follow the link. )

lsparrish

export OFFSET=4967232
alias extract="dd if=retroImage of=blocks.blk skip=$OFFSET ibs=4"
alias inject="dd if=blocks.blk of=retroImage ibs=4 bs=4 seek=$OFFSET"

alias text="tr -d '\000' < blocks.blk > blocks.txt"
alias block="sed -e 's/\(.\)/\1\x00\x00\x00/g' < blocks.txt > blocks.blk"

alias readable="fold -w 64 blocks.txt > readable.txt"
alias writable="tr -d '\012' < readable.txt > blocks.txt"

lsparrish

( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( >last and expose -- move a dictionary header to the top of )
( the dictionary.                                            )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

{{
  : tod     (  -a  ) last @ ;
  : nod     (  -a  ) tod @ ;  
  : d'      ( "-a  ) ' drop which @ ;
  : after   ( a-a  ) last repeat @ 2dup @ =if nip ;then again ;

lsparrish

{{
: :find ( a-af ) last repeat @ 2dup =if drop @ -1 ;; else dup 0 =if ;then then again ;
: .vocab ( a- ) dup 1+ @ :find nip if shut else open then ;
---reveal---
: as-vocab ( a- ) last @ d->class ['] .vocab swap ! ;
}}

vocab foo ((
stub bar
stub baz

lsparrish

( Elements are equivalent to variables, but are contiguous. )
{{
  : list     (  n-a ) here swap allot ;
  : setxt    (  a-  ) last @ d->xt ! ;
  : element  (  a-a ) create dup setxt 1+ ;
  ---reveal---
  : elements ( n"-  ) dup list swap for element next drop ;
}}
3 elements first second third

lsparrish

( >last and expose )

{{
  : tod     (  -a  ) last @ ;
  : nod     (  -a  ) tod @ ;  
  : after   ( a-a  ) last repeat @ 2dup @ =if nip ;then again ;
  : remove  ( a-   ) dup @ swap after ! ;
  : replace ( a-   ) tod over ! last ! ;
  ---reveal---
  : >last   ( a-   ) dup remove replace ;

lsparrish

( cd -- char dict )
( cdl -- cd last )
( cdn -- cd new  )
( cdf -- cd find )
( cde -- cd exec )
( cdk -- cd key  )

vocab cd ((
variable cdl
: cdn ( "-   ) 32 accept here @cdl , @tib , !cdl ] ;

lsparrish

( char dictionary )
variable cdl
: cdn ( "-   ) 32 accept here @cdl , @tib , !cdl -1 , ] ;
: cdf ( c-af ) cdl repeat @ 2dup 1+ @ =if nip 3 + -1 ;then dup 0; drop again ;
: cde ( c-   ) cdf if dup 1- @ 0 =if drop ;then execute ;then drop ;
: cda ( c-   ) cdf if 1- on ;then '? emit ;
: cdd ( c-   ) cdf if 1- off ;then '? emit ;
( keep tib string )
: kts tib here over getLength 1+ dup allot copy ;
( accept input, test each char )

lsparrish

variable this
variable that
: chain create here !that 0 , here !this 2 allot ;
: +link here push @this , @last , pop !this @@last !last ;
: seal @this @that ! ;

variable flag
variable xt
variable str
: zdrop ( n-n | nz-z ) dup 0 =if 2drop 0 then ;

lsparrish

( stack for nesting quotes )
chain: quote
  create   stack here , 10 allot
  : push   stack dup ++ @ ! ;
  : pop    stack dup @ @ swap -- ;
  : empty? stack dup @ = ;
;chain
chain: parable
  : __: header ; parsing
  : nest   compiler on here \quote.push 0 , 0 , ;