fix bug in ^

cvs
Slava Pestov 2006-01-28 18:43:42 +00:00
parent 7b33785b03
commit c312aea944
4 changed files with 23 additions and 8 deletions

View File

@ -25,4 +25,3 @@
- if two tasks write to a unix stream, the buffer can overflow
- font problem: http://iarc1.ece.utexas.edu/~erg/font-bug.JPG
- make 3.4 bits>double an error
- float>bits bits>double etc fail in gcc 4.0.3 with -fschedule-insns

View File

@ -19,8 +19,18 @@ GENERIC: ^ ( z w -- z^w ) foldable
: ^theta ( w abs arg -- theta )
>r >r >rect r> flog * swap r> * + ; inline
: 0^0 "0^0 is not defined" throw ;
: 0^ ( z w -- )
dup 0 number= [
2drop 0.0/0.0
] [
0 < [ drop 1.0/0.0 ] when
] if ;
M: number ^ ( z w -- z^w )
swap >polar 3dup ^theta >r ^mag r> polar> ;
over 0 number=
[ 0^ ] [ swap >polar 3dup ^theta >r ^mag r> polar> ] if ;
: each-bit ( n quot -- | quot: 0/1 -- )
over 0 number= pick -1 number= or [
@ -34,11 +44,8 @@ M: number ^ ( z w -- z^w )
inline
M: integer ^ ( z w -- z^w )
over 0 number= over 0 number= and [
"0^0 is not defined" throw
] [
dup 0 < [ neg ^ recip ] [ (integer^) ] if
] if ;
over 0 number=
[ 0^ ] [ dup 0 < [ neg ^ recip ] [ (integer^) ] if ] if ;
: power-of-2? ( n -- ? )
dup 0 > [

View File

@ -17,6 +17,13 @@ USE: test
[ t ] [ e pi i * ^ real -1.0 = ] unit-test
[ t ] [ e pi i * ^ imaginary -0.00001 0.00001 between? ] unit-test
[ 0.0/0.0 ] [ 0 0 ^ ] unit-test
[ 1.0/0.0 ] [ 0 -2 ^ ] unit-test
[ 0.0/0.0 ] [ 0 0.0 ^ ] unit-test
[ 1.0/0.0 ] [ 0 -2.0 ^ ] unit-test
[ 0 ] [ 0 3.0 ^ ] unit-test
[ 0 ] [ 0 3 ^ ] unit-test
[ 1.0 ] [ 0 cosh ] unit-test
[ 0.0 ] [ 1 acosh ] unit-test

View File

@ -2,7 +2,7 @@ IN: gadgets-presentations
USING: compiler gadgets gadgets-buttons gadgets-listener
gadgets-menus gadgets-panes generic hashtables inference
inspector io jedit kernel lists namespaces parser prettyprint
sequences words styles ;
sequences strings styles words ;
SYMBOL: commands
@ -78,6 +78,8 @@ M: command-button gadget-help ( button -- string )
"Reload original source" [ word? ] [ reload ] \ in-listener define-command
"Infer stack effect" [ word? ] [ unit infer . ] \ in-listener define-command
"Use word vocabulary" [ word? ] [ word-vocabulary use+ ] \ in-listener define-command
"Display gadget" [ [ gadget? ] is? ] [ gadget. ] \ in-listener define-command
"Use as input" [ input? ] [ input-string pane get replace-input ] \ call define-default-command