From 53758074a29aa3b5c85ede92199705ee11db2433 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Feb 2009 10:21:55 -0600 Subject: [PATCH] stack-checker: do constant folding for curry and compose with constant inputs at compile time. Allows macros to expand in more cases, fixing the fry caveat found by Doug --- .../known-words/known-words.factor | 53 ++++++++----------- basis/stack-checker/stack-checker-docs.factor | 8 --- .../stack-checker/stack-checker-tests.factor | 5 ++ .../transforms/transforms-docs.factor | 13 +++-- .../transforms/transforms-tests.factor | 9 ++++ .../transforms/transforms.factor | 4 +- basis/stack-checker/values/values.factor | 30 +++++++++-- 7 files changed, 73 insertions(+), 49 deletions(-) diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 7cdce301b5..56aebb20e7 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -89,44 +89,37 @@ M: composed infer-call* M: object infer-call* \ literal-expected inference-warning ; -: infer-slip ( -- ) - 1 infer->r infer-call 1 infer-r> ; +: infer-nslip ( n -- ) + [ infer->r infer-call ] [ infer-r> ] bi ; -: infer-2slip ( -- ) - 2 infer->r infer-call 2 infer-r> ; +: infer-slip ( -- ) 1 infer-nslip ; -: infer-3slip ( -- ) - 3 infer->r infer-call 3 infer-r> ; +: infer-2slip ( -- ) 2 infer-nslip ; -: infer-dip ( -- ) - literals get - [ \ dip def>> infer-quot-here ] - [ pop 1 infer->r infer-quot-here 1 infer-r> ] +: infer-3slip ( -- ) 3 infer-nslip ; + +: infer-ndip ( word n -- ) + [ literals get ] 2dip + [ '[ _ def>> infer-quot-here ] ] + [ '[ _ [ pop ] dip [ infer->r infer-quot-here ] [ infer-r> ] bi ] ] bi* if-empty ; -: infer-2dip ( -- ) - literals get - [ \ 2dip def>> infer-quot-here ] - [ pop 2 infer->r infer-quot-here 2 infer-r> ] - if-empty ; +: infer-dip ( -- ) \ dip 1 infer-ndip ; -: infer-3dip ( -- ) - literals get - [ \ 3dip def>> infer-quot-here ] - [ pop 3 infer->r infer-quot-here 3 infer-r> ] - if-empty ; +: infer-2dip ( -- ) \ 2dip 2 infer-ndip ; -: infer-curry ( -- ) - 2 consume-d - dup first2 make-known - [ push-d ] [ 1array ] bi - \ curry #call, ; +: infer-3dip ( -- ) \ 3dip 3 infer-ndip ; -: infer-compose ( -- ) - 2 consume-d - dup first2 make-known - [ push-d ] [ 1array ] bi - \ compose #call, ; +: infer-builder ( quot word -- ) + [ + [ 2 consume-d ] dip + [ dup first2 ] dip call make-known + [ push-d ] [ 1array ] bi + ] dip #call, ; inline + +: infer-curry ( -- ) [ ] \ curry infer-builder ; + +: infer-compose ( -- ) [ ] \ compose infer-builder ; : infer-execute ( -- ) pop-literal nip diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor index 5b67cd9adc..5926f08d8c 100644 --- a/basis/stack-checker/stack-checker-docs.factor +++ b/basis/stack-checker/stack-checker-docs.factor @@ -80,13 +80,6 @@ $nl "[ [ 5 ] t foo ] infer." } ; -ARTICLE: "compiler-transforms" "Compiler transforms" -"Compiler transforms can be used to allow words to compile which would otherwise not have a stack effect, and to expand combinators into more efficient code at compile time." -{ $subsection define-transform } -"An example is the " { $link cond } " word. If the association list of quotations it is given is literal, the entire form is expanded into a series of nested calls to " { $link if } "." -$nl -"The " { $vocab-link "macros" } " vocabulary defines some nice syntax sugar which makes compiler transforms easier to work with." ; - ARTICLE: "inference" "Stack effect inference" "The stack effect inference tool is used to check correctness of code before it is run. It is also used by the optimizing compiler to build the high-level SSA representation on which optimizations can be performed. Only words for which a stack effect can be inferred will compile with the optimizing compiler; all other words will be compiled with the non-optimizing compiler (see " { $link "compiler" } ")." $nl @@ -103,7 +96,6 @@ $nl { $subsection "inference-recursive-combinators" } { $subsection "inference-branches" } { $subsection "inference-errors" } -{ $subsection "compiler-transforms" } { $see-also "effects" } ; ABOUT: "inference" diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 4d7295042c..bc6eb9f092 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -577,3 +577,8 @@ DEFER: eee' [ bogus-error ] must-infer [ [ clear ] infer. ] [ inference-error? ] must-fail-with + +: debugging-curry-folding ( quot -- ) + [ debugging-curry-folding ] curry call ; inline recursive + +[ [ ] debugging-curry-folding ] must-infer \ No newline at end of file diff --git a/basis/stack-checker/transforms/transforms-docs.factor b/basis/stack-checker/transforms/transforms-docs.factor index a178669595..de0edc4528 100644 --- a/basis/stack-checker/transforms/transforms-docs.factor +++ b/basis/stack-checker/transforms/transforms-docs.factor @@ -3,12 +3,11 @@ USING: help.markup help.syntax combinators words kernel ; HELP: define-transform { $values { "word" word } { "quot" "a quotation taking " { $snippet "n" } " inputs from the stack and producing another quotation as output" } { "n" "a non-negative integer" } } -{ $description "Defines a compiler transform for the optimizing compiler. When a call to " { $snippet "word" } " is being compiled, the compiler ensures that the top " { $snippet "n" } " stack values are literal; if they are not, compilation fails. The literal values are passed to the quotation, which is expected to produce a new quotation. The call to the word is then replaced by this quotation." } -{ $examples "Here is a word which pops " { $snippet "n" } " values from the stack:" -{ $code ": ndrop ( n -- ) [ drop ] times ;" } -"This word is inefficient; it does not have a static stack effect. This means that words calling " { $snippet "ndrop" } " cannot be compiled by the optimizing compiler, and additionally, a call to this word will always involve a loop with arithmetic, even if the value of " { $snippet "n" } " is known at compile time. A compiler transform can fix this:" -{ $code "\\ ndrop [ \\ drop >quotation ] 1 define-transform" } -"Now, a call like " { $snippet "4 ndrop" } " is replaced with " { $snippet "drop drop drop drop" } " at compile time; the optimizer then ensures that this compiles as a single machine instruction, which is a lot cheaper than an actual call to " { $snippet "ndrop" } "." +{ $description "Defines a compiler transform for the optimizing compiler." + "When a call to " { $snippet "word" } " is being compiled, the compiler first checks that the top " { $snippet "n" } " stack values are literal, and if so, calls the quotation with those inputs at compile time. The quotation can output a new quotation, or " { $link f } "." $nl -"The " { $link cond } " word compiles to efficient code because it is transformed using " { $link cond>quot } ":" +"If the quotation outputs " { $link f } ", or if not all inputs are literal, a call to the word is compiled as usual, or compilation fails if the word does not have a static stack effect." +$nl +"Otherwise, if the transform output a new quotation, the quotation replaces the word's call site." } +{ $examples "The " { $link cond } " word compiles to efficient code because it is transformed using " { $link cond>quot } ":" { $code "\\ cond [ cond>quot ] 1 define-transform" } } ; diff --git a/basis/stack-checker/transforms/transforms-tests.factor b/basis/stack-checker/transforms/transforms-tests.factor index 2e2dccd6c4..fe580084c0 100644 --- a/basis/stack-checker/transforms/transforms-tests.factor +++ b/basis/stack-checker/transforms/transforms-tests.factor @@ -57,3 +57,12 @@ DEFER: smart-combo ( quot -- ) [ [ "a" "b" "c" ] very-smart-combo ] must-infer [ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer + +! Caveat found by Doug +DEFER: curry-folding-test ( quot -- ) + +\ curry-folding-test [ length \ drop >quotation ] 1 define-transform + +{ 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as +{ 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as +{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as \ No newline at end of file diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index e5c2f05d72..a2f616480a 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -24,8 +24,10 @@ IN: stack-checker.transforms rstate infer-quot ] [ word give-up-transform ] if* ; +: literals? ( values -- ? ) [ literal-value? ] all? ; + : (apply-transform) ( word quot n -- ) - ensure-d dup [ known literal? ] all? [ + ensure-d dup literals? [ dup empty? [ dup recursive-state get ] [ [ ] [ [ literal value>> ] map ] diff --git a/basis/stack-checker/values/values.factor b/basis/stack-checker/values/values.factor index 97aa774e55..19db441381 100644 --- a/basis/stack-checker/values/values.factor +++ b/basis/stack-checker/values/values.factor @@ -26,27 +26,51 @@ SYMBOL: known-values : copy-values ( values -- values' ) [ copy-value ] map ; +GENERIC: (literal-value?) ( value -- ? ) + +M: object (literal-value?) drop f ; + +GENERIC: (literal) ( value -- literal ) + ! Literal value TUPLE: literal < identity-tuple value recursion hashcode ; +: literal ( value -- literal ) known (literal) ; + +: literal-value? ( value -- ? ) known (literal-value?) ; + M: literal hashcode* nip hashcode>> ; : ( obj -- value ) recursive-state get over hashcode \ literal boa ; -GENERIC: (literal) ( value -- literal ) +M: literal (literal-value?) drop t ; M: literal (literal) ; -: literal ( value -- literal ) - known (literal) ; +: curried/composed-literal ( input1 input2 quot -- literal ) + [ [ literal ] bi@ ] dip + [ [ [ value>> ] bi@ ] dip call ] [ drop nip recursion>> ] 3bi + over hashcode \ literal boa ; inline ! Result of curry TUPLE: curried obj quot ; C: curried +: >curried< ( curried -- obj quot ) + [ obj>> ] [ quot>> ] bi ; inline + +M: curried (literal-value?) >curried< [ literal-value? ] both? ; +M: curried (literal) >curried< [ curry ] curried/composed-literal ; + ! Result of compose TUPLE: composed quot1 quot2 ; C: composed + +: >composed< ( composed -- quot1 quot2 ) + [ quot1>> ] [ quot2>> ] bi ; inline + +M: composed (literal-value?) >composed< [ literal-value? ] both? ; +M: composed (literal) >composed< [ compose ] curried/composed-literal ; \ No newline at end of file