steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Better compilation of member? when the sequence contains small integers only

db4
Slava Pestov 2008-06-18 00:32:38 -05:00
parent d17470b5fb
commit 0c0aaceedb
1 changed files with 50 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
core/optimizer/known-words/known-words.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: optimizer.known-words IN: optimizer.known-words
USING: alien arrays generic hashtables inference.dataflow USING: alien arrays generic hashtables inference.dataflow
inference.class kernel assocs math math.private kernel.private inference.class kernel assocs math math.order math.private
sequences words parser vectors strings sbufs io namespaces kernel.private sequences words parser vectors strings sbufs io
assocs quotations sequences.private io.binary namespaces assocs quotations sequences.private io.binary
io.streams.string layouts splitting math.intervals io.streams.string layouts splitting math.intervals
math.floats.private classes.tuple classes.tuple.private classes math.floats.private classes.tuple classes.tuple.private classes
classes.algebra optimizer.def-use optimizer.backend classes.algebra optimizer.def-use optimizer.backend
@ -59,19 +59,59 @@ sequences.private combinators byte-arrays byte-vectors ;
node-in-d peek dup value? node-in-d peek dup value?
[ value-literal sequence? ] [ drop f ] if ; [ value-literal sequence? ] [ drop f ] if ;
: member-quot ( seq predicate -- newquot ) : expand-member ( #call quot -- )
[ curry [ dup ] prepose [ drop t ] ] curry { } map>assoc >r dup node-in-d peek value-literal r> call f splice-quot ;
[ drop f ] suffix [ nip cond ] curry ;
: expand-member ( #call predicate -- ) : bit-member-n 256 ; inline
>r dup node-in-d peek value-literal r> member-quot f splice-quot ;
: bit-member? ( seq -- ? )
#! Can we use a fast byte array test here?
{
{ [ dup length 8 < ] [ f ] }
{ [ dup [ integer? not ] contains? ] [ f ] }
{ [ dup [ 0 < ] contains? ] [ f ] }
{ [ dup [ bit-member-n >= ] contains? ] [ f ] }
[ t ]
} cond nip ;
: bit-member-seq ( seq -- flags )
bit-member-n swap [ member? 1 0 ? ] curry B{ } map-as ;
: exact-float? ( f -- ? )
dup float? [ dup >integer >float = ] [ drop f ] if ; inline
: bit-member-quot ( seq -- newquot )
[
[ drop ] % ! drop the sequence itself; we don't use it at run time
bit-member-seq ,
[
{
{ [ over fixnum? ] [ ?nth 1 eq? ] }
{ [ over bignum? ] [ ?nth 1 eq? ] }
{ [ over exact-float? ] [ ?nth 1 eq? ] }
[ 2drop f ]
} cond
] %
] [ ] make ;
: member-quot ( seq -- newquot )
dup bit-member? [
bit-member-quot
] [
[ [ t ] ] { } map>assoc
[ drop f ] suffix [ nip case ] curry
] if ;
\ member? { \ member? {
{ [ dup literal-member? ] [ [ = ] expand-member ] } { [ dup literal-member? ] [ [ member-quot ] expand-member ] }
} define-optimizers } define-optimizers
: memq-quot ( seq -- newquot )
[ [ dupd eq? ] curry [ drop t ] ] { } map>assoc
[ drop f ] suffix [ nip cond ] curry ;
\ memq? { \ memq? {
{ [ dup literal-member? ] [ [ eq? ] expand-member ] } { [ dup literal-member? ] [ [ memq-quot ] expand-member ] }
} define-optimizers } define-optimizers
! if the result of eq? is t and the second input is a literal, ! if the result of eq? is t and the second input is a literal,