From 15a07f6f40316c63653f502682ca5bb196f7def6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 27 Nov 2004 05:33:17 +0000 Subject: [PATCH] inline annotation for combinators; faster stack checker taking advantage of this fact; started dataflow IR --- TODO.FACTOR.txt | 1 + library/bootstrap/boot-stage2.factor | 1 + library/combinators.factor | 9 ++--- library/inference/branches.factor | 34 ++++++++++------ library/inference/dataflow.factor | 59 ++++++++++++++++++++++++++++ library/inference/inference.factor | 35 ++++++----------- library/inference/words.factor | 28 +++++++------ library/list-namespaces.factor | 3 +- library/lists.factor | 8 ++-- library/sbuf.factor | 6 +-- library/strings.factor | 2 +- library/test/inference.factor | 4 ++ library/vector-combinators.factor | 10 ++--- library/vectors.factor | 2 +- 14 files changed, 132 insertions(+), 70 deletions(-) create mode 100644 library/inference/dataflow.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index c99f626a1c..1a50de9b92 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -25,6 +25,7 @@ + listener/plugin: +- console: wrong history - listener: if too many things popped off the stack, complain - gracefully handle non-working cfactor - NPE in ErrorHighlight diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 655292bd29..9cde9afdad 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -102,6 +102,7 @@ USE: stdio "/library/tools/heap-stats.factor" "/library/gensym.factor" "/library/tools/interpreter.factor" + "/library/inference/dataflow.factor" "/library/inference/inference.factor" "/library/inference/words.factor" "/library/inference/branches.factor" diff --git a/library/combinators.factor b/library/combinators.factor index 4bece90155..9ca96cd28b 100644 --- a/library/combinators.factor +++ b/library/combinators.factor @@ -42,16 +42,16 @@ USE: stack : keep ( a quot -- a ) #! Execute the quotation with a on the stack, and restore a #! after the quotation returns. - over >r call r> ; + over >r call r> ; inline : 2keep ( a b quot -- a b ) #! Execute the quotation with a and b on the stack, and #! restore a and b after the quotation returns. - over >r pick >r call r> r> ; + over >r pick >r call r> r> ; inline : apply ( code input -- code output ) #! Apply code to input. - swap dup >r call r> swap ; + swap dup >r call r> swap ; inline : cond ( x list -- ) #! The list is of this form: @@ -86,8 +86,7 @@ USE: stack #! If the condition is not f, execute the 'true' quotation, #! with the condition on the stack. Otherwise, pop the #! condition and execute the 'false' quotation. - pick [ drop call ] [ nip nip call ] ifte ; - inline + pick [ drop call ] [ nip nip call ] ifte ; inline : unless ( cond quot -- ) #! Execute a quotation only when the condition is f. The diff --git a/library/inference/branches.factor b/library/inference/branches.factor index c7a3047563..3375f1e4f5 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -42,13 +42,16 @@ USE: hashtables DEFER: (infer) -: (effect) ( -- [ in | stack ] ) - d-in get meta-d get cons ; - -: infer-branch ( quot -- [ in-d | datastack ] ) +: infer-branch ( quot -- [ in-d | datastack ] dataflow ) #! Infer the quotation's effect, restoring the meta #! interpreter state afterwards. - [ copy-interpreter (infer) (effect) ] with-scope ; + [ + copy-interpreter + dataflow-graph off + (infer) + d-in get meta-d get cons + get-dataflow + ] with-scope ; : difference ( [ in | stack ] -- diff ) #! Stack height difference of infer-branch return value. @@ -87,23 +90,28 @@ DEFER: (infer) "Unbalanced branches" throw ] ifte ; -: recursive-branch ( quot -- ) - #! Set base case if inference didn't fail +: recursive-branch ( quot -- ? ) + #! Set base case if inference didn't fail. [ - car infer-branch recursive-state get set-base + car infer-branch drop recursive-state get set-base t ] [ - [ drop ] when + [ drop f ] when ] catch ; -: infer-branches ( brachlist -- ) +: infer-branches ( consume instruction brachlist -- ) #! Recursive stack effect inference is done here. If one of #! the branches has an undecidable stack effect, we set the #! base case to this stack effect and try again. - dup [ recursive-branch ] each - [ car infer-branch ] map unify ; + f over [ recursive-branch or ] each [ + [ [ car infer-branch , ] map ] make-list swap + >r dataflow, r> unify + ] [ + "Foo!" throw + ] ifte ; : infer-ifte ( -- ) #! Infer effects for both branches, unify. + 3 IFTE pop-d pop-d 2list pop-d drop ( condition ) infer-branches ; @@ -118,12 +126,14 @@ DEFER: (infer) : infer-generic ( -- ) #! Infer effects for all branches, unify. + 2 GENERIC pop-d vtable>list peek-d drop ( dispatch ) infer-branches ; : infer-2generic ( -- ) #! Infer effects for all branches, unify. + 3 2GENERIC pop-d vtable>list peek-d drop ( dispatch ) peek-d drop ( dispatch ) diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor new file mode 100644 index 0000000000..df2067f616 --- /dev/null +++ b/library/inference/dataflow.factor @@ -0,0 +1,59 @@ +! :folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2004 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +IN: inference +USE: lists +USE: namespaces +USE: stack + +! We build a dataflow graph for the compiler. +SYMBOL: dataflow-graph + +SYMBOL: CALL ( non-tail call ) +SYMBOL: JUMP ( tail-call ) +SYMBOL: PUSH ( literal ) + +SYMBOL: IFTE +SYMBOL: GENERIC +SYMBOL: 2GENERIC + +: get-dataflow ( -- IR ) + dataflow-graph get reverse ; + +: dataflow, ( consume instruction parameters -- ) + #! Add a node to the dataflow IR. Each node is a list of + #! three elements: + #! - list of elements consumed from stack + #! - a symbol CALL, JUMP or PUSH + #! - parameter(s) to insn + unit cons cons dataflow-graph cons@ ; + +: dataflow-literal, ( lit -- ) + >r 0 PUSH r> dataflow, ; + +: dataflow-word, ( in word -- ) + >r count CALL r> dataflow, ; diff --git a/library/inference/inference.factor b/library/inference/inference.factor index aa7ed56edd..fcfc725034 100644 --- a/library/inference/inference.factor +++ b/library/inference/inference.factor @@ -55,13 +55,6 @@ SYMBOL: recursive-state SYMBOL: base-case SYMBOL: entry-effect -! We build a dataflow graph for the compiler. -SYMBOL: dataflow-graph - -: dataflow, ( obj -- ) - #! Add a node to the dataflow IR. - dataflow-graph cons@ ; - : gensym-vector ( n -- vector ) dup swap [ gensym over vector-push ] times ; @@ -115,21 +108,14 @@ SYMBOL: dataflow-graph DEFER: apply-word +: apply-literal ( obj -- ) + #! Literals are annotated with the current recursive + #! state. + dup dataflow-literal, recursive-state get cons push-d ; + : apply-object ( obj -- ) #! Apply the object's stack effect to the inferencer state. - #! There are three options: recursive-infer words always - #! cause a recursive call of the inferencer, regardless. - #! Be careful, you might hang the inferencer. Other words - #! solve a fixed-point equation if a recursive call is made, - #! otherwise the inferencer is invoked recursively if its - #! not a recursive call. - dup word? [ - apply-word - ] [ - #! Literals are annotated with the current recursive - #! state. - dup dataflow, recursive-state get cons push-d - ] ifte ; + dup word? [ apply-word ] [ apply-literal ] ifte ; : (infer) ( quot -- ) #! Recursive calls to this word are made for nested @@ -158,10 +144,11 @@ DEFER: apply-word : infer ( quot -- [ in | out ] ) #! Stack effect of a quotation. - [ - f init-inference (infer) effect - ( dataflow-graph get USE: prettyprint . ) - ] with-scope ; + [ f init-inference (infer) effect ] with-scope ; + +: dataflow ( quot -- dataflow ) + #! Data flow of a quotation. + [ f init-inference (infer) get-dataflow ] with-scope ; : try-infer ( quot -- effect/f ) #! Push f if inference fails. diff --git a/library/inference/words.factor b/library/inference/words.factor index 0c43e8b9cf..b7f0fab4de 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -45,6 +45,7 @@ USE: hashtables #! either execute the word in the meta interpreter (if it is #! side-effect-free and all parameters are literal), or #! simply apply its stack effect to the meta-interpreter. + dup car pick dataflow-word, swap "infer" word-property dup [ swap car ensure-d call ] [ @@ -69,17 +70,11 @@ USE: hashtables : apply-compound ( word -- ) #! Infer a compound word's stack effect. - dup "inline-infer" word-property [ + dup "inline" word-property [ inline-compound ] [ - [ - dup dataflow, infer-compound consume/produce - ] [ - [ - dup t "inline-infer" set-word-property - inline-compound - ] when - ] catch + dup infer-compound dup car rot dataflow-word, + consume/produce ] ifte ; : current-word ( -- word ) @@ -112,18 +107,25 @@ USE: hashtables check-recursion recursive-word ] [ drop dup "infer-effect" word-property dup [ - over dataflow, apply-effect ] [ - drop dup compound? [ apply-compound ] [ no-effect ] ifte + drop + [ + [ compound? ] [ apply-compound ] + [ symbol? ] [ apply-literal ] + [ drop t ] [ no-effect ] + ] cond ] ifte ] ifte ; : infer-call ( [ rstate | quot ] -- ) + 1 \ drop dataflow-word, [ + dataflow-graph off pop-d uncons recursive-state set (infer) - d-in get meta-d get - ] with-scope meta-d set d-in set ; + d-in get meta-d get get-dataflow + ] with-scope + [ dataflow-graph cons@ ] each meta-d set d-in set ; \ call [ infer-call ] "infer" set-word-property diff --git a/library/list-namespaces.factor b/library/list-namespaces.factor index 3cd6fb8833..ea56baa038 100644 --- a/library/list-namespaces.factor +++ b/library/list-namespaces.factor @@ -59,11 +59,12 @@ USE: stack #! objects to the list that is returned when the quotation #! is done. [ "list-buffer" off call "list-buffer" get ] with-scope ; + inline : make-list ( quot -- list ) #! Return a list whose entries are in the same order that , #! was called. - make-rlist reverse ; + make-rlist reverse ; inline : , ( obj -- ) #! Append an object to the currently constructing list. diff --git a/library/lists.factor b/library/lists.factor index 30211574a4..59afb3af41 100644 --- a/library/lists.factor +++ b/library/lists.factor @@ -76,7 +76,7 @@ USE: vectors dup cons? [ tail ] when not ; : partition-add ( obj ? ret1 ret2 -- ret1 ret2 ) - rot [ swapd cons ] [ >r cons r> ] ifte ; inline + rot [ swapd cons ] [ >r cons r> ] ifte ; : partition-step ( ref list combinator -- ref cdr combinator car ? ) pick pick car pick call >r >r unswons r> swap r> ; inline @@ -141,8 +141,7 @@ DEFER: tree-contains? : each ( list quot -- ) #! Push each element of a proper list in turn, and apply a #! quotation with effect ( X -- ) to each element. - over [ (each) each ] [ 2drop ] ifte ; - inline + over [ (each) each ] [ 2drop ] ifte ; inline : reverse ( list -- list ) [ ] swap [ swons ] each ; @@ -151,8 +150,7 @@ DEFER: tree-contains? #! Push each element of a proper list in turn, and collect #! return values of applying a quotation with effect #! ( X -- Y ) to each element into a new list. - over [ (each) rot >r map r> swons ] [ drop ] ifte ; - inline + over [ (each) rot >r map r> swons ] [ drop ] ifte ; inline : subset ( list quot -- list ) #! Applies a quotation with effect ( X -- ? ) to each diff --git a/library/sbuf.factor b/library/sbuf.factor index 2101e2ace0..bbb887a728 100644 --- a/library/sbuf.factor +++ b/library/sbuf.factor @@ -38,12 +38,12 @@ USE: stack #! Call a quotation. The quotation can call , to prepend #! objects to the list that is returned when the quotation #! is done. - make-list cat ; + make-list cat ; inline : make-rstring ( quot -- string ) #! Return a string whose entries are in the same order that , #! was called. - make-rlist cat ; + make-rlist cat ; inline : fill ( count char -- string ) #! Push a string that consists of the same character @@ -56,7 +56,7 @@ USE: stack #! The quotation must have stack effect ( X -- X ). over str-length rot [ swap >r apply r> tuck sbuf-append - ] str-each nip sbuf>str ; + ] str-each nip sbuf>str ; inline : split-next ( index string split -- next ) 3dup index-of* dup -1 = [ diff --git a/library/strings.factor b/library/strings.factor index 25fb56c3d6..e0c18cba22 100644 --- a/library/strings.factor +++ b/library/strings.factor @@ -143,7 +143,7 @@ USE: stack #! pushed onto the stack. over str-length [ -rot 2dup >r >r >r str-nth r> call r> r> - ] times* 2drop ; + ] times* 2drop ; inline : str-sort ( list -- sorted ) #! Sorts the list into ascending lexicographical string diff --git a/library/test/inference.factor b/library/test/inference.factor index 7fc174fa9e..6ce15aa259 100644 --- a/library/test/inference.factor +++ b/library/test/inference.factor @@ -147,6 +147,10 @@ DEFER: foe [ [ 1 | 0 ] ] [ [ nested-when* ] infer ] unit-test +SYMBOL: sym-test + +[ [ 0 | 1 ] ] [ [ sym-test ] infer ] unit-test + [ [ 2 | 1 ] ] [ [ fie ] infer ] unit-test [ [ 2 | 1 ] ] [ [ foe ] infer ] unit-test diff --git a/library/vector-combinators.factor b/library/vector-combinators.factor index 4878f57d87..17d194f678 100644 --- a/library/vector-combinators.factor +++ b/library/vector-combinators.factor @@ -38,7 +38,7 @@ USE: stack #! pushed onto the stack. over vector-length [ -rot 2dup >r >r >r vector-nth r> call r> r> - ] times* 2drop ; + ] times* 2drop ; inline : vector-map ( vector code -- vector ) #! Applies code to each element of the vector, return a new @@ -46,14 +46,14 @@ USE: stack #! ( obj -- obj ). over vector-length rot [ swap >r apply r> tuck vector-push - ] vector-each nip ; + ] vector-each nip ; inline : vector-and ( vector -- ? ) #! Logical and of all elements in the vector. t swap [ and ] vector-each ; : vector-all? ( vector pred -- ? ) - vector-map vector-and ; + vector-map vector-and ; inline : vector-append ( v1 v2 -- ) #! Destructively append v2 to v1. @@ -65,7 +65,7 @@ USE: stack #! in a new vector. over rot [ -rot 2dup >r >r slip vector-push r> r> - ] times* nip ; + ] times* nip ; inline : vector-zip ( v1 v2 -- v ) #! Make a new vector with each pair of elements from the @@ -81,4 +81,4 @@ USE: stack #! differ. -rot vector-zip [ swap dup >r >r uncons r> call r> swap - ] vector-map nip ; + ] vector-map nip ; inline diff --git a/library/vectors.factor b/library/vectors.factor index 8288b039db..b80863a604 100644 --- a/library/vectors.factor +++ b/library/vectors.factor @@ -72,7 +72,7 @@ DEFER: vector-map : ?vector= ( n vec vec -- ? ) #! Reached end? - drop vector-length = ; + drop vector-length number= ; : (vector=) ( n vec vec -- ? ) 3dup ?vector= [