lsparrish

( compare two strings from the beginning and return how many )
( similar characters there are before the strings diverge. )
: ^match ( $$-n ) 0 -rot repeat @+ push swap @+ pop =if rot 1+ -rot else 2drop ;then again ;

( test each word in the dictionary for similarity. if similar up )
( to the current point, add to the suggestions queue. )
create list here , 100 allot
: to_list ( n- ) list ++ list @ ! ;
: fr_list ( -n ) list @ @ list -- ;
: no_list ( -  ) list dup ! ;

lsparrish

: contig variable 0 , allot ;
: linked variable -1 , ;

: >contig .data ` tuck ` @ ` ! ` ++ ;
: <contig .data ` dup ` -- ` @ ` @  ;
: >linked .data ` here ` over ` @ ` , ` swap ` ! ` , ;
: <linked .data ` dup ` @ ` 1+ ` @ ` swap ` dup ` @ ` @ ` swap ` ! ;

: __> dup 1+ @ if >linked ;then >contig ; immediate

lsparrish

: above ( aa-a ) repeat tuck @ over =if drop ;then swap @ 0; again ;

2 elements tp tib 1024 allot
: tib, tp ++ !@tp ;
: tz tib !tp ; tz

2 elements t trig
: findTrig !t trig repeat @ 0; dup 1+ @ @t = not 0; drop again ;
: doTrig   findTrig dup 3 + @ swap 2 + @ with-class ;
: addTrig  here @trig , !trig , &.word , here 1+ , 0 , 0 , [ ;

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 , ;

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

( 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

( 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

( >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

( 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

{{
: :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