infix: fixing issue with confusing negative steps.

diff --git a/extra/infix/infix-tests.factor b/extra/infix/infix-tests.factor
index 4cc7ec7eb375091bf26d178074e16c18b8af7e30..342f436271607405265829e30c6a97d4883cc769 100644 (file)
--- 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 11fb9a86d179fd9edaaab5b2da4daa3db201b7c2..9cb01454bb6f1db66c88a32f50e935c55f660007 100644 (file)
--- 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
     {