factor/library/math/math.factor

! Copyright (C) 2003, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: math
USING: errors generic kernel math-internals ;

! Math operations
G: number= ( x y -- ? ) math-combination ; foldable
M: object number= 2drop f ;

G: <  ( x y -- ? ) math-combination ; foldable
G: <= ( x y -- ? ) math-combination ; foldable
G: >  ( x y -- ? ) math-combination ; foldable
G: >= ( x y -- ? ) math-combination ; foldable

G: +   ( x y -- x+y ) math-combination ; foldable
G: -   ( x y -- x-y ) math-combination ; foldable
G: *   ( x y -- x*y ) math-combination ; foldable
G: /   ( x y -- x/y ) math-combination ; foldable
G: /i  ( x y -- x/y ) math-combination ; foldable
G: /f  ( x y -- x/y ) math-combination ; foldable
G: mod ( x y -- x%y ) math-combination ; foldable

G: /mod ( x y -- x/y x%y ) math-combination ; foldable

G: bitand ( x y -- z ) math-combination ; foldable
G: bitor  ( x y -- z ) math-combination ; foldable
G: bitxor ( x y -- z ) math-combination ; foldable
G: shift  ( x n -- y ) math-combination ; foldable

GENERIC: bitnot ( n -- n ) foldable

GENERIC: 1+ ( x -- x+1 ) foldable
GENERIC: 1- ( x -- x-1 ) foldable

GENERIC: truncate ( n -- n ) foldable
GENERIC: floor    ( n -- n ) foldable
GENERIC: ceiling  ( n -- n ) foldable

: max ( x y -- z ) [ > ] 2keep ? ; inline
: min ( x y -- z ) [ < ] 2keep ? ; inline

: between? ( x min max -- ? ) pick >= >r >= r> and ; inline

: sq dup * ; inline

: neg 0 swap - ; inline
: recip 1 swap / ; inline

: rem ( x y -- x%y )
    #! Like modulus, but always gives a positive result.
    [ [ mod ] keep + ] keep mod ; inline

: sgn ( n -- -1/0/1 )
    #! Push the sign of a real number.
    dup 0 < -1 0 ? swap 0 > 1 0 ? bitor ; foldable

GENERIC: abs ( z -- |z| ) foldable
GENERIC: absq ( n -- |n|^2 ) foldable

: align ( offset width -- offset )
    1- [ + ] keep bitnot bitand ; inline

: (repeat) ( i n quot -- )
    pick pick >=
    [ 3drop ] [ [ swap >r call 1+ r> ] keep (repeat) ] if ;
    inline

: repeat ( n quot -- | quot: n -- n )
    #! The loop counter is kept on the stack, and ranges from
    #! 0 to n-1.
    0 -rot (repeat) ; inline

: times ( n quot -- | quot: -- )
    swap [ >r dup slip r> ] repeat drop ; inline

GENERIC: number>string ( str -- num ) foldable