From 8d7ebc510603772433b865ae8aa99ec0413793da Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 18:08:19 -0500
Subject: [PATCH] Change stack effect of nths to match nth, rice bounds-check?

---
 .../strength-reduction-tests.factor           | 119 ------------------
 .../strength-reduction.factor                 |   5 -
 core/sequences/sequences.factor               |   6 +-
 3 files changed, 3 insertions(+), 127 deletions(-)
 delete mode 100644 basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
 delete mode 100644 basis/compiler/tree/strength-reduction/strength-reduction.factor

diff --git a/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor b/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
deleted file mode 100644
index 86fe74d939..0000000000
--- a/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
+++ /dev/null
@@ -1,119 +0,0 @@
-! TUPLE: declared-fixnum { x fixnum } ;
-! 
-! [ t ] [
-!     [ { declared-fixnum } declare [ 1 + ] change-x ]
-!     { + fixnum+ >fixnum } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { declared-fixnum } declare x>> drop ]
-!     { slot } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ hashtable new ] \ new inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ dup hashtable eq? [ new ] when ] \ new inlined?
-! ] unit-test
-! 
-! [ f ] [
-!     [ { integer } declare -63 shift 4095 bitand ]
-!     \ shift inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { integer } declare 127 bitand 3 + ]
-!     { + +-integer-fixnum +-integer-fixnum-fast bitand } inlined?
-! ] unit-test
-! 
-! [ f ] [
-!     [ { integer } declare 127 bitand 3 + ]
-!     { >fixnum } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare
-!         dup 0 >= [
-!             615949 * 797807 + 20 2^ mod dup 19 2^ -
-!         ] [ dup ] if
-!     ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { fixnum } declare
-!         615949 * 797807 + 20 2^ mod dup 19 2^ -
-!     ] { >fixnum } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare 0 swap
-!         [
-!             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
-!         ] map
-!     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { fixnum } declare 0 swap
-!         [
-!             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
-!         ] map
-!     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
-! ] unit-test
-! 
-! 
-! 
-! [ t ] [
-!     [
-!         { integer } declare [ 256 mod ] map
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! 
-! [ f ] [
-!     [
-!         256 mod
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! [ f ] [
-!     [
-!         dup 0 >= [ 256 mod ] when
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare dup 0 >= [ 256 mod ] when
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare 256 rem
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare [ 256 rem ] map
-!     ] { mod fixnum-mod rem } inlined?
-! ] unit-test
diff --git a/basis/compiler/tree/strength-reduction/strength-reduction.factor b/basis/compiler/tree/strength-reduction/strength-reduction.factor
deleted file mode 100644
index c36395bbee..0000000000
--- a/basis/compiler/tree/strength-reduction/strength-reduction.factor
+++ /dev/null
@@ -1,5 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler.tree.strength-reduction
-
-: strength-reduce ( nodes -- nodes' ) ;
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index b08d6eb2c7..6cda7fc73f 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -51,7 +51,7 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
 : push ( elt seq -- ) [ length ] [ set-nth ] bi ;
 
 : bounds-check? ( n seq -- ? )
-    length 1- 0 swap between? ; inline
+    dupd length < [ 0 >= ] [ drop f ] if ; inline
 
 ERROR: bounds-error index seq ;
 
@@ -485,8 +485,8 @@ PRIVATE>
     [ rot = [ over push ] [ drop ] if ]
     curry each-index ;
 
-: nths ( seq indices -- seq' )
-    swap [ nth ] curry map ;
+: nths ( indices seq -- seq' )
+    [ nth ] curry map ;
 
 : contains? ( seq quot -- ? )
     find drop >boolean ; inline