From 480b57029a365c8d0b441e02064e94a8b29693cc Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 19 Mar 2013 18:48:49 -0700
Subject: [PATCH] infix: fixing issue with confusing negative steps.

---
 extra/infix/infix-tests.factor |  9 +++++++--
 extra/infix/infix.factor       | 18 ++++++++++++------
 2 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/extra/infix/infix-tests.factor b/extra/infix/infix-tests.factor
index 4cc7ec7eb3..342f436271 100644
--- a/extra/infix/infix-tests.factor
+++ b/extra/infix/infix-tests.factor
@@ -38,9 +38,14 @@ IN: infix.tests
 [ "foo" ] [ [let "foobar" :> s [infix s[0:3] infix] ] ] unit-test
 [ "foo" ] [ [let "foobar" :> s [infix s[:3] infix] ] ] unit-test
 [ "bar" ] [ [let "foobar" :> s [infix s[-3:] infix] ] ] unit-test
-[ "rab" ] [ [let "foobar" :> s [infix s[-3::-1] infix] ] ] unit-test
+[ "boof" ] [ [let "foobar" :> s [infix s[-3::-1] infix] ] ] unit-test
 [ "foobar" ] [ [let "foobar" :> s [infix s[:] infix] ] ] unit-test
 [ "foa" ] [ [let "foobar" :> s [infix s[::2] infix] ] ] unit-test
 [ "bar" ] [ [let "foobar" :> s [infix s[-3:100] infix] ] ] unit-test
 [ "foobar" ] [ [let "foobar" :> s [infix s[-100:100] infix] ] ] unit-test
-
+[ "olh" ] [ [let "hello" :> s [infix s[4::-2] infix] ] ] unit-test
+[ "rb" ] [ [let "foobar" :> s [infix s[:1:-2] infix] ] ] unit-test
+[ "foa" ] [ [let "foobar" :> s [infix s[:-1:2] infix] ] ] unit-test
+[ "rbo" ] [ [let "foobar" :> s [infix s[::-2] infix] ] ] unit-test
+[ "rbo" ] [ [let "foobar" :> s [infix s[:0:-2] infix] ] ] unit-test
+[ "rb" ] [ [let "foobar" :> s [infix s[:-5:-2] infix] ] ] unit-test
diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor
index 11fb9a86d1..9cb01454bb 100644
--- a/extra/infix/infix.factor
+++ b/extra/infix/infix.factor
@@ -44,16 +44,22 @@ M: ast-array infix-codegen
 : infix-subseq-step ( subseq step -- subseq' )
     dup 0 < [ [ reverse! ] dip ] when
     abs dup 1 = [ drop ] [
-        [ dup length 1 - 0 swap ] dip
+        [ dup length 1 [-] 0 swap ] dip
         <range> swap nths
     ] if ;
 
+:: infix-subseq-range ( from to step len -- from to )
+    step [ 0 < ] [ f ] if* [
+        to [ dup 0 < [ len + ] when 1 + ] [ 0 ] if*
+        from [ dup 0 < [ len + ] when 1 + ] [ len ] if*
+    ] [
+        from 0 or dup 0 < [ len + ] when
+        to [ dup 0 < [ len + ] when ] [ len ] if*
+    ] if [ 0 len clamp ] bi@ dupd max ;
+
 :: infix-subseq ( from to step seq -- subseq )
-    seq length :> len
-    from 0 or dup 0 < [ len + ] when
-    to [ dup 0 < [ len + ] when ] [ len ] if*
-    [ 0 len clamp ] bi@ dupd max seq subseq
-    step [ infix-subseq-step ] when* ;
+    from to step seq length infix-subseq-range
+    seq subseq step [ infix-subseq-step ] when* ;
 
 M: ast-slice infix-codegen
     {