diff --git a/basis/stack-checker/state/state-docs.factor b/basis/stack-checker/state/state-docs.factor index 734eb19357..7ad46dbc64 100644 --- a/basis/stack-checker/state/state-docs.factor +++ b/basis/stack-checker/state/state-docs.factor @@ -1,6 +1,29 @@ -USING: help.markup help.syntax quotations sequences ; +USING: compiler.tree effects help.markup help.syntax quotations sequences +stack-checker.values stack-checker.visitor ; IN: stack-checker.state +HELP: terminated? +{ $var-description "Did the current control-flow path throw an error?" } ; + +HELP: current-effect +{ $values { "effect" effect } } +{ $description "Returns what the current analysis states stack effect is." } +{ $examples + { $example + "USING: namespaces prettyprint stack-checker.state ;" + "{ { input-count 2 } { terminated? t } { (meta-d) { 1 2 } } }" + "[ current-effect ] with-variables ." + "( x x -- x x * )" + } +} ; + +HELP: commit-literals +{ $description "Outputs all remaining literals to the current " { $link stack-visitor } " as " { $link #push } " instructions. They are also pushed onto the compile-time data stack." } +{ $see-also meta-d } ; + +HELP: input-count +{ $var-description "Number of inputs current word expects from the stack." } ; + HELP: meta-d { $values { "stack" sequence } } { $description "Compile-time data stack." } ; @@ -11,3 +34,7 @@ HELP: meta-r HELP: literals { $var-description "Uncommitted literals. This is a form of local dead-code elimination; the goal is to reduce the number of IR nodes which get constructed. Technically it is redundant since we do global DCE later, but it speeds up compile time." } ; + +HELP: (push-literal) +{ $values { "obj" "a literal" } } +{ $description "Pushes a literal value to the end of the current " { $link stack-visitor } ". The literal is also given a number and registered in the assoc of " { $link known-values } "." } ; diff --git a/basis/stack-checker/state/state-tests.factor b/basis/stack-checker/state/state-tests.factor new file mode 100644 index 0000000000..24dd34bb23 --- /dev/null +++ b/basis/stack-checker/state/state-tests.factor @@ -0,0 +1,37 @@ +USING: accessors assocs classes.tuple compiler.tree kernel namespaces sequences +stack-checker.backend stack-checker.recursive-state stack-checker.state +stack-checker.values stack-checker.visitor tools.test ; +IN: stack-checker.state.tests + +{ + V{ 1 2 3 } +} [ + 0 \ set-global + init-inference init-known-values + V{ 1 2 3 } literals set commit-literals + (meta-d) get +] unit-test + +: node-seqs-eq? ( seq1 seq2 -- ? ) + [ [ tuple-slots ] map concat ] bi@ = ; + +{ t t } [ + 23 \ set-global [ + V{ } clone stack-visitor set + 33 (push-literal) + known-values get 24 of value>> 33 = + ] with-infer nip + V{ + T{ #push { literal 33 } { out-d { 24 } } } + T{ #return { in-d V{ 24 } } } + } node-seqs-eq? +] unit-test + +{ t } [ + 0 \ set-global + V{ } clone stack-visitor set + V{ [ call ] } literals set commit-literals + stack-visitor get + V{ T{ #push { literal [ call ] } { out-d { 1 } } } } + node-seqs-eq? +] unit-test diff --git a/basis/stack-checker/state/state.factor b/basis/stack-checker/state/state.factor index b48b0b14a6..2f898721e2 100644 --- a/basis/stack-checker/state/state.factor +++ b/basis/stack-checker/state/state.factor @@ -6,10 +6,8 @@ compiler.units stack-checker.values stack-checker.visitor stack-checker.errors ; IN: stack-checker.state -! Did the current control-flow path throw an error? SYMBOL: terminated? -! Number of inputs current word expects from the stack SYMBOL: input-count SYMBOL: inner-d-index @@ -29,9 +27,7 @@ SYMBOL: literals [ nip (meta-d) get push ] [ #push, ] 2bi ; : commit-literals ( -- ) - literals get [ - [ [ (push-literal) ] each ] [ delete-all ] bi - ] unless-empty ; + literals get [ [ (push-literal) ] each ] [ delete-all ] bi ; : current-stack-height ( -- n ) meta-d length input-count get - ;