1 ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: kernel kernel.private math ;
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
20 ! Defining a math generic for comparison forces a single math
21 ! promotion, and speeds up comparisons on numbers.
22 : (real<=>) ( x y -- <=> )
23 2dup < [ 2drop +lt+ ] [ number= +eq+ +gt+ ? ] if ; inline
25 MATH: real<=> ( x y -- <=> )
26 M: fixnum real<=> { fixnum fixnum } declare (real<=>) ; inline
27 M: bignum real<=> { bignum bignum } declare (real<=>) ; inline
28 M: float real<=> { float float } declare (real<=>) ; inline
29 M: real real<=> (real<=>) ; inline
33 M: real <=> real<=> ; inline
35 GENERIC: before? ( obj1 obj2 -- ? )
36 GENERIC: after? ( obj1 obj2 -- ? )
37 GENERIC: before=? ( obj1 obj2 -- ? )
38 GENERIC: after=? ( obj1 obj2 -- ? )
40 M: object before? <=> +lt+ eq? ; inline
41 M: object after? <=> +gt+ eq? ; inline
42 M: object before=? <=> +gt+ eq? not ; inline
43 M: object after=? <=> +lt+ eq? not ; inline
45 M: real before? < ; inline
46 M: real after? > ; inline
47 M: real before=? <= ; inline
48 M: real after=? >= ; inline
50 GENERIC: min ( obj1 obj2 -- obj )
51 GENERIC: max ( obj1 obj2 -- obj )
53 M: object min [ before? ] most ; inline
54 M: object max [ after? ] most ; inline
56 : clamp ( x min max -- y ) [ max ] dip min ; inline
58 : between? ( x min max -- ? )
59 pick after=? [ after=? ] [ 2drop f ] if ; inline
61 : [-] ( x y -- z ) - 0 max ; inline
63 : compare ( obj1 obj2 quot -- <=> ) bi@ <=> ; inline