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