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

infix: fixing issue with confusing negative steps.

db4
John Benediktsson 2013-03-19 18:48:49 -07:00
parent c55c4c4470
commit 480b57029a
2 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/infix/infix-tests.factor
View File

@ -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

16
extra/infix/infix.factor
View File

@ -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 ( from to step seq -- subseq )
seq length :> len
:: 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*
[ 0 len clamp ] bi@ dupd max seq subseq
step [ infix-subseq-step ] when* ;
] if [ 0 len clamp ] bi@ dupd max ;
:: infix-subseq ( from to step seq -- subseq )
from to step seq length infix-subseq-range
seq subseq step [ infix-subseq-step ] when* ;
M: ast-slice infix-codegen
{