1 ! Copyright (C) 2008 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
10 : invert-comparison ( <=> -- <=>' )
11 #! Can't use case, index or nth here
12 dup +lt+ eq? [ drop +gt+ ] [ +eq+ eq? +eq+ +lt+ ? ] if ;
14 GENERIC: <=> ( obj1 obj2 -- <=> )
16 : >=< ( obj1 obj2 -- >=< ) <=> invert-comparison ; inline
18 M: real <=> 2dup < [ 2drop +lt+ ] [ number= +eq+ +gt+ ? ] if ;
20 GENERIC: before? ( obj1 obj2 -- ? )
21 GENERIC: after? ( obj1 obj2 -- ? )
22 GENERIC: before=? ( obj1 obj2 -- ? )
23 GENERIC: after=? ( obj1 obj2 -- ? )
25 M: object before? ( obj1 obj2 -- ? ) <=> +lt+ eq? ;
26 M: object after? ( obj1 obj2 -- ? ) <=> +gt+ eq? ;
27 M: object before=? ( obj1 obj2 -- ? ) <=> +gt+ eq? not ;
28 M: object after=? ( obj1 obj2 -- ? ) <=> +lt+ eq? not ;
30 M: real before? ( obj1 obj2 -- ? ) < ;
31 M: real after? ( obj1 obj2 -- ? ) > ;
32 M: real before=? ( obj1 obj2 -- ? ) <= ;
33 M: real after=? ( obj1 obj2 -- ? ) >= ;
35 : min ( x y -- z ) [ before? ] most ; inline
36 : max ( x y -- z ) [ after? ] most ; inline
38 : between? ( x y z -- ? )
39 pick after=? [ after=? ] [ 2drop f ] if ; inline
41 : [-] ( x y -- z ) - 0 max ; inline
43 : compare ( obj1 obj2 quot -- <=> ) bi@ <=> ; inline