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

db4
Slava Pestov 2007-12-27 17:26:39 -05:00
parent 318b5f40c8
commit 9c1454ef68
21 changed files with 83 additions and 53 deletions

View File

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

View File

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

View File

@ -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." }

View File

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

View File

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

View File

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

View File

@ -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" } ]

View File

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

View File

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

11
core/inference/class/class-tests.factor Normal file → Executable file
View File

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

View File

@ -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." } ;

4
core/syntax/syntax-docs.factor Normal file → Executable file
View File

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

View File

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

4
extra/benchmark/mandel/mandel.factor Normal file → Executable file
View File

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

2
extra/help/cookbook/cookbook.factor Normal file → Executable file
View File

@ -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"
} ;

4
extra/math/complex/complex-docs.factor Normal file → Executable file
View File

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

View File

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

View File

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

View File

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

2
extra/math/quaternions/quaternions.factor Normal file → Executable file
View File

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

4
extra/serialize/serialize.factor Normal file → Executable file
View File

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