diff --git a/core/math/math.factor b/core/math/math.factor index 1d034aad49..cd908ea10f 100755 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -17,6 +17,11 @@ MATH: <= ( x y -- ? ) foldable MATH: > ( x y -- ? ) foldable MATH: >= ( x y -- ? ) foldable +: after? ( obj1 obj2 -- ? ) <=> 0 > ; inline +: before? ( obj1 obj2 -- ? ) <=> 0 < ; inline +: after=? ( obj1 obj2 -- ? ) <=> 0 >= ; inline +: before=? ( obj1 obj2 -- ? ) <=> 0 <= ; inline + MATH: + ( x y -- z ) foldable MATH: - ( x y -- z ) foldable MATH: * ( x y -- z ) foldable diff --git a/core/sorting/sorting-tests.factor b/core/sorting/sorting-tests.factor old mode 100644 new mode 100755 index 8325832050..d9227b2d95 --- a/core/sorting/sorting-tests.factor +++ b/core/sorting/sorting-tests.factor @@ -11,7 +11,7 @@ unit-test [ t ] [ 100 [ drop - 100 [ drop 20 random [ drop 1000 random ] map ] map natural-sort [ <=> 0 <= ] monotonic? + 100 [ drop 20 random [ drop 1000 random ] map ] map natural-sort [ before=? ] monotonic? ] all? ] unit-test diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index 25b8252ea1..ab2ce21010 100755 --- a/core/sorting/sorting.factor +++ b/core/sorting/sorting.factor @@ -52,7 +52,7 @@ PRIVATE> : sort-values ( seq -- sortedseq ) [ [ second ] compare ] sort ; -: sort-pair ( a b -- c d ) 2dup <=> 0 > [ swap ] when ; +: sort-pair ( a b -- c d ) 2dup after? [ swap ] when ; : midpoint ( seq -- elt ) [ midpoint@ ] keep nth-unsafe ; inline diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor index 90e74275ff..1df4e1c477 100755 --- a/core/strings/strings-tests.factor +++ b/core/strings/strings-tests.factor @@ -28,8 +28,8 @@ IN: temporary [ "end" ] [ "Beginning and end" 14 tail ] unit-test -[ t ] [ "abc" "abd" <=> 0 < ] unit-test -[ t ] [ "z" "abd" <=> 0 > ] unit-test +[ t ] [ "abc" "abd" before? ] unit-test +[ t ] [ "z" "abd" after? ] unit-test [ 0 10 "hello" subseq ] must-fail diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor index 7f43dbd612..651744d07f 100755 --- a/extra/alarms/alarms.factor +++ b/extra/alarms/alarms.factor @@ -29,10 +29,10 @@ SYMBOL: alarm-thread notify-alarm-thread ; : alarm-expired? ( alarm now -- ? ) - >r alarm-time r> <=> 0 <= ; + >r alarm-time r> before=? ; : reschedule-alarm ( alarm -- ) - dup alarm-time over alarm-interval +dt + dup alarm-time over alarm-interval time+ over set-alarm-time register-alarm ; diff --git a/extra/opengl/capabilities/capabilities.factor b/extra/opengl/capabilities/capabilities.factor old mode 100644 new mode 100755 index d9eb6fd679..d27df4965d --- a/extra/opengl/capabilities/capabilities.factor +++ b/extra/opengl/capabilities/capabilities.factor @@ -26,8 +26,8 @@ IN: opengl.capabilities : version-seq ( version-string -- version-seq ) "." split [ string>number ] map ; -: version<=> ( version1 version2 -- n ) - swap version-seq swap version-seq <=> ; +: version-before? ( version1 version2 -- ? ) + swap version-seq swap version-seq before=? ; : (gl-version) ( -- version vendor ) GL_VERSION glGetString " " split1 ; @@ -36,7 +36,7 @@ IN: opengl.capabilities : gl-vendor-version ( -- version ) (gl-version) nip ; : has-gl-version? ( version -- ? ) - gl-version version<=> 0 <= ; + gl-version version-before? ; : (make-gl-version-error) ( required-version -- ) "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ; : require-gl-version ( version -- ) @@ -51,7 +51,7 @@ IN: opengl.capabilities : glsl-vendor-version ( -- version ) (glsl-version) nip ; : has-glsl-version? ( version -- ? ) - glsl-version version<=> 0 <= ; + glsl-version version-before? ; : require-glsl-version ( version -- ) [ has-glsl-version? ] [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ] diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor old mode 100644 new mode 100755 index a806dafdec..81628684bc --- a/extra/trees/avl/avl.factor +++ b/extra/trees/avl/avl.factor @@ -53,14 +53,14 @@ TUPLE: avl-node balance ; DEFER: avl-set : avl-insert ( value key node -- node taller? ) - 2dup node-key key< left right ? [ + 2dup node-key before? left right ? [ [ node-link avl-set ] keep swap >r tuck set-node-link r> [ dup current-side get change-balance balance-insert ] [ f ] if ] with-side ; : (avl-set) ( value key node -- node taller? ) - 2dup node-key key= [ + 2dup node-key = [ -rot pick set-node-key over set-node-value f ] [ avl-insert ] if ; diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor old mode 100644 new mode 100755 index 6d53d9e541..e59bbab1ed --- a/extra/trees/trees.factor +++ b/extra/trees/trees.factor @@ -61,10 +61,6 @@ SYMBOL: current-side #! side is -1 if k1 < k2, 0 if they are equal, or 1 if k1 > k2 <=> sgn ; -: key< ( k1 k2 -- ? ) <=> 0 < ; -: key> ( k1 k2 -- ? ) <=> 0 > ; -: key= ( k1 k2 -- ? ) <=> zero? ; - : random-side ( -- side ) left right 2array random ; : choose-branch ( key node -- key node-left/right ) @@ -72,7 +68,7 @@ SYMBOL: current-side : node-at* ( key node -- value ? ) [ - 2dup node-key key= [ + 2dup node-key = [ nip node-value t ] [ choose-branch node-at* @@ -97,8 +93,8 @@ M: tree set-at ( value key tree -- ) : valid-node? ( node -- ? ) [ - dup dup node-left [ node-key swap node-key key< ] when* >r - dup dup node-right [ node-key swap node-key key> ] when* r> and swap + dup dup node-left [ node-key swap node-key before? ] when* >r + dup dup node-right [ node-key swap node-key after? ] when* r> and swap dup node-left valid-node? swap node-right valid-node? and and ] [ t ] if* ; diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor index 507dc932a4..def6b99b05 100755 --- a/extra/ui/gadgets/editors/editors.factor +++ b/extra/ui/gadgets/editors/editors.factor @@ -256,7 +256,7 @@ M: editor gadget-text* editor-string % ; } at T{ one-line-elt } or ; : drag-direction? ( loc editor -- ? ) - editor-mark* <=> 0 < ; + editor-mark* before? ; : drag-selection-caret ( loc editor element -- loc ) >r [ drag-direction? ] 2keep