Stack checker cleanup and optimization

- stack-checker.state vocabulary split up into stack-checker.{state,values,recursive-state}
- code that modifies and searches recursive state factored out into stack-checker.recursive-state
- recursive state is now a set of three binary hash trees instead of an alist, and no longer contains unnecessary data
- binary hash trees are in stack-checker.recursive-state.tree: unbalanced, persistent
- ~8 second speedup on bootstrap, ~20 second speedup in "peg.javascript" require

basis/compiler/tree/builder/builder.factor

@@ -1,9 +1,13 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors quotations kernel sequences namespaces
-assocs words arrays vectors hints combinators stack-checker
+assocs words arrays vectors hints combinators compiler.tree
-stack-checker.state stack-checker.visitor stack-checker.errors
+stack-checker
-stack-checker.backend compiler.tree ;
+stack-checker.state
+stack-checker.errors
+stack-checker.visitor
+stack-checker.backend
+stack-checker.recursive-state ;
 IN: compiler.tree.builder
 
 : with-tree-builder ( quot -- nodes )

basis/compiler/tree/escape-analysis/allocations/allocations.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs namespaces sequences kernel math
-combinators sets disjoint-sets fry stack-checker.state ;
+combinators sets disjoint-sets fry stack-checker.values ;
 IN: compiler.tree.escape-analysis.allocations
 
 ! A map from values to one of the following:

basis/stack-checker/backend/backend.factor

@@ -5,7 +5,8 @@ namespaces parser prettyprint sequences strings vectors words
 quotations effects classes continuations debugger assocs
 combinators compiler.errors accessors math.order definitions
 sets generic.standard.engines.tuple stack-checker.state
-stack-checker.visitor stack-checker.errors ;
+stack-checker.visitor stack-checker.errors
+stack-checker.values stack-checker.recursive-state ;
 IN: stack-checker.backend
 
 : push-d ( obj -- ) meta-d get push ;

basis/stack-checker/branches/branches.factor

@@ -3,7 +3,7 @@
 USING: fry vectors sequences assocs math accessors kernel
 combinators quotations namespaces stack-checker.state
 stack-checker.backend stack-checker.errors stack-checker.visitor
-;
+stack-checker.values stack-checker.recursive-state ;
 IN: stack-checker.branches
 
 : balanced? ( pairs -- ? )

basis/stack-checker/errors/errors.factor

@@ -2,10 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel generic sequences prettyprint io words arrays
 summary effects debugger assocs accessors namespaces
-compiler.errors stack-checker.state ;
+compiler.errors stack-checker.values
+stack-checker.recursive-state ;
 IN: stack-checker.errors
 
-TUPLE: inference-error error type rstate ;
+TUPLE: inference-error error type word ;
 
 M: inference-error compiler-error-type type>> ;
 
@@ -13,7 +14,7 @@ M: inference-error error-help error>> error-help ;
 
 : (inference-error) ( ... class type -- * )
     >r boa r>
-    recursive-state get
+    recursive-state get word>>
     \ inference-error boa throw ; inline
 
 : inference-error ( ... class -- * )
@@ -23,10 +24,7 @@ M: inference-error error-help error>> error-help ;
     +warning+ (inference-error) ; inline
 
 M: inference-error error.
-    [
+    [ "In word: " write word>> . ] [ error>> error. ] bi ;
-        rstate>>
-        [ "Nesting:" print stack. ] unless-empty
-    ] [ error>> error. ] bi ;
 
 TUPLE: literal-expected ;
 

basis/stack-checker/inlining/inlining.factor

@@ -4,18 +4,20 @@ USING: fry namespaces assocs kernel sequences words accessors
 definitions math math.order effects classes arrays combinators
 vectors arrays
 stack-checker.state
+stack-checker.errors
+stack-checker.values
 stack-checker.visitor
 stack-checker.backend
 stack-checker.branches
-stack-checker.errors
+stack-checker.known-words
-stack-checker.known-words ;
+stack-checker.recursive-state ;
 IN: stack-checker.inlining
 
 ! Code to handle inline words. Much of the complexity stems from
 ! having to handle recursive inline words.
 
 : infer-inline-word-def ( word label -- )
-    [ drop def>> ] [ add-local-recursive-state ] 2bi infer-quot ;
+    [ drop def>> ] [ add-inline-word ] 2bi infer-quot ;
 
 TUPLE: inline-recursive < identity-tuple
 id

basis/stack-checker/known-words/known-words.factor

@@ -11,14 +11,15 @@ strings.private system threads.private classes.tuple
 classes.tuple.private vectors vectors.private words definitions
 words.private assocs summary compiler.units system.private
 combinators locals locals.backend locals.private words.private
-quotations.private
+quotations.private stack-checker.values
+stack-checker.alien
 stack-checker.state
