42 lines
		
	
	
		
			1.2 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			42 lines
		
	
	
		
			1.2 KiB
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2008 Slava Pestov.
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
USING: accessors arrays sequences kernel sequences assocs
 | 
						|
namespaces stack-checker.recursive-state.tree ;
 | 
						|
IN: stack-checker.recursive-state
 | 
						|
 | 
						|
TUPLE: recursive-state word words quotations inline-words ;
 | 
						|
 | 
						|
: prepare-recursive-state ( word rstate -- rstate )
 | 
						|
    swap >>word
 | 
						|
    f >>quotations
 | 
						|
    f >>inline-words ; inline
 | 
						|
 | 
						|
: initial-recursive-state ( word -- state )
 | 
						|
    recursive-state new
 | 
						|
        f >>words
 | 
						|
        prepare-recursive-state ; inline
 | 
						|
 | 
						|
f initial-recursive-state recursive-state set-global
 | 
						|
 | 
						|
: add-recursive-state ( word -- rstate )
 | 
						|
    recursive-state get clone
 | 
						|
        [ word>> dup ] keep [ store ] change-words
 | 
						|
        prepare-recursive-state ;
 | 
						|
 | 
						|
: add-local-quotation ( recursive-state quot -- rstate )
 | 
						|
    swap clone [ dupd store ] change-quotations ;
 | 
						|
 | 
						|
: add-inline-word ( word label -- rstate )
 | 
						|
    swap recursive-state get clone
 | 
						|
    [ store ] change-inline-words ;
 | 
						|
 | 
						|
: recursive-word? ( word -- ? )
 | 
						|
    recursive-state get 2dup word>> eq?
 | 
						|
    [ 2drop t ] [ words>> lookup ] if ;
 | 
						|
 | 
						|
: inline-recursive-label ( word -- label/f )
 | 
						|
    recursive-state get inline-words>> lookup ;
 | 
						|
 | 
						|
: recursive-quotation? ( quot -- ? )
 | 
						|
    recursive-state get quotations>> lookup ;
 |