32 lines
820 B
Factor
32 lines
820 B
Factor
|
! Copyright (C) 2008 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: accessors kernel sequences math math.order ;
|
||
|
|
IN: stack-checker.recursive-state.tree
|
||
|
|
|
||
|
|
! Persistent unbalanced hash tree using eq? comparison.
|
||
|
|
! We use this to speed up stack-checker.recursive-state.
|
||
|
|
! Perhaps this should go somewhere else
|
||
|
|
|
||
|
|
TUPLE: node value key hashcode left right ;
|
||
|
|
|
||
|
|
GENERIC: lookup ( key node -- value/f )
|
||
|
|
|
||
|
|
M: f lookup nip ;
|
||
|
|
|
||
|
|
: decide ( key node -- key node ? )
|
||
|
|
over hashcode over hashcode>> <= ; inline
|
||
|
|
|
||
|
|
M: node lookup
|
||
|
|
2dup key>> eq?
|
||
|
|
[ nip value>> ]
|
||
|
|
[ decide [ left>> ] [ right>> ] if lookup ] if ;
|
||
|
|
|
||
|
|
GENERIC: store ( value key node -- node' )
|
||
|
|
|
||
|
|
M: f store drop dup hashcode f f node boa ;
|
||
|
|
|
||
|
|
M: node store
|
||
|
|
clone decide
|
||
|
|
[ [ store ] change-left ]
|
||
|
|
[ [ store ] change-right ] if ;
|