Move more math stuff to extra/, get compiler to work without ratios/complex numbers
parent
4d30644576
commit
e9b42fa635
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays generator generator.registers generator.fixup
|
||||
hashtables kernel math namespaces sequences words
|
||||
inference.backend inference.dataflow system math.functions
|
||||
inference.backend inference.dataflow system
|
||||
math.parser classes alien.arrays alien.c-types alien.structs
|
||||
alien.syntax cpu.architecture alien inspector quotations assocs
|
||||
kernel.private threads continuations.private libc combinators ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays generic hashtables kernel kernel.private math
|
||||
namespaces parser sequences strings words libc slots
|
||||
alien.c-types math.functions math.vectors cpu.architecture ;
|
||||
alien.c-types cpu.architecture ;
|
||||
IN: alien.structs
|
||||
|
||||
: align-offset ( offset type -- offset )
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
USING: arrays kernel sequences sequences.private growable
|
||||
tools.test vectors layouts system math math.functions
|
||||
vectors.private ;
|
||||
tools.test vectors layouts system math vectors.private ;
|
||||
IN: temporary
|
||||
|
||||
[ -2 { "a" "b" "c" } nth ] unit-test-fails
|
||||
|
|
|
@ -5,48 +5,46 @@ hashtables.private sequences.private math tuples.private
|
|||
growable namespaces.private alien.remote-control assocs
|
||||
words generator command-line vocabs io prettyprint libc ;
|
||||
|
||||
"bootstrap.math" vocab [
|
||||
"cpu." cpu append require
|
||||
"cpu." cpu append require
|
||||
|
||||
global [ { "compiler" } add-use ] bind
|
||||
global [ { "compiler" } add-use ] bind
|
||||
|
||||
"-no-stack-traces" cli-args member? [
|
||||
f compiled-stack-traces set-global
|
||||
] when
|
||||
|
||||
! Compile a set of words ahead of our general
|
||||
! compile-all. This set of words was determined
|
||||
! semi-empirically using the profiler. It improves
|
||||
! bootstrap time significantly, because frequenly
|
||||
! called words which are also quick to compile
|
||||
! are replaced by compiled definitions as soon as
|
||||
! possible.
|
||||
{
|
||||
roll -roll declare not
|
||||
|
||||
tuple-class-eq? array? hashtable? vector?
|
||||
tuple? sbuf? node? tombstone?
|
||||
|
||||
array-capacity array-nth set-array-nth
|
||||
|
||||
wrap probe
|
||||
|
||||
delegate
|
||||
|
||||
underlying
|
||||
|
||||
find-pair-next namestack*
|
||||
|
||||
bitand bitor bitxor bitnot
|
||||
|
||||
+ 1+ 1- 2/ < <= > >= shift min
|
||||
|
||||
new nth push pop peek hashcode* = get set
|
||||
|
||||
. lines
|
||||
|
||||
malloc free memcpy
|
||||
} [ compile ] each
|
||||
|
||||
[ recompile ] parse-hook set-global
|
||||
"-no-stack-traces" cli-args member? [
|
||||
f compiled-stack-traces set-global
|
||||
] when
|
||||
|
||||
! Compile a set of words ahead of our general
|
||||
! compile-all. This set of words was determined
|
||||
! semi-empirically using the profiler. It improves
|
||||
! bootstrap time significantly, because frequenly
|
||||
! called words which are also quick to compile
|
||||
! are replaced by compiled definitions as soon as
|
||||
! possible.
|
||||
{
|
||||
roll -roll declare not
|
||||
|
||||
tuple-class-eq? array? hashtable? vector?
|
||||
tuple? sbuf? node? tombstone?
|
||||
|
||||
array-capacity array-nth set-array-nth
|
||||
|
||||
wrap probe
|
||||
|
||||
delegate
|
||||
|
||||
underlying
|
||||
|
||||
find-pair-next namestack*
|
||||
|
||||
bitand bitor bitxor bitnot
|
||||
|
||||
+ 1+ 1- 2/ < <= > >= shift min
|
||||
|
||||
new nth push pop peek hashcode* = get set
|
||||
|
||||
. lines
|
||||
|
||||
malloc free memcpy
|
||||
} [ compile ] each
|
||||
|
||||
[ recompile ] parse-hook set-global
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: alien arrays bit-arrays byte-arrays generic assocs
|
|||
hashtables assocs hashtables.private io kernel kernel.private
|
||||
math namespaces parser prettyprint sequences sequences.private
|
||||
strings sbufs vectors words quotations assocs system layouts
|
||||
splitting growable math.functions classes tuples words.private
|
||||
splitting growable classes tuples words.private
|
||||
io.binary io.files vocabs vocabs.loader source-files
|
||||
definitions debugger float-arrays quotations.private
|
||||
combinators.private combinators ;
|
||||
|
|
|
@ -23,6 +23,7 @@ vocabs.loader system ;
|
|||
\ boot ,
|
||||
|
||||
"math.integers" require
|
||||
"math.floats" require
|
||||
"memory" require
|
||||
"io.streams.c" require
|
||||
"vocabs.loader" require
|
||||
|
|
|
@ -19,11 +19,14 @@ IN: bootstrap.stage2
|
|||
|
||||
parse-command-line
|
||||
|
||||
"Cross-referencing..." print flush
|
||||
H{ } clone changed-words set-global
|
||||
H{ } clone crossref set-global
|
||||
xref-words
|
||||
xref-sources
|
||||
|
||||
"-no-crossref" cli-args member? [
|
||||
"Cross-referencing..." print flush
|
||||
H{ } clone crossref set-global
|
||||
xref-words
|
||||
xref-sources
|
||||
] unless
|
||||
|
||||
! Set dll paths
|
||||
wince? [ "windows.ce" require ] when
|
||||
|
@ -34,6 +37,7 @@ IN: bootstrap.stage2
|
|||
] [
|
||||
"listener" require
|
||||
"none" require
|
||||
"listener" use+
|
||||
] if
|
||||
|
||||
[
|
||||
|
|
|
@ -20,7 +20,6 @@ f swap set-vocab-source-loaded?
|
|||
"B{"
|
||||
"C:"
|
||||
"CHAR:"
|
||||
"C{"
|
||||
"DEFER:"
|
||||
"F{"
|
||||
"FORGET:"
|
||||
|
|
|
@ -2,10 +2,9 @@ IN: temporary
|
|||
USING: arrays compiler kernel kernel.private math
|
||||
math.private sequences strings tools.test words continuations
|
||||
sequences.private hashtables.private byte-arrays
|
||||
strings.private system random math.vectors layouts
|
||||
strings.private system random layouts
|
||||
vectors.private sbufs.private strings.private slots.private
|
||||
alien alien.c-types alien.syntax namespaces libc math.constants
|
||||
math.functions ;
|
||||
alien alien.c-types alien.syntax namespaces libc ;
|
||||
|
||||
! Make sure that intrinsic ops compile to correct code.
|
||||
[ ] [ 1 [ drop ] compile-1 ] unit-test
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel cpu.architecture cpu.arm.assembler
|
||||
cpu.arm.architecture namespaces math math.functions sequences
|
||||
cpu.arm.architecture namespaces math sequences
|
||||
generator generator.registers generator.fixup system layouts
|
||||
alien ;
|
||||
IN: cpu.arm.allot
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types arrays cpu.arm.assembler compiler
|
||||
kernel kernel.private math math.functions namespaces words
|
||||
kernel kernel.private math namespaces words
|
||||
words.private generator.registers generator.fixup generator
|
||||
cpu.architecture system layouts ;
|
||||
IN: cpu.arm.architecture
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: bootstrap.image.private kernel namespaces system
|
||||
cpu.arm.assembler math math.functions layouts words vocabs ;
|
||||
cpu.arm.assembler math layouts words vocabs ;
|
||||
IN: bootstrap.arm
|
||||
|
||||
4 \ cell set
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien arrays cpu.architecture cpu.arm.assembler
|
||||
cpu.arm.architecture cpu.arm.allot kernel kernel.private math
|
||||
math.functions math.private namespaces sequences words
|
||||
math.private namespaces sequences words
|
||||
quotations byte-arrays hashtables.private hashtables generator
|
||||
generator.registers generator.fixup sequences.private sbufs
|
||||
sbufs.private vectors vectors.private system tuples.private
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: kernel cpu.ppc.architecture cpu.ppc.assembler
|
||||
kernel.private namespaces math sequences generic arrays
|
||||
generator generator.registers generator.fixup system layouts
|
||||
math.functions cpu.architecture alien ;
|
||||
cpu.architecture alien ;
|
||||
IN: cpu.ppc.allot
|
||||
|
||||
: load-zone-ptr ( reg -- )
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: alien.c-types cpu.ppc.assembler cpu.architecture generic
|
||||
kernel kernel.private math memory namespaces sequences words
|
||||
assocs generator generator.registers generator.fixup system
|
||||
layouts math.functions classes words.private alien combinators ;
|
||||
layouts classes words.private alien combinators ;
|
||||
IN: cpu.ppc.architecture
|
||||
|
||||
TUPLE: ppc-backend ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: cpu.ppc.assembler
|
||||
USING: generator.fixup generic kernel math memory namespaces
|
||||
words math.bitfields math.functions io.binary ;
|
||||
words math.bitfields io.binary ;
|
||||
|
||||
! See the Motorola or IBM documentation for details. The opcode
|
||||
! names are standard, and the operand order is the same as in
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: bootstrap.image.private kernel namespaces system
|
||||
cpu.ppc.assembler math math.functions layouts words vocabs ;
|
||||
cpu.ppc.assembler math layouts words vocabs ;
|
||||
IN: bootstrap.ppc
|
||||
|
||||
4 \ cell set
|
||||
|
|
|
@ -5,7 +5,7 @@ cpu.ppc.architecture cpu.ppc.allot cpu.architecture kernel
|
|||
kernel.private math math.private namespaces sequences words
|
||||
generic quotations byte-arrays hashtables hashtables.private
|
||||
generator generator.registers generator.fixup sequences.private
|
||||
sbufs vectors system layouts math.functions math.floats.private
|
||||
sbufs vectors system layouts math.floats.private
|
||||
classes tuples tuples.private sbufs.private vectors.private
|
||||
strings.private slots.private combinators bit-arrays
|
||||
float-arrays ;
|
||||
|
@ -374,14 +374,6 @@ IN: cpu.ppc.intrinsics
|
|||
{ +output+ { "out" } }
|
||||
} define-intrinsic
|
||||
|
||||
! \ fsqrt [
|
||||
! "y" operand "x" operand FSQRT
|
||||
! ] H{
|
||||
! { +input+ { { float "x" } } }
|
||||
! { +scratch+ { { float "y" } } }
|
||||
! { +output+ { "y" } }
|
||||
! } define-intrinsic
|
||||
|
||||
\ tag [
|
||||
"out" operand "in" operand tag-mask get ANDI
|
||||
"out" operand dup %tag-fixnum
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: alien.c-types arrays cpu.x86.assembler
|
|||
cpu.x86.architecture cpu.x86.intrinsics cpu.x86.allot
|
||||
cpu.architecture kernel kernel.private math namespaces sequences
|
||||
generator.registers generator.fixup generator system
|
||||
math.functions alien.compiler combinators command-line
|
||||
alien.compiler combinators command-line
|
||||
compiler io vocabs.loader ;
|
||||
IN: cpu.x86.32
|
||||
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: alien.c-types arrays cpu.x86.assembler
|
|||
cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2
|
||||
cpu.x86.allot cpu.architecture kernel kernel.private math
|
||||
namespaces sequences generator.registers generator.fixup system
|
||||
alien alien.compiler alien.structs slots splitting math.functions ;
|
||||
alien alien.compiler alien.structs slots splitting ;
|
||||
IN: cpu.x86.64
|
||||
|
||||
PREDICATE: x86-backend amd64-backend
|
||||
|
|
|
@ -2,8 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel cpu.architecture cpu.x86.assembler
|
||||
cpu.x86.architecture kernel.private namespaces math
|
||||
math.functions sequences generic arrays generator
|
||||
generator.fixup generator.registers system layouts alien ;
|
||||
sequences generic arrays generator generator.fixup
|
||||
generator.registers system layouts alien ;
|
||||
IN: cpu.x86.allot
|
||||
|
||||
: allot-reg
|
||||
|
|
|
@ -2,8 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.compiler arrays
|
||||
cpu.x86.assembler cpu.architecture kernel kernel.private math
|
||||
math.functions memory namespaces sequences words generator
|
||||
generator.registers generator.fixup system layouts combinators ;
|
||||
memory namespaces sequences words generator generator.registers
|
||||
generator.fixup system layouts combinators ;
|
||||
IN: cpu.x86.architecture
|
||||
|
||||
TUPLE: x86-backend cell ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien arrays cpu.x86.assembler cpu.x86.allot
|
||||
cpu.x86.architecture cpu.architecture kernel kernel.private math
|
||||
math.functions math.private namespaces quotations sequences
|
||||
math.private namespaces quotations sequences
|
||||
words generic byte-arrays hashtables hashtables.private
|
||||
generator generator.registers generator.fixup sequences.private
|
||||
sbufs sbufs.private vectors vectors.private layouts system
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: inference.backend
|
||||
USING: inference.dataflow arrays generic io io.streams.string
|
||||
kernel math math.vectors namespaces parser prettyprint sequences
|
||||
kernel math namespaces parser prettyprint sequences
|
||||
strings vectors words quotations effects classes continuations
|
||||
debugger assocs combinators ;
|
||||
|
||||
|
|
|
@ -2,8 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays generic assocs hashtables inference kernel
|
||||
math namespaces sequences words parser math.intervals
|
||||
math.vectors effects classes inference.dataflow
|
||||
inference.backend ;
|
||||
effects classes inference.dataflow inference.backend ;
|
||||
IN: inference.class
|
||||
|
||||
! Class inference
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006, 2007 Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math kernel sequences sbufs vectors namespaces io.binary
|
||||
io.encodings combinators splitting math.functions ;
|
||||
io.encodings combinators splitting ;
|
||||
IN: io.utf16
|
||||
|
||||
SYMBOL: double
|
||||
|
|
|
@ -25,9 +25,6 @@ IN: temporary
|
|||
|
||||
[ 2.1 ] [ -2.1 neg ] unit-test
|
||||
|
||||
[ 1 ] [ 0.5 1/2 + ] unit-test
|
||||
[ 1 ] [ 1/2 0.5 + ] unit-test
|
||||
|
||||
[ 3 ] [ 3.1415 >fixnum ] unit-test
|
||||
[ 3 ] [ 3.1415 >bignum ] unit-test
|
||||
|
||||
|
@ -48,23 +45,6 @@ unit-test
|
|||
[ 2.0 ] [ 1.0 1+ ] unit-test
|
||||
[ 0.0 ] [ 1.0 1- ] unit-test
|
||||
|
||||
[ 4.0 ] [ 4.5 truncate ] unit-test
|
||||
[ 4.0 ] [ 4.5 floor ] unit-test
|
||||
[ 5.0 ] [ 4.5 ceiling ] unit-test
|
||||
|
||||
[ -4.0 ] [ -4.5 truncate ] unit-test
|
||||
[ -5.0 ] [ -4.5 floor ] unit-test
|
||||
[ -4.0 ] [ -4.5 ceiling ] unit-test
|
||||
|
||||
[ -4.0 ] [ -4.0 truncate ] unit-test
|
||||
[ -4.0 ] [ -4.0 floor ] unit-test
|
||||
[ -4.0 ] [ -4.0 ceiling ] unit-test
|
||||
|
||||
[ -5.0 ] [ -4.5 round ] unit-test
|
||||
[ -4.0 ] [ -4.4 round ] unit-test
|
||||
[ 5.0 ] [ 4.5 round ] unit-test
|
||||
[ 4.0 ] [ 4.4 round ] unit-test
|
||||
|
||||
! [ t ] [ -0.0 -0.0 = ] unit-test
|
||||
! [ f ] [ 0.0 -0.0 = ] unit-test
|
||||
|
||||
|
|
|
@ -1,17 +1,11 @@
|
|||
! Copyright (C) 2004, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.private math.libm ;
|
||||
USING: kernel math math.private ;
|
||||
IN: math.floats.private
|
||||
|
||||
M: fixnum >float fixnum>float ;
|
||||
M: bignum >float bignum>float ;
|
||||
|
||||
M: real abs dup 0 < [ neg ] when ;
|
||||
M: real absq sq ;
|
||||
|
||||
M: real hashcode* nip >fixnum ;
|
||||
M: real <=> - ;
|
||||
|
||||
M: float zero? dup 0.0 float= swap -0.0 float= or ;
|
||||
|
||||
M: float >fixnum float>fixnum ;
|
||||
|
@ -29,6 +23,3 @@ M: float - float- ;
|
|||
M: float * float* ;
|
||||
M: float / float/f ;
|
||||
M: float mod float-mod ;
|
||||
|
||||
M: real sqrt
|
||||
>float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
USING: help.markup help.syntax math math.private math.functions
|
||||
math.ratios.private ;
|
||||
USING: help.markup help.syntax math math.private ;
|
||||
IN: math.integers
|
||||
|
||||
ARTICLE: "integers" "Integers"
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
USING: kernel math namespaces prettyprint math.functions
|
||||
USING: kernel math namespaces prettyprint
|
||||
math.private continuations tools.test sequences ;
|
||||
IN: temporary
|
||||
|
||||
|
@ -57,15 +57,6 @@ IN: temporary
|
|||
[ 134217728 dup + dup + dup + dup + dup + dup + unparse ]
|
||||
unit-test
|
||||
|
||||
[ t ] [ 0 0 ^ fp-nan? ] unit-test
|
||||
[ 1 ] [ 10 0 ^ ] unit-test
|
||||
[ 1/8 ] [ 1/2 3 ^ ] unit-test
|
||||
[ 1/8 ] [ 2 -3 ^ ] unit-test
|
||||
[ t ] [ 1 100 shift 2 100 ^ = ] unit-test
|
||||
|
||||
[ t ] [ 256 power-of-2? ] unit-test
|
||||
[ f ] [ 123 power-of-2? ] unit-test
|
||||
|
||||
[ 7 ] [ 255 log2 ] unit-test
|
||||
[ 8 ] [ 256 log2 ] unit-test
|
||||
[ 8 ] [ 257 log2 ] unit-test
|
||||
|
@ -100,11 +91,6 @@ unit-test
|
|||
[ f ] [ BIN: -1101 >bignum 3 bit? ] unit-test
|
||||
[ t ] [ BIN: -1101 >bignum 4 bit? ] unit-test
|
||||
|
||||
[ 1 ] [ 7/8 ceiling ] unit-test
|
||||
[ 2 ] [ 3/2 ceiling ] unit-test
|
||||
[ 0 ] [ -7/8 ceiling ] unit-test
|
||||
[ -1 ] [ -3/2 ceiling ] unit-test
|
||||
|
||||
[ 2 ] [ 0 next-power-of-2 ] unit-test
|
||||
[ 2 ] [ 1 next-power-of-2 ] unit-test
|
||||
[ 2 ] [ 2 next-power-of-2 ] unit-test
|
||||
|
@ -115,7 +101,6 @@ unit-test
|
|||
[ 268435456 ] [ -268435456 >fixnum -1 / ] unit-test
|
||||
[ 268435456 ] [ -268435456 >fixnum -1 /i ] unit-test
|
||||
[ 268435456 0 ] [ -268435456 >fixnum -1 /mod ] unit-test
|
||||
[ 1/268435456 ] [ -1 -268435456 >fixnum / ] unit-test
|
||||
[ 0 ] [ -1 -268435456 >fixnum /i ] unit-test
|
||||
[ 0 -1 ] [ -1 -268435456 >fixnum /mod ] unit-test
|
||||
[ 14355 ] [ 1591517158873146351817850880000000 32769 mod ] unit-test
|
||||
|
|
|
@ -4,9 +4,6 @@ USING: kernel kernel.private sequences
|
|||
sequences.private math math.private combinators ;
|
||||
IN: math.integers.private
|
||||
|
||||
M: integer hashcode* nip >fixnum ;
|
||||
M: integer <=> - ;
|
||||
|
||||
M: integer numerator ;
|
||||
M: integer denominator drop 1 ;
|
||||
|
||||
|
|
|
@ -39,11 +39,11 @@ IN: temporary
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
1 2 [a,b] -1/2 1/2 [a,b] interval* -1 1 [a,b] =
|
||||
1 2 [a,b] -0.5 0.5 [a,b] interval* -1 1 [a,b] =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
1 2 [a,b] -1/2 1/2 (a,b] interval* -1 1 (a,b] =
|
||||
1 2 [a,b] -0.5 0.5 (a,b] interval* -1 1 (a,b] =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
|
@ -77,7 +77,7 @@ IN: temporary
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
1/2 0 1 (a,b) interval-contains?
|
||||
0.5 0 1 (a,b) interval-contains?
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
|
@ -89,7 +89,7 @@ IN: temporary
|
|||
[ f ] [ -1 1 (a,b) 0 1 (a,b) interval/ ] unit-test
|
||||
|
||||
[ t ] [
|
||||
-1 1 (a,b) 1/2 1 (a,b) interval/ -2 2 (a,b) =
|
||||
-1 1 (a,b) 0.5 1 (a,b) interval/ -2 2 (a,b) =
|
||||
] unit-test
|
||||
|
||||
[ t ] [ 0 5 [a,b] 5 interval<= ] unit-test
|
||||
|
@ -125,12 +125,15 @@ IN: temporary
|
|||
{ + interval+ }
|
||||
{ - interval- }
|
||||
{ * interval* }
|
||||
{ / interval/ }
|
||||
{ /i interval/i }
|
||||
{ shift interval-shift }
|
||||
{ min interval-min }
|
||||
{ max interval-max }
|
||||
} random ;
|
||||
}
|
||||
"math.ratios.private" vocab [
|
||||
{ / interval/ } add
|
||||
] when
|
||||
random ;
|
||||
|
||||
: interval-test
|
||||
random-interval random-interval random-op
|
||||
|
|
|
@ -243,26 +243,6 @@ HELP: 1-
|
|||
{ $code "1-" "1 -" }
|
||||
} ;
|
||||
|
||||
HELP: truncate
|
||||
{ $values { "x" real } { "y" "a whole real number" } }
|
||||
{ $description "Outputs the number that results from subtracting the fractional component of " { $snippet "x" } "." }
|
||||
{ $notes "The result is not necessarily an integer." } ;
|
||||
|
||||
HELP: floor
|
||||
{ $values { "x" real } { "y" "a whole real number" } }
|
||||
{ $description "Outputs the greatest whole number smaller than or equal to " { $snippet "x" } "." }
|
||||
{ $notes "The result is not necessarily an integer." } ;
|
||||
|
||||
HELP: ceiling
|
||||
{ $values { "x" real } { "y" "a whole real number" } }
|
||||
{ $description "Outputs the least whole number greater than or equal to " { $snippet "x" } "." }
|
||||
{ $notes "The result is not necessarily an integer." } ;
|
||||
|
||||
HELP: round
|
||||
{ $values { "x" real } { "y" "a whole real number" } }
|
||||
{ $description "Outputs the whole number closest to " { $snippet "x" } "." }
|
||||
{ $notes "The result is not necessarily an integer." } ;
|
||||
|
||||
HELP: sq
|
||||
{ $values { "x" number } { "y" number } }
|
||||
{ $description "Multiplies a number by itself." } ;
|
||||
|
@ -351,22 +331,9 @@ HELP: imaginary ( z -- y )
|
|||
{ $values { "z" number } { "y" real } }
|
||||
{ $description "Outputs the imaginary part of a complex number. This outputs zero for real numbers." } ;
|
||||
|
||||
HELP: (rect>)
|
||||
{ $values { "x" real } { "y" real } { "z" number } }
|
||||
{ $description "Creates a complex number from real and imaginary components." }
|
||||
{ $warning "This word does not check that the arguments are real numbers, which can have undefined consequences. Use the " { $link rect> } " word instead." } ;
|
||||
|
||||
HELP: number
|
||||
{ $class-description "The class of numbers." } ;
|
||||
|
||||
HELP: rect>
|
||||
{ $values { "x" real } { "y" real } { "z" number } }
|
||||
{ $description "Creates a complex number from real and imaginary components." } ;
|
||||
|
||||
HELP: >rect
|
||||
{ $values { "z" number } { "x" real } { "y" real } }
|
||||
{ $description "Extracts the real and imaginary components of a complex number." } ;
|
||||
|
||||
HELP: next-power-of-2
|
||||
{ $values { "m" "a non-negative integer" } { "n" "an integer" } }
|
||||
{ $description "Outputs the smallest power of 2 greater than " { $snippet "m" } ". The output value is always at least 1." } ;
|
||||
|
|
|
@ -8,6 +8,7 @@ GENERIC: >bignum ( x -- y ) foldable
|
|||
GENERIC: >float ( x -- y ) foldable
|
||||
|
||||
MATH: number= ( x y -- ? ) foldable
|
||||
|
||||
M: object number= 2drop f ;
|
||||
|
||||
MATH: < ( x y -- ? ) foldable
|
||||
|
@ -48,8 +49,6 @@ GENERIC: zero? ( x -- ? ) foldable
|
|||
|
||||
M: object zero? drop f ;
|
||||
|
||||
GENERIC: sqrt ( x -- y ) foldable
|
||||
|
||||
: 1+ ( x -- y ) 1 + ; foldable
|
||||
: 1- ( x -- y ) 1 - ; foldable
|
||||
: 2/ ( x -- y ) -1 shift ; foldable
|
||||
|
@ -66,15 +65,8 @@ GENERIC: sqrt ( x -- y ) foldable
|
|||
pick >= [ >= ] [ 2drop f ] if ; inline
|
||||
|
||||
: rem ( x y -- z ) tuck mod over + swap mod ; foldable
|
||||
|
||||
: sgn ( x -- n ) dup 0 < -1 0 ? swap 0 > 1 0 ? bitor ; foldable
|
||||
: truncate ( x -- y ) dup 1 mod - ; inline
|
||||
: round ( x -- y ) dup sgn 2 / + truncate ; inline
|
||||
|
||||
: floor ( x -- y )
|
||||
dup 1 mod dup zero?
|
||||
[ drop ] [ dup 0 < [ - 1- ] [ - ] if ] if ; foldable
|
||||
|
||||
: ceiling ( x -- y ) neg floor neg ; foldable
|
||||
|
||||
: [-] ( x y -- z ) - 0 max ; inline
|
||||
|
||||
|
@ -84,9 +76,6 @@ GENERIC: sqrt ( x -- y ) foldable
|
|||
|
||||
: odd? ( n -- ? ) 1 bitand 1 number= ;
|
||||
|
||||
: >fraction ( a/b -- a b )
|
||||
dup numerator swap denominator ; inline
|
||||
|
||||
UNION: integer fixnum bignum ;
|
||||
|
||||
UNION: rational integer ratio ;
|
||||
|
@ -95,6 +84,12 @@ UNION: real rational float ;
|
|||
|
||||
UNION: number real complex ;
|
||||
|
||||
M: number equal? number= ;
|
||||
|
||||
M: real hashcode* nip >fixnum ;
|
||||
|
||||
M: real <=> - ;
|
||||
|
||||
GENERIC: fp-nan? ( x -- ? )
|
||||
|
||||
M: object fp-nan?
|
||||
|
@ -104,25 +99,6 @@ M: float fp-nan?
|
|||
double>bits -51 shift BIN: 111111111111 [ bitand ] keep
|
||||
number= ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (rect>) ( x y -- z )
|
||||
dup zero? [ drop ] [ <complex> ] if ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: rect> ( x y -- z )
|
||||
over real? over real? and [
|
||||
(rect>)
|
||||
] [
|
||||
"Complex number must have real components" throw
|
||||
] if ; inline
|
||||
|
||||
: >rect ( z -- x y ) dup real swap imaginary ; inline
|
||||
|
||||
: >float-rect ( z -- x y )
|
||||
>rect swap >float swap >float ; inline
|
||||
|
||||
: (next-power-of-2) ( i n -- n )
|
||||
2dup >= [
|
||||
drop
|
||||
|
@ -132,6 +108,8 @@ PRIVATE>
|
|||
|
||||
: next-power-of-2 ( m -- n ) 2 swap (next-power-of-2) ; foldable
|
||||
|
||||
: align ( m w -- n ) 1- [ + ] keep bitnot bitand ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: iterate-prep 0 -rot ; inline
|
||||
|
|
|
@ -77,22 +77,6 @@ unit-test
|
|||
[ "-101.0e-2" string>number number>string ]
|
||||
unit-test
|
||||
|
||||
[ 5 ]
|
||||
[ "10/2" string>number ]
|
||||
unit-test
|
||||
|
||||
[ -5 ]
|
||||
[ "-10/2" string>number ]
|
||||
unit-test
|
||||
|
||||
[ -5 ]
|
||||
[ "10/-2" string>number ]
|
||||
unit-test
|
||||
|
||||
[ 5 ]
|
||||
[ "-10/-2" string>number ]
|
||||
unit-test
|
||||
|
||||
[ 5.0 ]
|
||||
[ "10.0/2" string>number ]
|
||||
unit-test
|
||||
|
@ -105,10 +89,6 @@ unit-test
|
|||
[ "e/2" string>number ]
|
||||
unit-test
|
||||
|
||||
[ "33/100" ]
|
||||
[ "66/200" string>number number>string ]
|
||||
unit-test
|
||||
|
||||
[ f ] [ "12" bin> ] unit-test
|
||||
[ f ] [ "fdsf" bin> ] unit-test
|
||||
[ 3 ] [ "11" bin> ] unit-test
|
||||
|
|
|
@ -6,7 +6,7 @@ inference.class kernel assocs math math.private kernel.private
|
|||
sequences words parser vectors strings sbufs io namespaces
|
||||
assocs quotations sequences.private io.binary io.crc32
|
||||
io.buffers io.streams.string layouts splitting math.intervals
|
||||
math.floats.private math.vectors tuples tuples.private classes
|
||||
math.floats.private tuples tuples.private classes
|
||||
optimizer.def-use optimizer.backend optimizer.pattern-match
|
||||
float-arrays combinators.private ;
|
||||
|
||||
|
@ -102,20 +102,6 @@ float-arrays combinators.private ;
|
|||
{ number number } "specializer" set-word-prop
|
||||
] each
|
||||
|
||||
{ vneg norm-sq norm normalize } [
|
||||
{ { float-array array } } "specializer" set-word-prop
|
||||
] each
|
||||
|
||||
\ n*v { * { float-array array } } "specializer" set-word-prop
|
||||
\ v*n { { float-array array } * } "specializer" set-word-prop
|
||||
\ n/v { * { float-array array } } "specializer" set-word-prop
|
||||
\ v/n { { float-array array } * } "specializer" set-word-prop
|
||||
|
||||
{ v+ v- v* v/ vmax vmin v. } [
|
||||
{ { float-array array } { float-array array } }
|
||||
"specializer" set-word-prop
|
||||
] each
|
||||
|
||||
{ first first2 first3 first4 }
|
||||
[ { array } "specializer" set-word-prop ] each
|
||||
|
||||
|
|
|
@ -5,7 +5,7 @@ USING: alien arrays generic hashtables kernel assocs math
|
|||
math.private kernel.private sequences words parser
|
||||
inference.class inference.dataflow vectors strings sbufs io
|
||||
namespaces assocs quotations math.intervals sequences.private
|
||||
math.libm combinators splitting layouts math.parser classes
|
||||
combinators splitting layouts math.parser classes
|
||||
generic.math optimizer.pattern-match optimizer.backend
|
||||
optimizer.def-use generic.standard ;
|
||||
|
||||
|
@ -439,17 +439,3 @@ most-negative-fixnum most-positive-fixnum [a,b]
|
|||
[ splice-quot ] curry ,
|
||||
] { } make 1array define-optimizers
|
||||
] assoc-each
|
||||
|
||||
! This will go away when we have cross-word type inference
|
||||
{
|
||||
facos fasin fatan
|
||||
fcos fexp fcosh flog fpow
|
||||
fsin fsinh fsqrt
|
||||
} [
|
||||
[ drop { float } f ]
|
||||
"output-classes" set-word-prop
|
||||
] each
|
||||
|
||||
\ fatan2
|
||||
[ drop { float float } f ]
|
||||
"output-classes" set-word-prop
|
||||
|
|
|
@ -155,7 +155,6 @@ GENERIC: >pprint-sequence ( obj -- seq )
|
|||
|
||||
M: object >pprint-sequence ;
|
||||
|
||||
M: complex >pprint-sequence >rect 2array ;
|
||||
M: hashtable >pprint-sequence >alist ;
|
||||
M: tuple >pprint-sequence tuple>array ;
|
||||
M: wrapper >pprint-sequence wrapped 1array ;
|
||||
|
|
|
@ -7,7 +7,6 @@ IN: temporary
|
|||
|
||||
[ "4" ] [ 4 unparse ] unit-test
|
||||
[ "1.0" ] [ 1.0 unparse ] unit-test
|
||||
[ "C{ 1/2 2/3 }" ] [ C{ 1/2 2/3 } unparse ] unit-test
|
||||
[ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
|
||||
|
||||
[ "+" ] [ \ + unparse ] unit-test
|
||||
|
|
|
@ -943,3 +943,21 @@ HELP: unclip
|
|||
HELP: unclip-slice
|
||||
{ $values { "seq" sequence } { "rest" slice } { "first" object } }
|
||||
{ $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first. Unlike " { $link unclip } ", this word does not make a copy of the input sequence, and runs in constant time." } ;
|
||||
|
||||
HELP: sum
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a number" } }
|
||||
{ $description "Outputs the sum of all elements of " { $snippet "seq" } ". Outputs zero given an empty sequence." } ;
|
||||
|
||||
HELP: product
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a number" } }
|
||||
{ $description "Outputs the product of all elements of " { $snippet "seq" } ". Outputs one given an empty sequence." } ;
|
||||
|
||||
HELP: infimum
|
||||
{ $values { "seq" "a sequence of real numbers" } { "n" "a number" } }
|
||||
{ $description "Outputs the least element of " { $snippet "seq" } "." }
|
||||
{ $errors "Throws an error if the sequence is empty." } ;
|
||||
|
||||
HELP: supremum
|
||||
{ $values { "seq" "a sequence of real numbers" } { "n" "a number" } }
|
||||
{ $description "Outputs the greatest element of " { $snippet "seq" } "." }
|
||||
{ $errors "Throws an error if the sequence is empty." } ;
|
||||
|
|
|
@ -655,3 +655,9 @@ PRIVATE>
|
|||
|
||||
: trim ( seq quot -- newseq )
|
||||
[ ltrim ] keep rtrim ; inline
|
||||
|
||||
: sum ( seq -- n ) 0 [ + ] reduce ;
|
||||
: product ( seq -- n ) 1 [ * ] reduce ;
|
||||
|
||||
: infimum ( seq -- n ) dup first [ min ] reduce ;
|
||||
: supremum ( seq -- n ) dup first [ max ] reduce ;
|
||||
|
|
|
@ -77,7 +77,6 @@ IN: bootstrap.syntax
|
|||
"?{" [ \ } [ >bit-array ] parse-literal ] define-syntax
|
||||
"F{" [ \ } [ >float-array ] parse-literal ] define-syntax
|
||||
"H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
|
||||
"C{" [ \ } [ first2 rect> ] parse-literal ] define-syntax
|
||||
"T{" [ \ } [ >tuple ] parse-literal ] define-syntax
|
||||
"W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax
|
||||
|
||||
|
@ -165,5 +164,3 @@ IN: bootstrap.syntax
|
|||
] define-syntax
|
||||
|
||||
"MAIN:" [ scan-word in get vocab set-vocab-main ] define-syntax
|
||||
|
||||
"bootstrap.syntax" forget-vocab
|
||||
|
|
|
@ -8,6 +8,6 @@ IN: temporary
|
|||
[ ] [ [ "Errors, errors" throw ] in-thread ] unit-test
|
||||
yield
|
||||
|
||||
[ ] [ 1/2 sleep ] unit-test
|
||||
[ ] [ 1 2 / sleep ] unit-test
|
||||
[ ] [ 0.3 sleep ] unit-test
|
||||
[ "hey" sleep ] unit-test-fails
|
||||
|
|
|
@ -10,7 +10,7 @@ IN: temporary
|
|||
|
||||
[ -3 V{ } nth ] unit-test-fails
|
||||
[ 3 V{ } nth ] unit-test-fails
|
||||
[ 3 C{ 1 2 } nth ] unit-test-fails
|
||||
[ 3 54.3 nth ] unit-test-fails
|
||||
|
||||
[ "hey" [ 1 2 ] set-length ] unit-test-fails
|
||||
[ "hey" V{ 1 2 } set-length ] unit-test-fails
|
||||
|
|
5
core/math/complex/complex-tests.factor → extra/math/complex/complex-tests.factor
Normal file → Executable file
5
core/math/complex/complex-tests.factor → extra/math/complex/complex-tests.factor
Normal file → Executable file
|
@ -1,4 +1,5 @@
|
|||
USING: kernel math math.constants math.functions tools.test ;
|
||||
USING: kernel math math.constants math.functions tools.test
|
||||
prettyprint ;
|
||||
IN: temporary
|
||||
|
||||
[ 1 C{ 0 1 } rect> ] unit-test-fails
|
||||
|
@ -63,3 +64,5 @@ IN: temporary
|
|||
[ ] [ C{ 1 4 } tan drop ] unit-test
|
||||
[ ] [ C{ 1 4 } coth drop ] unit-test
|
||||
[ ] [ C{ 1 4 } cot drop ] unit-test
|
||||
|
||||
[ "C{ 1/2 2/3 }" ] [ C{ 1/2 2/3 } unparse ] unit-test
|
11
core/math/complex/complex.factor → extra/math/complex/complex.factor
Normal file → Executable file
11
core/math/complex/complex.factor → extra/math/complex/complex.factor
Normal file → Executable file
|
@ -2,13 +2,12 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: math.complex.private
|
||||
USING: kernel kernel.private math math.private
|
||||
math.libm math.functions ;
|
||||
math.libm math.functions prettyprint.backend arrays
|
||||
math.functions.private sequences parser ;
|
||||
|
||||
M: real real ;
|
||||
M: real imaginary drop 0 ;
|
||||
|
||||
M: number equal? number= ;
|
||||
|
||||
M: complex absq >rect [ sq ] 2apply + ;
|
||||
|
||||
: 2>rect ( x y -- xr yr xi yi )
|
||||
|
@ -34,3 +33,9 @@ M: complex abs absq >float fsqrt ;
|
|||
M: complex sqrt >polar swap fsqrt swap 2.0 / polar> ;
|
||||
|
||||
M: complex hashcode* nip >rect >fixnum swap >fixnum bitxor ;
|
||||
|
||||
M: complex >pprint-sequence >rect 2array ;
|
||||
|
||||
IN: syntax
|
||||
|
||||
: C{ \ } [ first2 rect> ] parse-literal ; parsing
|
2
core/math/constants/constants.factor → extra/math/constants/constants.factor
Normal file → Executable file
2
core/math/constants/constants.factor → extra/math/constants/constants.factor
Normal file → Executable file
|
@ -2,8 +2,6 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: math.constants
|
||||
|
||||
: i ( -- i ) C{ 0 1 } ; inline
|
||||
: -i ( -- -i ) C{ 0 -1 } ; inline
|
||||
: e ( -- e ) 2.7182818284590452354 ; inline
|
||||
: pi ( -- pi ) 3.14159265358979323846 ; inline
|
||||
: epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline
|
34
core/math/functions/functions-docs.factor → extra/math/functions/functions-docs.factor
Normal file → Executable file
34
core/math/functions/functions-docs.factor → extra/math/functions/functions-docs.factor
Normal file → Executable file
|
@ -94,6 +94,19 @@ ARTICLE: "math-functions" "Mathematical functions"
|
|||
|
||||
ABOUT: "math-functions"
|
||||
|
||||
HELP: (rect>)
|
||||
{ $values { "x" real } { "y" real } { "z" number } }
|
||||
{ $description "Creates a complex number from real and imaginary components." }
|
||||
{ $warning "This word does not check that the arguments are real numbers, which can have undefined consequences. Use the " { $link rect> } " word instead." } ;
|
||||
|
||||
HELP: rect>
|
||||
{ $values { "x" real } { "y" real } { "z" number } }
|
||||
{ $description "Creates a complex number from real and imaginary components." } ;
|
||||
|
||||
HELP: >rect
|
||||
{ $values { "z" number } { "x" real } { "y" real } }
|
||||
{ $description "Extracts the real and imaginary components of a complex number." } ;
|
||||
|
||||
HELP: power-of-2?
|
||||
{ $values { "n" integer } { "?" "a boolean" } }
|
||||
{ $description "Tests if " { $snippet "n" } " is a power of 2." } ;
|
||||
|
@ -281,3 +294,24 @@ HELP: ~
|
|||
{ { $snippet "epsilon" } " is negative: relative distance test." }
|
||||
}
|
||||
} ;
|
||||
|
||||
|
||||
HELP: truncate
|
||||
{ $values { "x" real } { "y" "a whole real number" } }
|
||||
{ $description "Outputs the number that results from subtracting the fractional component of " { $snippet "x" } "." }
|
||||
{ $notes "The result is not necessarily an integer." } ;
|
||||
|
||||
HELP: floor
|
||||
{ $values { "x" real } { "y" "a whole real number" } }
|
||||
{ $description "Outputs the greatest whole number smaller than or equal to " { $snippet "x" } "." }
|
||||
{ $notes "The result is not necessarily an integer." } ;
|
||||
|
||||
HELP: ceiling
|
||||
{ $values { "x" real } { "y" "a whole real number" } }
|
||||
{ $description "Outputs the least whole number greater than or equal to " { $snippet "x" } "." }
|
||||
{ $notes "The result is not necessarily an integer." } ;
|
||||
|
||||
HELP: round
|
||||
{ $values { "x" real } { "y" "a whole real number" } }
|
||||
{ $description "Outputs the whole number closest to " { $snippet "x" } "." }
|
||||
{ $notes "The result is not necessarily an integer." } ;
|
31
core/math/functions/functions-tests.factor → extra/math/functions/functions-tests.factor
Normal file → Executable file
31
core/math/functions/functions-tests.factor → extra/math/functions/functions-tests.factor
Normal file → Executable file
|
@ -74,3 +74,34 @@ IN: temporary
|
|||
[ 78572682077 ] [ 234829342 342389423843 mod-inv ] unit-test
|
||||
|
||||
[ 2 10 mod-inv ] unit-test-fails
|
||||
|
||||
[ t ] [ 0 0 ^ fp-nan? ] unit-test
|
||||
[ 1 ] [ 10 0 ^ ] unit-test
|
||||
[ 1/8 ] [ 1/2 3 ^ ] unit-test
|
||||
[ 1/8 ] [ 2 -3 ^ ] unit-test
|
||||
[ t ] [ 1 100 shift 2 100 ^ = ] unit-test
|
||||
|
||||
[ t ] [ 256 power-of-2? ] unit-test
|
||||
[ f ] [ 123 power-of-2? ] unit-test
|
||||
|
||||
[ 1 ] [ 7/8 ceiling ] unit-test
|
||||
[ 2 ] [ 3/2 ceiling ] unit-test
|
||||
[ 0 ] [ -7/8 ceiling ] unit-test
|
||||
[ -1 ] [ -3/2 ceiling ] unit-test
|
||||
|
||||
[ 4.0 ] [ 4.5 truncate ] unit-test
|
||||
[ 4.0 ] [ 4.5 floor ] unit-test
|
||||
[ 5.0 ] [ 4.5 ceiling ] unit-test
|
||||
|
||||
[ -4.0 ] [ -4.5 truncate ] unit-test
|
||||
[ -5.0 ] [ -4.5 floor ] unit-test
|
||||
[ -4.0 ] [ -4.5 ceiling ] unit-test
|
||||
|
||||
[ -4.0 ] [ -4.0 truncate ] unit-test
|
||||
[ -4.0 ] [ -4.0 floor ] unit-test
|
||||
[ -4.0 ] [ -4.0 ceiling ] unit-test
|
||||
|
||||
[ -5.0 ] [ -4.5 round ] unit-test
|
||||
[ -4.0 ] [ -4.4 round ] unit-test
|
||||
[ 5.0 ] [ 4.5 round ] unit-test
|
||||
[ 4.0 ] [ 4.4 round ] unit-test
|
49
core/math/functions/functions.factor → extra/math/functions/functions.factor
Normal file → Executable file
49
core/math/functions/functions.factor → extra/math/functions/functions.factor
Normal file → Executable file
|
@ -1,8 +1,28 @@
|
|||
! Copyright (C) 2004, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math kernel math.constants math.libm combinators ;
|
||||
USING: math kernel math.constants math.private
|
||||
math.libm combinators ;
|
||||
IN: math.functions
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (rect>) ( x y -- z )
|
||||
dup zero? [ drop ] [ <complex> ] if ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: rect> ( x y -- z )
|
||||
over real? over real? and [
|
||||
(rect>)
|
||||
] [
|
||||
"Complex number must have real components" throw
|
||||
] if ; inline
|
||||
|
||||
GENERIC: sqrt ( x -- y ) foldable
|
||||
|
||||
M: real sqrt
|
||||
>float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
|
||||
|
||||
: each-bit ( n quot -- )
|
||||
over 0 number= pick -1 number= or [
|
||||
2drop
|
||||
|
@ -62,8 +82,12 @@ M: integer (^)
|
|||
|
||||
GENERIC: abs ( x -- y ) foldable
|
||||
|
||||
M: real abs dup 0 < [ neg ] when ;
|
||||
|
||||
GENERIC: absq ( x -- y ) foldable
|
||||
|
||||
M: real absq sq ;
|
||||
|
||||
: ~abs ( x y epsilon -- ? )
|
||||
>r - abs r> < ;
|
||||
|
||||
|
@ -81,10 +105,13 @@ GENERIC: absq ( x -- y ) foldable
|
|||
: power-of-2? ( n -- ? )
|
||||
dup 0 < [ drop f ] [ dup 1- bitand zero? ] if ; foldable
|
||||
|
||||
: align ( m w -- n ) 1- [ + ] keep bitnot bitand ; inline
|
||||
: >rect ( z -- x y ) dup real swap imaginary ; inline
|
||||
|
||||
: conjugate ( z -- z* ) >rect neg rect> ; inline
|
||||
|
||||
: >float-rect ( z -- x y )
|
||||
>rect swap >float swap >float ; inline
|
||||
|
||||
: arg ( z -- arg ) >float-rect swap fatan2 ; inline
|
||||
|
||||
: >polar ( z -- abs arg )
|
||||
|
@ -160,18 +187,32 @@ M: number (^)
|
|||
: [-1,1]? ( x -- ? )
|
||||
dup complex? [ drop f ] [ abs 1 <= ] if ; inline
|
||||
|
||||
: i* ( x -- y ) >rect neg swap rect> ;
|
||||
|
||||
: -i* ( x -- y ) >rect swap neg rect> ;
|
||||
|
||||
: asin ( x -- y )
|
||||
dup [-1,1]? [ >float fasin ] [ i * asinh -i * ] if ; inline
|
||||
dup [-1,1]? [ >float fasin ] [ i* asinh -i* ] if ; inline
|
||||
|
||||
: acos ( x -- y )
|
||||
dup [-1,1]? [ >float facos ] [ asin pi 2 / swap - ] if ;
|
||||
inline
|
||||
|
||||
: atan ( x -- y )
|
||||
dup [-1,1]? [ >float fatan ] [ i * atanh i * ] if ; inline
|
||||
dup [-1,1]? [ >float fatan ] [ i* atanh i* ] if ; inline
|
||||
|
||||
: asec ( x -- y ) recip acos ; inline
|
||||
|
||||
: acosec ( x -- y ) recip asin ; inline
|
||||
|
||||
: acot ( x -- y ) recip atan ; inline
|
||||
|
||||
: truncate ( x -- y ) dup 1 mod - ; inline
|
||||
|
||||
: round ( x -- y ) dup sgn 2 / + truncate ; inline
|
||||
|
||||
: floor ( x -- y )
|
||||
dup 1 mod dup zero?
|
||||
[ drop ] [ dup 0 < [ - 1- ] [ - ] if ] if ; foldable
|
||||
|
||||
: ceiling ( x -- y ) neg floor neg ; foldable
|
26
core/math/ratios/ratios-tests.factor → extra/math/ratios/ratios-tests.factor
Normal file → Executable file
26
core/math/ratios/ratios-tests.factor → extra/math/ratios/ratios-tests.factor
Normal file → Executable file
|
@ -1,4 +1,4 @@
|
|||
USING: kernel math tools.test ;
|
||||
USING: kernel math math.parser tools.test ;
|
||||
IN: temporary
|
||||
|
||||
[ 1 2 ] [ 1/2 >fraction ] unit-test
|
||||
|
@ -79,3 +79,27 @@ unit-test
|
|||
|
||||
[ -1/2 ] [ 1/2 1- ] unit-test
|
||||
[ 3/2 ] [ 1/2 1+ ] unit-test
|
||||
|
||||
[ 1 ] [ 0.5 1/2 + ] unit-test
|
||||
[ 1 ] [ 1/2 0.5 + ] unit-test
|
||||
|
||||
[ 1/268435456 ] [ -1 -268435456 >fixnum / ] unit-test
|
||||
|
||||
[ 5 ]
|
||||
[ "10/2" string>number ]
|
||||
unit-test
|
||||
|
||||
[ -5 ]
|
||||
[ "-10/2" string>number ]
|
||||
unit-test
|
||||
|
||||
[ -5 ]
|
||||
[ "10/-2" string>number ]
|
||||
unit-test
|
||||
|
||||
[ 5 ]
|
||||
[ "-10/-2" string>number ]
|
||||
unit-test
|
||||
[ "33/100" ]
|
||||
[ "66/200" string>number number>string ]
|
||||
unit-test
|
|
@ -1,12 +1,27 @@
|
|||
! Copyright (C) 2004, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: math.ratios.private
|
||||
USING: kernel kernel.private math math.functions
|
||||
math.private ;
|
||||
IN: math.ratios
|
||||
USING: kernel kernel.private math math.functions math.private ;
|
||||
|
||||
: >fraction ( a/b -- a b )
|
||||
dup numerator swap denominator ; inline
|
||||
|
||||
: 2>fraction ( a/b c/d -- a c b d )
|
||||
[ >fraction ] 2apply swapd ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: fraction> ( a b -- a/b )
|
||||
dup 1 number= [ drop ] [ <ratio> ] if ; inline
|
||||
|
||||
: scale ( a/b c/d -- a*d b*c )
|
||||
2>fraction >r * swap r> * swap ; inline
|
||||
|
||||
: ratio+d ( a/b c/d -- b*d )
|
||||
denominator swap denominator * ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: integer /
|
||||
dup zero? [
|
||||
/i
|
||||
|
@ -15,15 +30,6 @@ M: integer /
|
|||
2dup gcd nip tuck /i >r /i r> fraction>
|
||||
] if ;
|
||||
|
||||
: 2>fraction ( a/b c/d -- a c b d )
|
||||
[ >fraction ] 2apply swapd ; inline
|
||||
|
||||
: scale ( a/b c/d -- a*d b*c )
|
||||
2>fraction >r * swap r> * swap ; inline
|
||||
|
||||
: ratio+d ( a/b c/d -- b*d )
|
||||
denominator swap denominator * ; inline
|
||||
|
||||
M: ratio number=
|
||||
2>fraction number= [ number= ] [ 2drop f ] if ;
|
||||
|
25
core/math/vectors/vectors-docs.factor → extra/math/vectors/vectors-docs.factor
Normal file → Executable file
25
core/math/vectors/vectors-docs.factor → extra/math/vectors/vectors-docs.factor
Normal file → Executable file
|
@ -21,12 +21,7 @@ $nl
|
|||
{ $subsection v. }
|
||||
{ $subsection norm }
|
||||
{ $subsection norm-sq }
|
||||
{ $subsection normalize }
|
||||
"Combining all the values in a vector into a scalar with " { $link reduce } ":"
|
||||
{ $subsection sum }
|
||||
{ $subsection product }
|
||||
{ $subsection supremum }
|
||||
{ $subsection infimum } ;
|
||||
{ $subsection normalize } ;
|
||||
|
||||
ABOUT: "math-vectors"
|
||||
|
||||
|
@ -105,21 +100,3 @@ HELP: set-axis
|
|||
{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "axis" "a sequence of 0/1" } { "w" "a sequence of numbers" } }
|
||||
{ $description "Using " { $snippet "w" } " as a template, creates a new sequence containing corresponding elements from " { $snippet "u" } " in place of 0, and corresponding elements from " { $snippet "v" } " in place of 1." }
|
||||
{ $examples { $example "USE: math.vectors" "{ 1 2 3 } { 4 5 6 } { 0 1 0 } set-axis ." "{ 1 5 3 }" } } ;
|
||||
|
||||
HELP: sum
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a number" } }
|
||||
{ $description "Outputs the sum of all elements of " { $snippet "seq" } ". Outputs zero given an empty sequence." } ;
|
||||
|
||||
HELP: product
|
||||
{ $values { "seq" "a sequence of numbers" } { "n" "a number" } }
|
||||
{ $description "Outputs the product of all elements of " { $snippet "seq" } ". Outputs one given an empty sequence." } ;
|
||||
|
||||
HELP: infimum
|
||||
{ $values { "seq" "a sequence of real numbers" } { "n" "a number" } }
|
||||
{ $description "Outputs the least element of " { $snippet "seq" } "." }
|
||||
{ $errors "Throws an error if the sequence is empty." } ;
|
||||
|
||||
HELP: supremum
|
||||
{ $values { "seq" "a sequence of real numbers" } { "n" "a number" } }
|
||||
{ $description "Outputs the greatest element of " { $snippet "seq" } "." }
|
||||
{ $errors "Throws an error if the sequence is empty." } ;
|
23
core/math/vectors/vectors.factor → extra/math/vectors/vectors.factor
Normal file → Executable file
23
core/math/vectors/vectors.factor → extra/math/vectors/vectors.factor
Normal file → Executable file
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2005, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel sequences math math.functions ;
|
||||
USING: arrays kernel sequences math math.functions hints
|
||||
float-arrays ;
|
||||
IN: math.vectors
|
||||
|
||||
: vneg ( u -- v ) [ neg ] map ;
|
||||
|
@ -26,8 +27,20 @@ IN: math.vectors
|
|||
: set-axis ( u v axis -- w )
|
||||
dup length [ >r zero? pick pick ? r> swap nth ] 2map 2nip ;
|
||||
|
||||
: sum ( seq -- n ) 0 [ + ] reduce ;
|
||||
: product ( seq -- n ) 1 [ * ] reduce ;
|
||||
HINTS: vneg { float-array array } ;
|
||||
HINTS: norm-sq { float-array array } ;
|
||||
HINTS: norm { float-array array } ;
|
||||
HINTS: normalize { float-array array } ;
|
||||
|
||||
: infimum ( seq -- n ) dup first [ min ] reduce ;
|
||||
: supremum ( seq -- n ) dup first [ max ] reduce ;
|
||||
HINTS: n*v * { float-array array } ;
|
||||
HINTS: v*n { float-array array } * ;
|
||||
HINTS: n/v * { float-array array } ;
|
||||
HINTS: v/n { float-array array } * ;
|
||||
|
||||
HINTS: v+ { float-array array } { float-array array } ;
|
||||
HINTS: v- { float-array array } { float-array array } ;
|
||||
HINTS: v* { float-array array } { float-array array } ;
|
||||
HINTS: v/ { float-array array } { float-array array } ;
|
||||
HINTS: vmax { float-array array } { float-array array } ;
|
||||
HINTS: vmin { float-array array } { float-array array } ;
|
||||
HINTS: v. { float-array array } { float-array array } ;
|
|
@ -4,7 +4,7 @@
|
|||
! mersenne twister based on
|
||||
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
|
||||
|
||||
USING: arrays kernel math math.functions namespaces sequences
|
||||
USING: arrays kernel math namespaces sequences
|
||||
system init alien.c-types ;
|
||||
IN: random
|
||||
|
||||
|
|
|
@ -48,7 +48,7 @@ DEF(void,c_to_factor,(CELL quot)):
|
|||
SAVE(r11,7)
|
||||
SAVE(r0,8) /* save quotation since we're about to mangle it */
|
||||
|
||||
mov r0,sp /* pass call stack pointer as an argument */
|
||||
sub r0,sp,#4 /* pass call stack pointer as an argument */
|
||||
bl MANGLE(save_callstack_bottom)
|
||||
|
||||
RESTORE(r0,8) /* restore quotation */
|
||||
|
@ -78,7 +78,7 @@ DEFER: foo
|
|||
And calls to non-primitives do not have this one-instruction prologue, so we
|
||||
set the XT of undefined words to this symbol. */
|
||||
DEF(void,undefined,(CELL word)):
|
||||
mov r1,sp
|
||||
sub r1,sp,#4
|
||||
b MANGLE(undefined_error)
|
||||
|
||||
DEF(void,dosym,(CELL word)):
|
||||
|
|
|
@ -20,12 +20,9 @@ typedef struct
|
|||
|
||||
/* Frame size in bytes */
|
||||
CELL size;
|
||||
|
||||
/* Return address */
|
||||
XT return_address;
|
||||
} F_STACK_FRAME;
|
||||
|
||||
#define FRAME_RETURN_ADDRESS(frame) (frame)->return_address
|
||||
#define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1)
|
||||
|
||||
void c_to_factor(CELL quot);
|
||||
void dosym(CELL word);
|
||||
|
|
20
vm/factor.c
20
vm/factor.c
|
@ -3,21 +3,27 @@
|
|||
void default_parameters(F_PARAMETERS *p)
|
||||
{
|
||||
p->image = NULL;
|
||||
p->ds_size = 128;
|
||||
p->rs_size = 128;
|
||||
|
||||
/* We make a wild guess here that if we're running on ARM, we don't
|
||||
have a lot of memory. */
|
||||
#ifdef FACTOR_ARM
|
||||
p->ds_size = 8 * CELLS;
|
||||
p->rs_size = 8 * CELLS;
|
||||
|
||||
p->gen_count = 2;
|
||||
p->code_size = 2 * CELLS;
|
||||
p->code_size = 4;
|
||||
p->young_size = 1;
|
||||
p->aging_size = 4;
|
||||
#else
|
||||
p->ds_size = 32 * CELLS;
|
||||
p->rs_size = 32 * CELLS;
|
||||
|
||||
p->gen_count = 3;
|
||||
p->code_size = 4 * CELLS;
|
||||
#endif
|
||||
|
||||
p->young_size = 2 * CELLS;
|
||||
p->aging_size = 4 * CELLS;
|
||||
#endif
|
||||
|
||||
p->secure_gc = false;
|
||||
p->fep = false;
|
||||
}
|
||||
|
@ -134,9 +140,7 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
|
|||
if(p.fep)
|
||||
factorbug();
|
||||
|
||||
printf("about to call boot\n");
|
||||
c_to_factor(userenv[BOOT_ENV]);
|
||||
printf("return from call boot\n");
|
||||
c_to_factor_toplevel(userenv[BOOT_ENV]);
|
||||
unnest_stacks();
|
||||
|
||||
for(i = 0; i < argc; i++)
|
||||
|
|
Loading…
Reference in New Issue