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

make monotonic-slice compile

db4
Doug Coleman 2009-01-09 19:04:10 -06:00
parent b08e1a0205
commit ea4f8867c7
2 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/splitting/monotonic/monotonic-tests.factor
View File

@ -15,6 +15,8 @@ USING: tools.test math arrays kernel sequences ;
[ { { 1 } } ] [ { { 1 } } ]
[ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test [ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
[ { 1 } [ = ] slice monotonic-slice ] must-infer
[ t ] [ t ]
[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test [ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test

8
basis/splitting/monotonic/monotonic.factor
View File

@ -24,13 +24,15 @@ PRIVATE>
<PRIVATE <PRIVATE
: (monotonic-slice) ( seq quot class -- slices ) : (monotonic-slice) ( seq quot class -- slices )
-rot [
dupd '[ dupd '[
[ length ] [ ] [ <circular> 1 over change-circular-start ] tri [ length ] [ ] [ <circular> 1 over change-circular-start ] tri
[ @ not [ , ] [ drop ] if ] 3each [ @ not [ , ] [ drop ] if ] 3each
] { } make ] { } make
dup empty? [ over length 1- prefix ] when -1 prefix 2 clump dup empty? [ over length 1- prefix ] when -1 prefix 2 clump
[ first2 [ 1+ ] bi@ rot roll boa ] with with map ; inline swap
] dip
'[ first2 [ 1+ ] bi@ _ _ boa ] map ; inline
PRIVATE> PRIVATE>
@ -39,7 +41,7 @@ PRIVATE>
{ 0 [ 2drop ] } { 0 [ 2drop ] }
{ 1 [ nip [ 0 1 rot ] dip boa 1array ] } { 1 [ nip [ 0 1 rot ] dip boa 1array ] }
[ drop (monotonic-slice) ] [ drop (monotonic-slice) ]
} case ; } case ; inline
TUPLE: downward-slice < slice ; TUPLE: downward-slice < slice ;
TUPLE: stable-slice < slice ; TUPLE: stable-slice < slice ;