From 5bae69426db5b2019fd2bdec55526f596d1d18a0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 13 Nov 2008 00:07:45 -0600 Subject: [PATCH] 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 | 10 ++- .../allocations/allocations.factor | 2 +- basis/stack-checker/backend/backend.factor | 3 +- basis/stack-checker/branches/branches.factor | 2 +- basis/stack-checker/errors/errors.factor | 12 ++-- basis/stack-checker/inlining/inlining.factor | 8 ++- .../known-words/known-words.factor | 9 +-- .../recursive-state/recursive-state.factor | 43 +++++++++++ .../recursive-state/tree/tree.factor | 31 ++++++++ basis/stack-checker/state/state.factor | 72 ------------------- .../transforms/transforms.factor | 3 +- basis/stack-checker/values/values.factor | 52 ++++++++++++++ 12 files changed, 154 insertions(+), 93 deletions(-) create mode 100644 basis/stack-checker/recursive-state/recursive-state.factor create mode 100644 basis/stack-checker/recursive-state/tree/tree.factor create mode 100644 basis/stack-checker/values/values.factor diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index 65e9ccdff6..c2ec6552cd 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/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 -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 ) diff --git a/basis/compiler/tree/escape-analysis/allocations/allocations.factor b/basis/compiler/tree/escape-analysis/allocations/allocations.factor index 4c197d7fc0..5d34eaad15 100644 --- a/basis/compiler/tree/escape-analysis/allocations/allocations.factor +++ b/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: diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 250ee2cb7a..94e59950f7 100644 --- a/basis/stack-checker/backend/backend.factor +++ b/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 ; diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index d1417d035c..7b461d0028 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/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 -- ? ) diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index b728d1a7e9..efdc7e23b2 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/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. - [ - rstate>> - [ "Nesting:" print stack. ] unless-empty - ] [ error>> error. ] bi ; + [ "In word: " write word>> . ] [ error>> error. ] bi ; TUPLE: literal-expected ; diff --git a/basis/stack-checker/inlining/inlining.factor b/basis/stack-checker/inlining/inlining.factor index 695eb4f0d3..b6a988652b 100644 --- a/basis/stack-checker/inlining/inlining.factor +++ b/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 diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index ecc9f95f54..4aea0f2d28 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/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.alien ; +stack-checker.recursive-state ; IN: stack-checker.known-words : infer-primitive ( word -- ) diff --git a/basis/stack-checker/recursive-state/recursive-state.factor b/basis/stack-checker/recursive-state/recursive-state.factor new file mode 100644 index 0000000000..41d7331230 --- /dev/null +++ b/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 + +: 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 ; diff --git a/basis/stack-checker/recursive-state/tree/tree.factor b/basis/stack-checker/recursive-state/tree/tree.factor new file mode 100644 index 0000000000..dd392af7c9 --- /dev/null +++ b/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 ; diff --git a/basis/stack-checker/state/state.factor b/basis/stack-checker/state/state.factor index 177731f985..2706ec60ef 100644 --- a/basis/stack-checker/state/state.factor +++ b/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 ) \ 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 ) - [ 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 ; - -: ( 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 - -! Result of compose -TUPLE: composed quot1 quot2 ; - -C: 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 diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index c71337b021..e4f8c50eeb 100644 --- a/basis/stack-checker/transforms/transforms.factor +++ b/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 -- ) diff --git a/basis/stack-checker/values/values.factor b/basis/stack-checker/values/values.factor new file mode 100644 index 0000000000..97aa774e55 --- /dev/null +++ b/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 ) \ 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 ) + [ 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>> ; + +: ( 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 + +! Result of compose +TUPLE: composed quot1 quot2 ; + +C: composed