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

Make the member? transform better

db4
Slava Pestov 2009-03-21 03:10:21 -05:00
parent 59dbba09a3
commit 385892be64
2 changed files with 26 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/stack-checker/transforms/transforms-tests.factor
View File

@ -65,4 +65,9 @@ DEFER: curry-folding-test ( quot -- )
{ 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
{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
: member?-test ( a -- ? ) { 1 2 3 10 7 58 } member? ;
[ f ] [ 1.0 member?-test ] unit-test
[ t ] [ \ member?-test def>> first [ member?-test ] all? ] unit-test

48
basis/stack-checker/transforms/transforms.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors arrays kernel kernel.private combinators.private
words sequences generic math namespaces make quotations assocs
combinators classes.tuple classes.tuple.private effects summary
hashtables classes generic sets definitions generic.standard
slots.private continuations locals generalizations
stack-checker.backend stack-checker.state stack-checker.visitor
stack-checker.errors stack-checker.values
words sequences generic math math.order namespaces make quotations assocs
combinators combinators.short-circuit classes.tuple
classes.tuple.private effects summary hashtables classes generic sets
definitions generic.standard slots.private continuations locals
generalizations stack-checker.backend stack-checker.state
stack-checker.visitor stack-checker.errors stack-checker.values
stack-checker.recursive-state ;
IN: stack-checker.transforms
@ -107,36 +107,28 @@ IN: stack-checker.transforms
] 1 define-transform
! Membership testing
CONSTANT: bit-member-n 256
CONSTANT: bit-member-max 256
: bit-member? ( seq -- ? )
#! Can we use a fast byte array test here?
{
{ [ dup length 8 < ] [ f ] }
{ [ dup [ integer? not ] any? ] [ f ] }
{ [ dup [ 0 < ] any? ] [ f ] }
{ [ dup [ bit-member-n >= ] any? ] [ f ] }
[ t ]
} cond nip ;
[ length 4 > ]
[ [ integer? ] all? ]
[ [ 0 bit-member-max between? ] any? ]
} 1&& ;
: 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
[ supremum 1+ ] keep '[ _ member? 1 0 ? ] B{ } map-as ;
: bit-member-quot ( seq -- newquot )
[
bit-member-seq ,
[
{
{ [ over fixnum? ] [ ?nth 1 eq? ] }
{ [ over bignum? ] [ ?nth 1 eq? ] }
{ [ over exact-float? ] [ ?nth 1 eq? ] }
[ 2drop f ]
} cond
] %
] [ ] make ;
bit-member-seq
'[
_ {
{ [ over fixnum? ] [ ?nth 1 eq? ] }
{ [ over bignum? ] [ ?nth 1 eq? ] }
[ 2drop f ]
} cond
] ;
: member-quot ( seq -- newquot )
dup bit-member? [