"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

Magnitude subclass:#ArithmeticValue

	instanceVariableNames:''

	classVariableNames:'DivisionByZeroSignal DomainErrorSignal OverflowSignal

		UnderflowSignal ArithmeticSignal AnyArithmeticSignal

		UnorderedSignal ConversionErrorSignal'

	poolDictionaries:''

	category:'Magnitude-Numbers'

!

!ArithmeticValue class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    ArithmeticValue is an abstract superclass for all things responding to

    arithmetic messages. It was inserted into the hierarchy, to allow objects

    like matrices, functions etc. to share the arithmetic methods defined here.

    [class variables:]

        ArithmeticSignal        <Signal>        parent of all arithmetic signals

                                                (never raised itself)

        DomainErrorSignal       <Signal>        raised upon float errors

                                                (for example range in trigonometric)

        DivisionByZeroSignal    <Signal>        raised when division by 0 is attempted

        OverflowSignal          <Signal>        raised on overflow/underflow conditions

        UnderflowSignal                         in float arithmetic. 

                                                Notice: some OperatingSystems do not 

                                                provide enough information for ST/X to 

                                                extract the real reason for the floatException

                                                thus raising DomainErrorSignal in these cases.

    [author:]

        Claus Gittinger

    [See also:]

        Number

"

! !

!ArithmeticValue class methodsFor:'initialization'!

initialize

    "setup the signals"

    ArithmeticSignal := ArithmeticError.

    ArithmeticError notifierString:'arithmetic error'.

    DomainErrorSignal := DomainError.

    DomainError     notifierString:'domain error'.

    RangeError      notifierString:'numeric range error'.

    DivisionByZeroSignal := ZeroDivide.

    ZeroDivide      notifierString:'division by zero'.

"/    ArithmeticSignal isNil ifTrue:[

"/        ArithmeticSignal := ErrorSignal newSignalMayProceed:true.

"/        ArithmeticSignal nameClass:self message:#arithmeticSignal.

"/        ArithmeticSignal notifierString:'arithmetic error'.

"/    ].

"/    DomainErrorSignal isNil ifTrue:[

"/        DomainErrorSignal := ArithmeticSignal newSignal.

"/        DomainErrorSignal nameClass:self message:#domainErrorSignal.

"/        DomainErrorSignal notifierString:'domain error'.

"/    ].

    ConversionErrorSignal isNil ifTrue:[

        ConversionErrorSignal := ArithmeticSignal newSignal.

        ConversionErrorSignal nameClass:self message:#conversionErrorSignal.

        ConversionErrorSignal notifierString:'conversion error'.

    ].

"/    DivisionByZeroSignal isNil ifTrue:[

"/        DivisionByZeroSignal := ArithmeticSignal newSignal.

"/        DivisionByZeroSignal nameClass:self message:#divisionByZeroSignal.

"/        DivisionByZeroSignal notifierString:'division by zero'.

"/    ].

    OverflowSignal isNil ifTrue:[

        OverflowSignal := RangeError newSignal.

        OverflowSignal nameClass:self message:#overflowSignal.

        OverflowSignal notifierString:'overflow'.

    ].

    UnderflowSignal isNil ifTrue:[

        UnderflowSignal := RangeError newSignal.

        UnderflowSignal nameClass:self message:#underflowSignal.

        UnderflowSignal notifierString:'underflow'.

    ].

    UnorderedSignal isNil ifTrue:[

        UnorderedSignal := ArithmeticSignal newSignal.

        UnorderedSignal nameClass:self message:#unorderedSignal.

        UnorderedSignal notifierString:'unordered'.

    ].

    AnyArithmeticSignal := SignalSet with:DomainErrorSignal

                                     with:DivisionByZeroSignal

                                     with:OverflowSignal

                                     with:UnderflowSignal

                                     with:UnorderedSignal.

! !

!ArithmeticValue class methodsFor:'Signal constants'!

anyArithmeticSignal

    "return a signalSet with all possible arithmetic signals.

     OBSOLETE: this will vanish, since starting with 2.10.3, signal parents

	       have been added."

    ^ AnyArithmeticSignal

!

