basis/stack-checker/recursive-state/tree/tree.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel sequences math math.order ;
   4 IN: stack-checker.recursive-state.tree
   5
   6 ! Persistent unbalanced hash tree using eq? comparison.
   7 ! We use this to speed up stack-checker.recursive-state.
   8 ! Perhaps this should go somewhere else
   9
  10 TUPLE: node value key hashcode left right ;
  11
  12 GENERIC: lookup ( key node -- value/f )
  13
  14 M: f lookup nip ;
  15
  16 : decide ( key node -- key node ? )
  17     over hashcode over hashcode>> <= ; inline
  18
  19 M: node lookup
  20     2dup key>> eq?
  21     [ nip value>> ]
  22     [ decide [ left>> ] [ right>> ] if lookup ] if ;
  23
  24 GENERIC: store ( value key node -- node' )
  25
  26 M: f store drop dup hashcode f f node boa ;
  27
  28 M: node store
  29     clone decide
  30     [ [ store ] change-left ]
  31     [ [ store ] change-right ] if ;