From 3843ebb7443ec07602f28daff7521475a577f8c2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 10 Dec 2004 23:38:40 +0000 Subject: [PATCH] move some words to math-internals --- library/bootstrap/cross-compiler.factor | 18 +- library/generic.factor | 4 +- library/inference/branches.factor | 8 +- library/kernel.factor | 1 + library/math/arc-trig-hyp.factor | 2 +- library/math/generic.factor | 490 ++++++++++++------------ library/math/math.factor | 2 +- library/math/pow.factor | 2 +- library/math/trig-hyp.factor | 2 +- library/primitives.factor | 2 +- library/test/dataflow.factor | 4 +- library/test/math/irrational.factor | 2 +- library/tools/heap-stats.factor | 2 +- 13 files changed, 279 insertions(+), 260 deletions(-) diff --git a/library/bootstrap/cross-compiler.factor b/library/bootstrap/cross-compiler.factor index fd5ca32548..9afb380f62 100644 --- a/library/bootstrap/cross-compiler.factor +++ b/library/bootstrap/cross-compiler.factor @@ -30,9 +30,9 @@ USE: errors USE: kernel USE: lists USE: math +USE: math-internals USE: namespaces USE: parser -USE: real-math USE: stack USE: stdio USE: streams @@ -111,9 +111,11 @@ DEFER: pending-io-error DEFER: next-io-task IN: math -DEFER: arithmetic-type DEFER: >fraction DEFER: fraction> + +IN: math-internals +DEFER: arithmetic-type DEFER: fixnum= DEFER: fixnum+ DEFER: fixnum- @@ -157,6 +159,18 @@ DEFER: float< DEFER: float<= DEFER: float> DEFER: float>= +DEFER: facos +DEFER: fasin +DEFER: fatan +DEFER: fatan2 +DEFER: fcos +DEFER: fexp +DEFER: fcosh +DEFER: flog +DEFER: fpow +DEFER: fsin +DEFER: fsinh +DEFER: fsqrt IN: parser DEFER: str>float diff --git a/library/generic.factor b/library/generic.factor index 2928a71029..c25c7b65ec 100644 --- a/library/generic.factor +++ b/library/generic.factor @@ -62,7 +62,7 @@ SYMBOL: delegate : init-traits-map ( word -- ) "traits-map" set-word-property ; -: no-method +: undefined-method "No applicable method." throw ; : method ( selector traits -- traits quot ) @@ -75,7 +75,7 @@ SYMBOL: delegate drop delegate swap hash* dup [ cdr method ( check delegate ) ] [ - drop [ no-method ] ( no delegate ) + drop [ undefined-method ] ( no delegate ) ] ifte ] ifte ; diff --git a/library/inference/branches.factor b/library/inference/branches.factor index 4f34285473..0e85bc6812 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -28,6 +28,7 @@ IN: inference USE: combinators USE: errors +USE: generic USE: interpreter USE: kernel USE: lists @@ -98,10 +99,10 @@ USE: hashtables ] extend ; : terminator? ( quot -- ? ) - #! This is a hack. no-method has a stack effect that + #! This is a hack. undefined-method has a stack effect that #! probably does not match any other branch of the generic, #! so we handle it specially. - \ no-method swap tree-contains? ; + \ undefined-method swap tree-contains? ; : recursive-branch ( rstate quot -- ) #! Set base case if inference didn't fail. @@ -154,8 +155,7 @@ USE: hashtables : vtable>list ( [ vtable | rstate ] -- list ) #! generic and 2generic use vectors of words, we need lists - #! of quotations. Filter out no-method. Dirty workaround; - #! later properly handle throw. + #! of quotations. unswons vector>list [ unit over cons ] map nip ; : infer-generic ( -- ) diff --git a/library/kernel.factor b/library/kernel.factor index 65912e3fe2..68dfe7509d 100644 --- a/library/kernel.factor +++ b/library/kernel.factor @@ -34,6 +34,7 @@ IN: kernel USE: combinators USE: lists USE: math +USE: math-internals USE: stack USE: strings USE: vectors diff --git a/library/math/arc-trig-hyp.factor b/library/math/arc-trig-hyp.factor index 2dc8a22ae2..009901e3be 100644 --- a/library/math/arc-trig-hyp.factor +++ b/library/math/arc-trig-hyp.factor @@ -28,7 +28,7 @@ IN: math USE: combinators USE: math -USE: real-math +USE: math-internals USE: stack ! Inverse trigonometric functions: diff --git a/library/math/generic.factor b/library/math/generic.factor index 12f653cc9d..0f2dfa85a1 100644 --- a/library/math/generic.factor +++ b/library/math/generic.factor @@ -28,6 +28,7 @@ IN: math USE: combinators USE: errors +USE: generic USE: kernel USE: stack USE: vectors @@ -38,14 +39,22 @@ DEFER: number= : (gcd) ( x y -- z ) dup 0 = [ drop ] [ tuck mod (gcd) ] ifte ; : gcd ( x y -- z ) abs swap abs 2dup < [ swap ] when (gcd) ; -: reduce ( x y -- x' y' ) - dup 0 < [ swap neg swap neg ] when 2dup gcd tuck /i >r /i r> ; -: ratio ( x y -- x/y ) reduce fraction> ; +: >rect ( x -- x:re x: im ) dup real swap imaginary ; +: 2>rect ( x y -- x:re y:re x:im y:im ) + [ swap real swap real ] 2keep + swap imaginary swap imaginary ; + : >fraction ( a/b -- a b ) dup numerator swap denominator ; : 2>fraction ( a/b c/d -- a c b d ) [ swap numerator swap numerator ] 2keep swap denominator swap denominator ; +IN: math-internals + +: reduce ( x y -- x' y' ) + dup 0 < [ swap neg swap neg ] when 2dup gcd tuck /i >r /i r> ; +: ratio ( x y -- x/y ) reduce fraction> ; + : ratio= ( a/b c/d -- ? ) 2>fraction number= [ number= ] [ 2drop f ] ifte ; : ratio-scale ( a/b c/d -- a*d b*c ) @@ -62,11 +71,6 @@ DEFER: number= : ratio> ( x y -- ? ) ratio-scale > ; : ratio>= ( x y -- ? ) ratio-scale >= ; -: >rect ( x -- x:re x: im ) dup real swap imaginary ; -: 2>rect ( x y -- x:re y:re x:im y:im ) - [ swap real swap real ] 2keep - swap imaginary swap imaginary ; - : complex= ( x y -- ? ) 2>rect number= [ number= ] [ 2drop f ] ifte ; @@ -89,12 +93,12 @@ DEFER: number= : complex/f ( x y -- x/y ) (complex/) tuck /f >r /f r> rect> ; -: no-method ( -- ) - "No applicable method" throw ; - : (not-=) ( x y -- f ) 2drop f ; +IN: math +USE: math-internals + : number= ( x y -- ? ) { fixnum= @@ -119,356 +123,356 @@ DEFER: number= : + ( x y -- x+y ) { fixnum+ - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method ratio+ complex+ - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method bignum+ float+ - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : - ( x y -- x-y ) { fixnum- - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method ratio- complex- - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method bignum- float- - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : * ( x y -- x*y ) { fixnum* - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method ratio* complex* - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method bignum* float* - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : / ( x y -- x/y ) { ratio - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method ratio/ complex/ - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method ratio float/f - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : /i ( x y -- x/y ) { fixnum/i - no-method - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method bignum/i - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : /f ( x y -- x/y ) { fixnum/f - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method ratio/f complex/f - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method bignum/f float/f - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : mod ( x y -- x%y ) { fixnum-mod - no-method - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method bignum-mod - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : /mod ( x y -- x/y x%y ) { fixnum/mod - no-method - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method bignum/mod - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : bitand ( x y -- x&y ) { fixnum-bitand - no-method - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method bignum-bitand - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : bitor ( x y -- x|y ) { fixnum-bitor - no-method - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method bignum-bitor - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : bitxor ( x y -- x^y ) { fixnum-bitxor - no-method - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method bignum-bitxor - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : bitnot ( x -- ~x ) { fixnum-bitnot - no-method - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method bignum-bitnot - no-method - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } generic ; : shift ( x n -- x< ( x y -- ? ) { fixnum> - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method ratio> - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method bignum> float> - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; : >= ( x y -- ? ) { fixnum>= - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method ratio>= - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method bignum>= float>= - no-method - no-method - no-method - no-method - no-method - no-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method + undefined-method } 2generic ; diff --git a/library/math/math.factor b/library/math/math.factor index 42b63ab8e0..55add939ff 100644 --- a/library/math/math.factor +++ b/library/math/math.factor @@ -30,7 +30,7 @@ USE: combinators USE: kernel USE: logic USE: math -USE: real-math +USE: math-internals USE: stack : fac ( n -- n! ) diff --git a/library/math/pow.factor b/library/math/pow.factor index f703b69c6a..39815fd3e7 100644 --- a/library/math/pow.factor +++ b/library/math/pow.factor @@ -28,7 +28,7 @@ IN: math USE: combinators USE: math -USE: real-math +USE: math-internals USE: kernel USE: logic USE: stack diff --git a/library/math/trig-hyp.factor b/library/math/trig-hyp.factor index e7509f127c..7e11b62793 100644 --- a/library/math/trig-hyp.factor +++ b/library/math/trig-hyp.factor @@ -29,7 +29,7 @@ IN: math USE: combinators USE: kernel USE: math -USE: real-math +USE: math-internals USE: stack ! Trigonometric functions: diff --git a/library/primitives.factor b/library/primitives.factor index 1ff5b89730..fbb1c7a369 100644 --- a/library/primitives.factor +++ b/library/primitives.factor @@ -34,10 +34,10 @@ USE: io-internals USE: kernel USE: lists USE: math +USE: math-internals USE: parser USE: profiler USE: random -USE: real-math USE: stack USE: strings USE: unparser diff --git a/library/test/dataflow.factor b/library/test/dataflow.factor index 994f4017db..c26e2c142e 100644 --- a/library/test/dataflow.factor +++ b/library/test/dataflow.factor @@ -63,10 +63,10 @@ USE: words ] unit-test [ t ] [ - [ { drop no-method drop no-method } generic ] dataflow + [ { drop undefined-method drop undefined-method } generic ] dataflow #generic swap dataflow-contains-op? car [ node-param get [ - [ [ node-param get \ no-method = ] bind ] some? + [ [ node-param get \ undefined-method = ] bind ] some? ] some? ] bind >boolean ] unit-test diff --git a/library/test/math/irrational.factor b/library/test/math/irrational.factor index 41963093ec..41daa8b4c6 100644 --- a/library/test/math/irrational.factor +++ b/library/test/math/irrational.factor @@ -1,8 +1,8 @@ IN: scratchpad USE: kernel USE: math +USE: math-internals USE: test -USE: real-math ! Lets get the argument order correct, eh? [ 0.0 ] [ 0 1 fatan2 ] unit-test diff --git a/library/tools/heap-stats.factor b/library/tools/heap-stats.factor index 91e8a30237..5677881f53 100644 --- a/library/tools/heap-stats.factor +++ b/library/tools/heap-stats.factor @@ -25,7 +25,7 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -IN: kernel +IN: listener USE: combinators USE: kernel USE: lists