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
db4
Slava Pestov 2008-11-13 00:07:45 -06:00
parent 4a1bcacfd4
commit 5bae69426d
12 changed files with 154 additions and 93 deletions

View File

@ -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
stack-checker.state stack-checker.visitor stack-checker.errors
stack-checker.backend compiler.tree ;
assocs words arrays vectors hints combinators compiler.tree
stack-checker
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 )

View File

@ -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:

View File

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

View File

@ -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 -- ? )

View File

@ -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.
[
rstate>>
[ "Nesting:" print stack. ] unless-empty
] [ error>> error. ] bi ;
[ "In word: " write word>> . ] [ error>> error. ] bi ;
TUPLE: literal-expected ;

View File

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

View File

@ -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.alien ;
stack-checker.recursive-state ;
IN: stack-checker.known-words
: infer-primitive ( word -- )

View File

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

View File

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

View File

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

View File

@ -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 -- )

View File

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