From 0c0aaceedb84a947d0127a404a4bdee07b858840 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 18 Jun 2008 00:32:38 -0500
Subject: [PATCH] Better compilation of member? when the sequence contains
 small integers only

---
 core/optimizer/known-words/known-words.factor | 60 +++++++++++++++----
 1 file changed, 50 insertions(+), 10 deletions(-)

diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor
index 970b69a18a..7f882d85d0 100755
--- a/core/optimizer/known-words/known-words.factor
+++ b/core/optimizer/known-words/known-words.factor
@@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer.known-words
 USING: alien arrays generic hashtables inference.dataflow
-inference.class kernel assocs math math.private kernel.private
-sequences words parser vectors strings sbufs io namespaces
-assocs quotations sequences.private io.binary
+inference.class kernel assocs math math.order math.private
+kernel.private sequences words parser vectors strings sbufs io
+namespaces assocs quotations sequences.private io.binary
 io.streams.string layouts splitting math.intervals
 math.floats.private classes.tuple classes.tuple.private classes
 classes.algebra optimizer.def-use optimizer.backend
@@ -59,19 +59,59 @@ sequences.private combinators byte-arrays byte-vectors ;
     node-in-d peek dup value?
     [ value-literal sequence? ] [ drop f ] if ;
 
-: member-quot ( seq predicate -- newquot )
-    [ curry [ dup ] prepose [ drop t ] ] curry { } map>assoc
-    [ drop f ] suffix [ nip cond ] curry ;
+: expand-member ( #call quot -- )
+    >r dup node-in-d peek value-literal r> call f splice-quot ;
 
-: expand-member ( #call predicate -- )
-    >r dup node-in-d peek value-literal r> member-quot f splice-quot ;
+: bit-member-n 256 ; inline
+
+: 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? {
-    { [ dup literal-member? ] [ [ = ] expand-member ] }
+    { [ dup literal-member? ] [ [ member-quot ] expand-member ] }
 } define-optimizers
 
+: memq-quot ( seq -- newquot )
+    [ [ dupd eq? ] curry [ drop t ] ] { } map>assoc
+    [ drop f ] suffix [ nip cond ] curry ;
+
 \ memq? {
-    { [ dup literal-member? ] [ [ eq? ] expand-member ] }
+    { [ dup literal-member? ] [ [ memq-quot ] expand-member ] }
 } define-optimizers
 
 ! if the result of eq? is t and the second input is a literal,