arithmeticSignal

    "return the parent of all arithmetic signals"

    ^ ArithmeticSignal

!

conversionErrorSignal

    "return the signal which is raised when a conversion fails

     (such as bcd decoding of an invalid BCD number)"

    ^ ConversionErrorSignal

    "Created: / 15.11.1999 / 20:34:18 / cg"

!

divisionByZeroSignal

    "return the signal which is raised on division by zero"

    ^ DivisionByZeroSignal

!

domainErrorSignal

    "return the signal which is raised on math errors

     (such as log of 0 etc.)"

    ^ DomainErrorSignal

!

overflowSignal

    "return the signal which is raised on overflow conditions (in floats)"

    ^ OverflowSignal

!

underflowSignal

    "return the signal which is raised on underflow conditions (in floats)"

    ^ UnderflowSignal

!

unorderedSignal

    "return the signal which is raised when numbers are compared, 

     for which no ordering is defined (for example: complex numbers)"

    ^ UnorderedSignal

! !

!ArithmeticValue methodsFor:'arithmetic'!

* something

    "return the product of the receiver and the argument"

    ^ self subclassResponsibility

!

+ something

    "return the sum of the receiver and the argument"

    ^ self subclassResponsibility

!

- something

    "return the difference of the receiver and the argument"

    ^ self subclassResponsibility

!

/ something

    "return the quotient of the receiver and the argument"

    ^ self subclassResponsibility

!

// something

    "return the integer quotient of dividing the receiver by aNumber with

     truncation towards negative infinity."

    "/ Note: '^ (self / something) floor' may lead to infinite recursion

    ^ self subclassResponsibility

    "Modified: / 5.11.1996 / 11:46:27 / cg"

    "Modified: / 12.2.1998 / 16:31:36 / stefan"

!

