Rename real/imaginary slots of complex to real-part/imaginary-part to avoid clashing with the real class word; fix bug where redefining a generic as a class leaves the word in a weird state
parent
318b5f40c8
commit
9c1454ef68
|
@ -149,16 +149,16 @@ num-types get f <array> builtins set
|
|||
{
|
||||
{
|
||||
{ "real" "math" }
|
||||
"real"
|
||||
"real-part"
|
||||
1
|
||||
{ "real" "math" }
|
||||
{ "real-part" "math" }
|
||||
f
|
||||
}
|
||||
{
|
||||
{ "real" "math" }
|
||||
"imaginary"
|
||||
"imaginary-part"
|
||||
2
|
||||
{ "imaginary" "math" }
|
||||
{ "imaginary-part" "math" }
|
||||
f
|
||||
}
|
||||
} define-builtin
|
||||
|
|
|
@ -253,6 +253,7 @@ PRIVATE>
|
|||
|
||||
: (define-class) ( word props -- )
|
||||
over reset-class
|
||||
over reset-generic
|
||||
over define-symbol
|
||||
>r dup word-props r> union over set-word-props
|
||||
t "class" set-word-prop ;
|
||||
|
|
|
@ -5,8 +5,7 @@ IN: compiler
|
|||
ARTICLE: "compiler-usage" "Calling the optimizing compiler"
|
||||
"The main entry point to the optimizing compiler is a single word taking a word as input:"
|
||||
{ $subsection compile }
|
||||
"The optimizing compiler can also compile a single quotation:"
|
||||
{ $subsection compile-quot }
|
||||
"The optimizing compiler can also compile and call a single quotation:"
|
||||
{ $subsection compile-call }
|
||||
"Three utility words for bulk compilation:"
|
||||
{ $subsection compile-batch }
|
||||
|
@ -87,11 +86,6 @@ HELP: compile-vocabs
|
|||
{ $values { "seq" "a sequence of strings" } }
|
||||
{ $description "Compiles all words which have not been compiled yet from the given vocabularies." } ;
|
||||
|
||||
HELP: compile-quot
|
||||
{ $values { "quot" "a quotation" } { "word" "a new, uninterned word" } }
|
||||
{ $description "Creates a new uninterned word having the given quotation as its definition, and compiles it. The returned word can be passed to " { $link execute } "." }
|
||||
{ $errors "Throws an error if the stack effect of the quotation cannot be inferred." } ;
|
||||
|
||||
HELP: compile-call
|
||||
{ $values { "quot" "a quotation" } }
|
||||
{ $description "Compiles and runs a quotation." }
|
||||
|
|
|
@ -57,13 +57,13 @@ SYMBOL: compiler-hook
|
|||
: compile ( words -- )
|
||||
[ compiled? not ] subset recompile ;
|
||||
|
||||
: compile-quot ( quot -- word )
|
||||
: compile-call ( quot -- )
|
||||
H{ } clone changed-words [
|
||||
define-temp dup 1array recompile
|
||||
] with-variable ;
|
||||
] with-variable execute ;
|
||||
|
||||
: compile-call ( quot -- )
|
||||
compile-quot execute ;
|
||||
|
||||
: compile-all ( -- )
|
||||
: recompile-all ( -- )
|
||||
all-words recompile ;
|
||||
|
||||
: decompile ( word -- )
|
||||
f 2array 1array modify-code-heap ;
|
||||
|
|
|
@ -324,7 +324,8 @@ cell 8 = [
|
|||
] unit-test
|
||||
|
||||
[ 1 2 ] [
|
||||
1 2 [ <complex> ] compile-call dup real swap imaginary
|
||||
1 2 [ <complex> ] compile-call
|
||||
dup real-part swap imaginary-part
|
||||
] unit-test
|
||||
|
||||
[ 1 2 ] [
|
||||
|
|
|
@ -170,7 +170,9 @@ GENERIC: void-generic ( obj -- * )
|
|||
] unit-test
|
||||
|
||||
! compiling <tuple> with a non-literal class failed
|
||||
[ t ] [ [ <tuple> ] compile-quot word? ] unit-test
|
||||
: <tuple>-regression <tuple> ;
|
||||
|
||||
[ t ] [ \ <tuple>-regression compiled? ] unit-test
|
||||
|
||||
GENERIC: foozul
|
||||
M: reversed foozul ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
IN: temporary
|
||||
USING: compiler generator generator.registers
|
||||
generator.registers.private tools.test namespaces sequences
|
||||
words kernel math effects ;
|
||||
words kernel math effects definitions ;
|
||||
|
||||
: <int-vreg> ( n -- vreg ) T{ int-regs } <vreg> ;
|
||||
|
||||
|
@ -68,7 +68,7 @@ words kernel math effects ;
|
|||
! Test template picking strategy
|
||||
SYMBOL: template-chosen
|
||||
|
||||
: template-test ( a b -- c ) + ;
|
||||
: template-test ( a b -- c d ) ;
|
||||
|
||||
\ template-test {
|
||||
{
|
||||
|
@ -76,7 +76,7 @@ SYMBOL: template-chosen
|
|||
1 template-chosen get push
|
||||
] H{
|
||||
{ +input+ { { f "obj" } { [ ] "n" } } }
|
||||
{ +output+ { "obj" } }
|
||||
{ +output+ { "obj" "n" } }
|
||||
}
|
||||
}
|
||||
{
|
||||
|
@ -84,26 +84,26 @@ SYMBOL: template-chosen
|
|||
2 template-chosen get push
|
||||
] H{
|
||||
{ +input+ { { f "obj" } { f "n" } } }
|
||||
{ +output+ { "obj" } }
|
||||
{ +output+ { "obj" "n" } }
|
||||
}
|
||||
}
|
||||
} define-intrinsics
|
||||
|
||||
[ V{ 2 } ] [
|
||||
V{ } clone template-chosen set
|
||||
[ template-test ] compile-quot drop
|
||||
0 0 [ template-test ] compile-call 2drop
|
||||
template-chosen get
|
||||
] unit-test
|
||||
|
||||
[ V{ 1 } ] [
|
||||
V{ } clone template-chosen set
|
||||
[ dup 0 template-test ] compile-quot drop
|
||||
1 [ dup 0 template-test ] compile-call 3drop
|
||||
template-chosen get
|
||||
] unit-test
|
||||
|
||||
[ V{ 1 } ] [
|
||||
V{ } clone template-chosen set
|
||||
[ 0 template-test ] compile-quot drop
|
||||
1 [ 0 template-test ] compile-call 2drop
|
||||
template-chosen get
|
||||
] unit-test
|
||||
|
||||
|
@ -209,7 +209,8 @@ H{
|
|||
{ { f "x" } { f "y" } } define-if-intrinsic
|
||||
|
||||
[ ] [
|
||||
[ 2 template-choice-1 template-choice-2 ] compile-quot drop
|
||||
[ 2 template-choice-1 template-choice-2 ]
|
||||
[ define-temp ] with-compilation-unit drop
|
||||
] unit-test
|
||||
|
||||
[ V{ "template-choice-1" "template-choice-2" } ]
|
||||
|
|
|
@ -1,9 +1,8 @@
|
|||
! Black box testing of templating optimization
|
||||
|
||||
USING: arrays compiler kernel kernel.private math
|
||||
hashtables.private math.private namespaces sequences
|
||||
sequences.private tools.test namespaces.private slots.private
|
||||
combinators.private byte-arrays alien layouts ;
|
||||
combinators.private byte-arrays alien layouts words definitions ;
|
||||
IN: temporary
|
||||
|
||||
! Oops!
|
||||
|
@ -102,7 +101,7 @@ unit-test
|
|||
[ ] [
|
||||
[
|
||||
[ 200 dup [ 200 3array ] curry map drop ] times
|
||||
] compile-quot drop
|
||||
] [ define-temp ] with-compilation-unit drop
|
||||
] unit-test
|
||||
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@ quotations arrays vocabs ;
|
|||
IN: generic
|
||||
|
||||
PREDICATE: compound generic ( word -- ? )
|
||||
"combination" word-prop ;
|
||||
"combination" word-prop >boolean ;
|
||||
|
||||
M: generic definer drop f f ;
|
||||
|
||||
|
|
|
@ -136,9 +136,16 @@ M: object xyz ;
|
|||
] set-constraints
|
||||
] "constraints" set-word-prop
|
||||
|
||||
DEFER: blah
|
||||
|
||||
[ t ] [
|
||||
[ dup V{ } eq? [ foo ] when ] dup second dup push
|
||||
compile-quot word?
|
||||
[
|
||||
\ blah
|
||||
[ dup V{ } eq? [ foo ] when ] dup second dup push
|
||||
define-compound
|
||||
] with-compilation-unit
|
||||
|
||||
\ blah compiled?
|
||||
] unit-test
|
||||
|
||||
GENERIC: detect-fx ( n -- n )
|
||||
|
|
|
@ -322,15 +322,17 @@ HELP: fp-nan?
|
|||
{ $values { "x" real } { "?" "a boolean" } }
|
||||
{ $description "Tests if " { $snippet "x" } " is an IEEE Not-a-Number value. While " { $snippet "x" } " can be any real number, this word will only ever yield true if " { $snippet "x" } " is a " { $link float } "." } ;
|
||||
|
||||
HELP: real ( z -- x )
|
||||
HELP: real-part ( z -- x )
|
||||
{ $values { "z" number } { "x" real } }
|
||||
{ $description "Outputs the real part of a complex number. This acts as the identity on real numbers." }
|
||||
{ $class-description "The class of real numbers, which is a disjoint union of rationals and floats." } ;
|
||||
{ $description "Outputs the real part of a complex number. This acts as the identity on real numbers." } ;
|
||||
|
||||
HELP: imaginary ( z -- y )
|
||||
HELP: imaginary-part ( z -- y )
|
||||
{ $values { "z" number } { "y" real } }
|
||||
{ $description "Outputs the imaginary part of a complex number. This outputs zero for real numbers." } ;
|
||||
|
||||
HELP: real
|
||||
{ $class-description "The class of real numbers, which is a disjoint union of rationals and floats." } ;
|
||||
|
||||
HELP: number
|
||||
{ $class-description "The class of numbers." } ;
|
||||
|
||||
|
|
|
@ -286,8 +286,8 @@ HELP: H{
|
|||
{ $examples { $code "H{ { \"tuna\" \"fish\" } { \"jalapeno\" \"vegetable\" } }" } } ;
|
||||
|
||||
HELP: C{
|
||||
{ $syntax "C{ real imaginary }" }
|
||||
{ $values { "real" "a real number" } { "imaginary" "a real number" } }
|
||||
{ $syntax "C{ real-part imaginary-part }" }
|
||||
{ $values { "real-part" "a real number" } { "imaginary-part" "a real number" } }
|
||||
{ $description "Parses a complex number given in rectangular form as a pair of real numbers. Literal complex numbers are terminated by " { $link POSTPONE: } } "." } ;
|
||||
|
||||
HELP: T{
|
||||
|
|
|
@ -161,3 +161,25 @@ SYMBOL: quot-uses-b
|
|||
[ "IN: temporary : undef-test ; << undef-test >>" eval ] catch
|
||||
[ undefined? ] is?
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: temporary GENERIC: symbol-generic" eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: temporary SYMBOL: symbol-generic" eval
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "symbol-generic" "temporary" lookup symbol? ] unit-test
|
||||
[ f ] [ "symbol-generic" "temporary" lookup generic? ] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: temporary GENERIC: symbol-generic" eval
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: temporary TUPLE: symbol-generic ;" eval
|
||||
] unit-test
|
||||
|
||||
[ t ] [ "symbol-generic" "temporary" lookup symbol? ] unit-test
|
||||
[ f ] [ "symbol-generic" "temporary" lookup generic? ] unit-test
|
||||
|
|
|
@ -34,9 +34,9 @@ SYMBOL: cols
|
|||
|
||||
: c ( i j -- c )
|
||||
>r
|
||||
x-inc * center real x-inc width 2 / * - + >float
|
||||
x-inc * center real-part x-inc width 2 / * - + >float
|
||||
r>
|
||||
y-inc * center imaginary y-inc height 2 / * - + >float
|
||||
y-inc * center imaginary-part y-inc height 2 / * - + >float
|
||||
rect> ; inline
|
||||
|
||||
: render ( -- )
|
||||
|
|
|
@ -114,7 +114,7 @@ $nl
|
|||
"{ -12 -1 -3 -9 }"
|
||||
}
|
||||
{ $references
|
||||
{ "Since quotations are real objects, they can be constructed and taken apart at will. You can write code that writes code. Arrays are just one of the various types of sequences, and the sequence operations such as " { $link each } " and " { $link map } " operate on all types of sequences. There are many more sequence iteration operations than the ones above, too." }
|
||||
{ "Since quotations are objects, they can be constructed and taken apart at will. You can write code that writes code. Arrays are just one of the various types of sequences, and the sequence operations such as " { $link each } " and " { $link map } " operate on all types of sequences. There are many more sequence iteration operations than the ones above, too." }
|
||||
"dataflow"
|
||||
"sequences"
|
||||
} ;
|
||||
|
|
|
@ -9,8 +9,8 @@ $nl
|
|||
"Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero."
|
||||
$nl
|
||||
"Complex numbers can be taken apart:"
|
||||
{ $subsection real }
|
||||
{ $subsection imaginary }
|
||||
{ $subsection real-part }
|
||||
{ $subsection imaginary-part }
|
||||
{ $subsection >rect }
|
||||
"Complex numbers can be constructed from real numbers:"
|
||||
{ $subsection rect> }
|
||||
|
|
|
@ -5,13 +5,14 @@ USING: kernel kernel.private math math.private
|
|||
math.libm math.functions prettyprint.backend arrays
|
||||
math.functions.private sequences parser ;
|
||||
|
||||
M: real real ;
|
||||
M: real imaginary drop 0 ;
|
||||
M: real real-part ;
|
||||
M: real imaginary-part drop 0 ;
|
||||
|
||||
M: complex absq >rect [ sq ] 2apply + ;
|
||||
|
||||
: 2>rect ( x y -- xr yr xi yi )
|
||||
[ [ real ] 2apply ] 2keep [ imaginary ] 2apply ; inline
|
||||
[ [ real-part ] 2apply ] 2keep
|
||||
[ imaginary-part ] 2apply ; inline
|
||||
|
||||
M: complex number=
|
||||
2>rect number= [ number= ] [ 2drop f ] if ;
|
||||
|
|
|
@ -17,8 +17,8 @@ IN: temporary
|
|||
[ 4.0 ] [ 2 2 ^ ] unit-test
|
||||
[ 0.25 ] [ 2 -2 ^ ] unit-test
|
||||
[ t ] [ 2 0.5 ^ 2 ^ 2 2.00001 between? ] unit-test
|
||||
[ t ] [ e pi i* ^ real -1.0 = ] unit-test
|
||||
[ t ] [ e pi i* ^ imaginary -0.00001 0.00001 between? ] unit-test
|
||||
[ t ] [ e pi i* ^ real-part -1.0 = ] unit-test
|
||||
[ t ] [ e pi i* ^ imaginary-part -0.00001 0.00001 between? ] unit-test
|
||||
|
||||
[ t ] [ 0 0 ^ fp-nan? ] unit-test
|
||||
[ 1.0/0.0 ] [ 0 -2 ^ ] unit-test
|
||||
|
|
|
@ -105,7 +105,7 @@ M: real absq sq ;
|
|||
: power-of-2? ( n -- ? )
|
||||
dup 0 < [ drop f ] [ dup 1- bitand zero? ] if ; foldable
|
||||
|
||||
: >rect ( z -- x y ) dup real swap imaginary ; inline
|
||||
: >rect ( z -- x y ) dup real-part swap imaginary-part ; inline
|
||||
|
||||
: conjugate ( z -- z* ) >rect neg rect> ; inline
|
||||
|
||||
|
|
|
@ -56,7 +56,7 @@ PRIVATE>
|
|||
: q>v ( q -- v )
|
||||
#! Get the vector part of a quaternion, discarding the real
|
||||
#! part.
|
||||
first2 >r imaginary r> >rect 3array ;
|
||||
first2 >r imaginary-part r> >rect 3array ;
|
||||
|
||||
! Zero
|
||||
: q0 { 0 0 } ;
|
||||
|
|
|
@ -58,8 +58,8 @@ M: float (serialize) ( obj -- )
|
|||
|
||||
M: complex (serialize) ( obj -- )
|
||||
"c" write
|
||||
dup real (serialize)
|
||||
imaginary (serialize) ;
|
||||
dup real-part (serialize)
|
||||
imaginary-part (serialize) ;
|
||||
|
||||
M: ratio (serialize) ( obj -- )
|
||||
"r" write
|
||||
|
|
Loading…
Reference in New Issue