diff --git a/contrib/math/load.factor b/contrib/math/load.factor index aae78c4925..ca0a05e95a 100644 --- a/contrib/math/load.factor +++ b/contrib/math/load.factor @@ -1,6 +1,7 @@ IN: dimensions USING: parser sequences words compiler ; [ + "contrib/math/utils.factor" "contrib/math/combinatorics.factor" "contrib/math/analysis.factor" "contrib/math/polynomial.factor" diff --git a/contrib/math/utils.factor b/contrib/math/utils.factor new file mode 100644 index 0000000000..70de6b0765 --- /dev/null +++ b/contrib/math/utils.factor @@ -0,0 +1,33 @@ +IN: math +USING: errors kernel sequences ; + +: deg>rad pi * 180 / ; inline +: rad>deg 180 * pi / ; inline + +: lcm ( a b -- c ) + #! Smallest integer such that c/a and c/b are both integers. + 2dup gcd nip >r * r> /i ; foldable + +: mod-inv ( x n -- y ) + #! Compute the multiplicative inverse of x mod n. + gcd 1 = [ "Non-trivial divisor found" throw ] unless ; + foldable + +: (^mod) ( n z w -- z^w ) + 1 swap [ + 1 number= [ dupd * pick mod ] when >r sq over mod r> + ] each-bit 2nip ; inline + +: ^mod ( z w n -- z^w ) + #! Compute z^w mod n. + over 0 < [ + [ >r neg r> ^mod ] keep mod-inv + ] [ + -rot (^mod) + ] if ; foldable + +: ** ( u v -- u*v' ) conjugate * ; inline + +: c. ( v v -- x ) + #! Complex inner product. + 0 [ ** + ] 2reduce ; diff --git a/library/compiler/architecture.factor b/library/compiler/architecture.factor index 34b4704ba9..dc816692bb 100644 --- a/library/compiler/architecture.factor +++ b/library/compiler/architecture.factor @@ -10,3 +10,7 @@ DEFER: fixnum-imm? ( -- ? ) DEFER: vregs ( -- n ) #! Number of vregs + +DEFER: dual-fp/int-regs? ( -- ? ) +#! Should fp parameters to fastcalls be loaded in integer +#! registers too? Only for PowerPC. diff --git a/library/math/complex.factor b/library/math/complex.factor index 273a9d465e..c6d46dbe07 100644 --- a/library/math/complex.factor +++ b/library/math/complex.factor @@ -28,8 +28,6 @@ M: number = ( n n -- ? ) number= ; : conjugate ( z -- z* ) >rect neg rect> ; inline -: ** ( u v -- u*v' ) conjugate * ; inline - : arg ( z -- arg ) #! Compute the complex argument. >rect swap fatan2 ; inline diff --git a/library/math/constants.factor b/library/math/constants.factor index 876fcf4bc5..da511f9ca2 100644 --- a/library/math/constants.factor +++ b/library/math/constants.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: math -USE: kernel : i #{ 0 1 }# ; inline : -i #{ 0 -1 }# ; inline @@ -9,6 +8,3 @@ USE: kernel : -inf -1.0 0.0 / ; inline : e 2.7182818284590452354 ; inline : pi 3.14159265358979323846 ; inline - -: deg>rad pi * 180 / ; inline -: rad>deg 180 * pi / ; inline diff --git a/library/math/integer.factor b/library/math/integer.factor index 9bc6255bad..ca3d5ec548 100644 --- a/library/math/integer.factor +++ b/library/math/integer.factor @@ -21,15 +21,6 @@ UNION: integer fixnum bignum ; #! such that a*x=d mod y. swap 0 1 2swap (gcd) abs ; foldable -: lcm ( a b -- c ) - #! Smallest integer such that c/a and c/b are both integers. - 2dup gcd nip >r * r> /i ; foldable - -: mod-inv ( x n -- y ) - #! Compute the multiplicative inverse of x mod n. - gcd 1 = [ "Non-trivial divisor found" throw ] unless ; - foldable - : (next-power-of-2) ( i n -- n ) 2dup >= [ drop diff --git a/library/math/pow.factor b/library/math/pow.factor index fbe07b343d..b7140304ff 100644 --- a/library/math/pow.factor +++ b/library/math/pow.factor @@ -45,16 +45,3 @@ M: integer ^ ( z w -- z^w ) ] [ dup 0 < [ neg ^ recip ] [ (integer^) ] if ] if ; - -: (^mod) ( n z w -- z^w ) - 1 swap [ - 1 number= [ dupd * pick mod ] when >r sq over mod r> - ] each-bit 2nip ; inline - -: ^mod ( z w n -- z^w ) - #! Compute z^w mod n. - over 0 < [ - [ >r neg r> ^mod ] keep mod-inv - ] [ - -rot (^mod) - ] if ; foldable diff --git a/library/math/vectors.factor b/library/math/vectors.factor index 2f3a54d558..d019fe2132 100644 --- a/library/math/vectors.factor +++ b/library/math/vectors.factor @@ -25,20 +25,19 @@ USING: arrays generic kernel sequences ; 2dup v* >r >r drop dup r> v* v- r> v+ ; : v. ( v v -- x ) - #! Real inner product. + #! Dot product. 0 [ * + ] 2reduce ; -: c. ( v v -- x ) - #! Complex inner product. - 0 [ ** + ] 2reduce ; - : norm-sq ( v -- n ) 0 [ absq + ] reduce ; -: norm ( vec -- n ) norm-sq sqrt ; +: norm ( vec -- n ) + #! Length of a vector. + norm-sq sqrt ; -: normalize ( vec -- vec ) dup norm v/n ; +: normalize ( vec -- uvec ) + #! Unit vector with same direction as vec. + dup norm v/n ; : proj ( u v -- w ) #! Orthogonal projection of u onto v. [ [ v. ] keep norm-sq v/n ] keep n*v ; - diff --git a/library/opengl/opengl-utils.factor b/library/opengl/opengl-utils.factor index 04476efbef..148c33d8c8 100644 --- a/library/opengl/opengl-utils.factor +++ b/library/opengl/opengl-utils.factor @@ -86,7 +86,7 @@ USING: alien errors kernel math namespaces opengl sdl sequences ; swap glMatrixMode glPushMatrix call glPopMatrix ; inline : gl-set-clip ( loc dim -- ) - dup first2 >r >r + dup first2 1+ >r >r over second swap second + height get swap - >r first r> r> r> glScissor ; diff --git a/library/ui/paint.factor b/library/ui/paint.factor index 5fb21c19b9..80d2546285 100644 --- a/library/ui/paint.factor +++ b/library/ui/paint.factor @@ -77,14 +77,14 @@ TUPLE: solid ; : rect>screen ( shape -- x1 y1 x2 y2 ) >r origin get dup r> rect-dim v+ - [ first2 ] 2apply [ 1 - ] 2apply ; + [ first2 ] 2apply ( [ 1 - ] 2apply ) ; ! Solid pen M: solid draw-interior drop dup bg gl-color rect-dim gl-fill-rect ; M: solid draw-boundary - drop dup fg gl-color rect-dim @{ 1 1 0 }@ v- gl-rect ; + drop dup fg gl-color rect-dim ( @{ 1 1 0 }@ v- ) gl-rect ; ! Rollover only TUPLE: rollover-only ;