+stack-checker.errors
+stack-checker.visitor
 stack-checker.backend
 stack-checker.branches
-stack-checker.errors
 stack-checker.transforms
-stack-checker.visitor
+stack-checker.recursive-state ;
-stack-checker.alien ;
 IN: stack-checker.known-words
 
 : infer-primitive ( word -- )

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

@@ -0,0 +1,43 @@
+! 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 words word quotations inline-words ;
+
+C: <recursive-state> recursive-state
+
+: 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 ;

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

@@ -0,0 +1,31 @@
+! 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 ;

basis/stack-checker/state/state.factor

@@ -5,75 +5,6 @@ math effects accessors words fry classes.algebra
 compiler.units ;
 IN: stack-checker.state
 
-! Recursive state
-SYMBOL: recursive-state
-
-: initial-recursive-state ( word -- state )
-    { } { } 3array 1array ; inline
-
-f initial-recursive-state recursive-state set-global
-
-: add-recursive-state ( word -- rstate )
-    [ recursive-state get ] dip { } { } 3array prefix ;
-
-: add-local-quotation ( recursive-state quot -- rstate )
-    [ unclip first3 swap ] dip prefix swap 3array prefix ;
-
-: add-local-recursive-state ( word label -- rstate )
-    [ recursive-state get ] 2dip
-    [ unclip first3 ] 2dip 2array prefix 3array prefix ;
-
-: recursive-word? ( word -- ? )
-    recursive-state get key? ;
-
-: inline-recursive-label ( word -- label/f )
-    recursive-state get first third at ;
-
-: recursive-quotation? ( quot -- ? )
-    recursive-state get first second [ eq? ] with contains? ;
-
-! Values
-: <value> ( -- value ) \ <value> counter ;
-
-SYMBOL: known-values
-
-: known ( value -- known ) known-values get at ;
-
-: set-known ( known value -- )
-    over [ known-values get set-at ] [ 2drop ] if ;
-
-: make-known ( known -- value )
-    <value> [ set-known ] keep ;
-
-: copy-value ( value -- value' )
-    known make-known ;
-
-: copy-values ( values -- values' )
-    [ copy-value ] map ;
-
-! Literal value
-TUPLE: literal < identity-tuple value recursion ;
-
-: <literal> ( obj -- value )
-    recursive-state get \ literal boa ;
-
-GENERIC: (literal) ( value -- literal )
-
-M: literal (literal) ;
-
-: literal ( value -- literal )
-    known (literal) ;
-
-! Result of curry
-TUPLE: curried obj quot ;
-
-C: <curried> curried
-
-! Result of compose
-TUPLE: composed quot1 quot2 ;
-
-C: <composed> composed
-
 ! Did the current control-flow path throw an error?
 SYMBOL: terminated?
 
@@ -99,9 +30,6 @@ SYMBOL: meta-r
     V{ } clone meta-r set
     0 d-in set ;
 
-: init-known-values ( -- )
-    H{ } clone known-values set ;
-
 ! Words that the current quotation depends on
 SYMBOL: dependencies
 

basis/stack-checker/transforms/transforms.factor

@@ -5,7 +5,8 @@ namespaces make quotations assocs combinators classes.tuple
 classes.tuple.private effects summary hashtables classes generic
 sets definitions generic.standard slots.private continuations
 stack-checker.backend stack-checker.state stack-checker.visitor
-stack-checker.errors ;
+stack-checker.errors stack-checker.values
+stack-checker.recursive-state ;
 IN: stack-checker.transforms
 
 : give-up-transform ( word -- )

basis/stack-checker/values/values.factor

@@ -0,0 +1,52 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors namespaces kernel assocs sequences
+stack-checker.recursive-state ;
+IN: stack-checker.values
+
+! Values
+: <value> ( -- value ) \ <value> counter ;
+
+SYMBOL: known-values
+
+: init-known-values ( -- )
+    H{ } clone known-values set ;
+
+: known ( value -- known ) known-values get at ;
+
+: set-known ( known value -- )
+    over [ known-values get set-at ] [ 2drop ] if ;
+
+: make-known ( known -- value )
+    <value> [ set-known ] keep ;
+
+: copy-value ( value -- value' )
+    known make-known ;
+
+: copy-values ( values -- values' )
+    [ copy-value ] map ;
+
+! Literal value
+TUPLE: literal < identity-tuple value recursion hashcode ;
+
+M: literal hashcode* nip hashcode>> ;
+
+: <literal> ( obj -- value )
+    recursive-state get over hashcode \ literal boa ;
+
+GENERIC: (literal) ( value -- literal )
+
+M: literal (literal) ;
+
+: literal ( value -- literal )
+    known (literal) ;
+
+! Result of curry
+TUPLE: curried obj quot ;
+
+C: <curried> curried
+
+! Result of compose
+TUPLE: composed quot1 quot2 ;
+
+C: <composed> composed