\\ something

    "return the receiver modulo something.

     The remainder has the same sign as something,"

    ^ self - ((self // something) * something)

   "

     0.9 \\ 0.4

     0.9 \\ -0.4

    -0.9 \\ 0.4

    -0.9 \\ -0.4

   "

    "Modified: / 12.2.1998 / 19:14:37 / stefan"

!

abs

    "return the absolute value of the receiver"

    (self negative) ifTrue:[^ self negated].

    ^ self

!

negated

    "return the receiver negated"

    ^ self class zero - self

!

quo:something

    "Return the integer quotient of dividing the receiver by the argument

     with truncation towards zero."

    ^ (self / something) truncated

!

reciprocal

    "return the receivers reciprocal"

    ^ self class unity / self

!

rem:something

    "Return the integer remainder of dividing the receiver by the argument

     with truncation towards zero.

     The remainder has the same sign as the receiver."

    ^ self - ((self quo:something) * something)

! !

!ArithmeticValue methodsFor:'coercing & converting'!

coerce:aNumber

    "convert aNumber into an instance of the receivers class and return it."

    ^ self subclassResponsibility

!

generality

    "return a number giving the receivers generality, that number is

     used to convert one of the arguments in a mixed expression. 

     The generality has to be defined in subclasses,

     such that gen(a) > gen(b) iff, conversion of b into a's class 

     does not cut precision. For example, Integer has 40, Float has 80,

     meaning that if we convert a Float to an Integer, some precision may

     be lost. The generality is used by ArithmeticValue>>retry:coercing:,

     which converts the lower-precision number to the higher precision

     numbers class, when mixed-type arithmetic is performed."

    ^ self subclassResponsibility

    "Modified: / 5.11.1996 / 15:05:30 / cg"

    "Modified: / 13.2.1998 / 15:36:01 / stefan"

!

retry:aSymbol coercing:aNumber

    "arithmetic represented by the binary operator, aSymbol,

     could not be performed with the receiver and the argument, aNumber, 

     because of the differences in representation.  

     Coerce either the receiver or the argument, depending on which has higher 

     generality, and try again.  

     If the operation is compare for same value (=), return false if

     the argument is not a Number. 

     If the generalities are the same, create an error message, since this

     means that a subclass has not been fully implemented."

    |hasGenerality myGenerality otherGenerality|

    hasGenerality := aNumber respondsTo:#generality.

    hasGenerality ifFalse:[

        (aSymbol == #=) ifTrue:[

            ^ false

        ].

        (aSymbol == #~=) ifTrue:[

            ^ true

        ].

        ^ self error:'retry:coercing: argument is not a number'.

    ].

    myGenerality := self generality.

    otherGenerality := aNumber generality.

    (myGenerality > otherGenerality) ifTrue:[

        ^ self perform:aSymbol with:(self coerce:aNumber)

    ].

    (myGenerality < otherGenerality) ifTrue:[

        ^ (aNumber coerce:self) perform:aSymbol with:aNumber

    ].

    self error:'retry:coercing: oops - same generality'

    "Modified: 5.11.1996 / 15:03:38 / cg"

! !

!ArithmeticValue methodsFor:'comparing'!

< something

    "return true, if the argument is greater than the receiver"

    ^ self subclassResponsibility

!

<= something

    "return true, if the argument is greater or equal than the receiver"

    ^ (something < self) not

!

> something

    "return true, if the argument is less than the receiver"

    ^ something < self

!

>= something

    "return true, if the argument is less or equal than the receiver"

    ^ (self < something) not

!

compare:arg ifLess:lessBlock ifEqual:equalBlock ifGreater:greaterBlock

    "three-way compare - thanks to Self for this idea.

     Can be redefined in subclasses to do it with a single comparison if

     comparison is expensive."

    self < arg ifTrue:[

	^ lessBlock value

    ].

    self = arg ifTrue:[

	^ equalBlock value

    ].

    ^ greaterBlock value

! !

!ArithmeticValue methodsFor:'converting'!

asDouble

    "ST80 compatibility: return our floats are the identical to ST80 doubles"

   ^ self asFloat

    "Created: / 13.2.1998 / 15:40:14 / stefan"

!

asFloat

    "return a float with same value"

   ^ self subclassResponsibility

!

asFraction

    "return a fraction with same value"

   ^ self subclassResponsibility

!

asInteger

    "return an integer with same value - might truncate"

    ^ self truncated

!

asShortFloat

    "return a shortFloat with same value"

   ^ self asFloat asShortFloat

    "Modified: 17.4.1996 / 12:21:35 / cg"

!

degreesToRadians

    "interpreting the receiver as radians, return the degrees"

    ^ self asFloat degreesToRadians

!

radiansToDegrees

    "interpreting the receiver as degrees, return the radians"

    ^ self asFloat radiansToDegrees

! !

!ArithmeticValue methodsFor:'destructive arithmethic'!

*= aNumber

    "Return the product of self multiplied by aNumber. 

     Self MAY, but NEED NOT be changed to contain the product.

     So this method must be used: 'a := a *= 5'.

     This method can be redefined for constructed datatypes

     to do optimisations"

    ^ self * aNumber

    "Created: / 28.4.1999 / 11:46:11 / stefan"

    "Modified: / 28.4.1999 / 11:53:28 / stefan"

!

+= aNumber

    "Return the sum of self and aNumber. 

     Self MAY, but NEED NOT be changed to contain the product.

     So this method must be used: 'a := a += 5'.

     This method can be redefined for constructed datatypes

     to do optimisations"

    ^ self + aNumber

    "Created: / 28.4.1999 / 10:13:41 / stefan"

    "Modified: / 28.4.1999 / 11:54:11 / stefan"

!

-= aNumber

    "Return the difference of self and aNumber. 

     Self MAY, but NEED NOT be changed to contain the product.

     So this method must be used: 'a := a -= 5'.

     This method can be redefined for constructed datatypes

     to do optimisations"

    ^ self - aNumber

    "Created: / 28.4.1999 / 10:13:58 / stefan"

    "Modified: / 28.4.1999 / 11:54:37 / stefan"

!

/= aNumber

    "Return the quotient of self and aNumber. 

     Self MAY, but NEED NOT be changed to contain the product.

     So this method must be used: 'a := a /= 5'.

     This method can be redefined for constructed datatypes

     to do optimisations"

    ^ self / aNumber

    "Created: / 28.4.1999 / 11:46:22 / stefan"

    "Modified: / 28.4.1999 / 11:55:06 / stefan"

!

div2