( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Associative Arrays [aka. Hash Tables] for Retro              )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2010, Marc Simpson                             )
( License: ISC                                                 )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

include library/data/ll.retro
include library/data/hash.retro

' hashing open

( ~~[ Associative Array Vocab ]~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

vocab associative
((
  : preallocate ( n- )
    ll.make ll:freelist !  for ll.make ll.free next ;

  1000 preallocate

  : new-hash   (   -t ) here hash-prime @ zallot ;
  : new-bucket ( $x-a ) here push swap , , pop ;

  : add-entry ( $xt- )
    push  over hash push new-bucket pop ( ah )
    pop ( aht ) + ( ae ) swap
    ll.new tuck ll.data !
    ( el ) over @ over ! ( next pointer )
    swap ! ;

  : get-entry (  $t-xf )
    over hash + @ ( $l )
    repeat dup 0 =if nip 0 ;then
    2dup ll.data @ @ compare if nip ll.data @ 1+ @ -1 ;then
    @ again ;

  {{
    : chop (  $-$ ) dup getLength + 1- 0 swap ! ;
    : (%{) ( "- ) char: = accept tib keepString dup chop ;
    ---reveal---
    : %{   ( "- ) compiler @ if ahead (%{) here rot ! literal,
                  else (%{) then ; immediate
  }}

  : }%   ( t$x- ) rot add-entry ;
  : @"   (  t"- ) compiler @ if
                  ahead " keepString here rot ! literal, else "
                  then ` swap ` get-entry ; immediate
))

' hashing shut
' associative shut