TUPLE: interval { from read-only } { to read-only } ;
: <interval> ( from to -- int )
- over first over first {
+ 2dup [ first ] bi@ {
{ [ 2dup > ] [ 2drop 2drop empty-interval ] }
{ [ 2dup = ] [
- 2drop over second over second and
+ 2drop 2dup [ second ] both?
[ interval boa ] [ 2drop empty-interval ] if
] }
[ 2drop interval boa ]
: closed-point ( n -- endpoint ) t 2array ;
: [a,b] ( a b -- interval )
- >r closed-point r> closed-point <interval> ; foldable
+ [ closed-point ] dip closed-point <interval> ; foldable
: (a,b) ( a b -- interval )
- >r open-point r> open-point <interval> ; foldable
+ [ open-point ] dip open-point <interval> ; foldable
: [a,b) ( a b -- interval )
- >r closed-point r> open-point <interval> ; foldable
+ [ closed-point ] dip open-point <interval> ; foldable
: (a,b] ( a b -- interval )
- >r open-point r> closed-point <interval> ; foldable
+ [ open-point ] dip closed-point <interval> ; foldable
: [a,a] ( a -- interval )
closed-point dup <interval> ; foldable
: [-inf,inf] ( -- interval ) full-interval ; inline
: compare-endpoints ( p1 p2 quot -- ? )
- >r over first over first r> call [
+ [ 2dup [ first ] bi@ ] dip call [
2drop t
] [
- over first over first = [
- swap second swap second not or
+ 2dup [ first ] bi@ = [
+ [ second ] bi@ not or
] [
2drop f
] if
] if ;
: (interval-op) ( p1 p2 quot -- p3 )
- [ [ first ] [ first ] [ ] tri* call ]
+ [ [ first ] [ first ] [ call ] tri* ]
[ drop [ second ] both? ]
3bi 2array ; inline
drop f
] [
interval>points
- 2dup [ second ] bi@ and
+ 2dup [ second ] both?
[ [ first ] bi@ = ]
[ 2drop f ] if
] if ;
dup [ interval>points [ first ] bi@ [a,b] ] when ;
: interval-integer-op ( i1 i2 quot -- i3 )
- >r 2dup
- [ interval>points [ first integer? ] both? ] both?
- r> [ 2drop [-inf,inf] ] if ; inline
+ [
+ 2dup [ interval>points [ first integer? ] both? ] both?
+ ] dip [ 2drop [-inf,inf] ] if ; inline
: interval-shift ( i1 i2 -- i3 )
#! Inaccurate; could be tighter
2tri and and ;
: (interval<) ( i1 i2 -- i1 i2 ? )
- over from>> over from>> endpoint< ;
+ 2dup [ from>> ] bi@ endpoint< ;
: interval< ( i1 i2 -- ? )
{
} cond 2nip ;
: left-endpoint-<= ( i1 i2 -- ? )
- >r from>> r> to>> = ;
+ [ from>> ] dip to>> = ;
: right-endpoint-<= ( i1 i2 -- ? )
- >r to>> r> from>> = ;
+ [ to>> ] dip from>> = ;
: interval<= ( i1 i2 -- ? )
{