steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

move some words to math-internals

cvs
Slava Pestov 2004-12-10 23:38:40 +00:00
parent f1ac31e7c5
commit 3843ebb744
13 changed files with 279 additions and 260 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
library/bootstrap/cross-compiler.factor
View File

@ -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

4
library/generic.factor
View File

@ -62,7 +62,7 @@ SYMBOL: delegate
: init-traits-map ( word -- )
<namespace> "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 ;

8
library/inference/branches.factor
View File

@ -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 ( -- )

1
library/kernel.factor
View File

@ -34,6 +34,7 @@ IN: kernel
USE: combinators
USE: lists
USE: math
USE: math-internals
USE: stack
USE: strings
USE: vectors

2
library/math/arc-trig-hyp.factor
View File

@ -28,7 +28,7 @@
IN: math
USE: combinators
USE: math
USE: real-math
USE: math-internals
USE: stack
! Inverse trigonometric functions:

490
library/math/generic.factor
View File

@ -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<<n )
{
fixnum-shift
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-shift
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 ;
: < ( 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 ;
: > ( 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 ;

2
library/math/math.factor
View File

@ -30,7 +30,7 @@ USE: combinators
USE: kernel
USE: logic
USE: math
USE: real-math
USE: math-internals
USE: stack
: fac ( n -- n! )

2
library/math/pow.factor
View File

@ -28,7 +28,7 @@
IN: math
USE: combinators
USE: math
USE: real-math
USE: math-internals
USE: kernel
USE: logic
USE: stack

2
library/math/trig-hyp.factor
View File

@ -29,7 +29,7 @@ IN: math
USE: combinators
USE: kernel
USE: math
USE: real-math
USE: math-internals
USE: stack
! Trigonometric functions:

2
library/primitives.factor
View File

@ -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

4
library/test/dataflow.factor
View File

@ -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

2
library/test/math/irrational.factor
View File

@ -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

2
library/tools/heap-stats.factor
View File

@ -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