[comp.lang.smalltalk] Smalltalk/V for PM V1.0 bug fixes & enhancements Part 7

cowan@marob.masa.com (John Cowan) (07/27/90)

"

Purpose of MAGNITUD.ST:

Supports new Magnitude subsystem with extensible mixed-mode
arithmetic, plus new subclasses Complex (of Number), NonFiniteNumber
(of Number) and Timestamp (of Magnitude).

1) The relational operators are now defined in circular
form, such that subclasses need only implement = and one
other, typically <, to support all six.

2) The arithmetic operators in subclasses of Number now
check whether the right-hand argument belongs to their own
subclass or not.  If not, a dispatch is made to the superclass
method, which is a general mixed-mode method.  The mixed-mode
machinery relies on a "generalizer" method for each type of
Number.  This returns a selector which can be sent to any
subclass of Number to coerce an instance of the less general type
to the more general type.

For example, the generalizer for Fraction is
"fromFraction:" and this can be sent to any subclass of Number.
Fractions cannot be coerced to Integers, so Integer class does
not support fromFraction: (a dummy version exists in Number class).
Fractions can be coerced to Floats, and this is done in
Float class>>fromFraction:.  To add a new class, each more
general class must implement a generalizer for the new class.
Less general classes need not change.  For this purpose, Point
is also treated as a subclass of Number, so that mixed arithmetic
between Points and Numbers is possible.

3) The following new methods have been added:
	Character>>to:do:
	Character>>to:by:do:
	Date>>easter
	Number>>i
	Number>>finite
	Number>>infinite
	Number>>infinitesimal

4) Complex class implements mathematical complex numbers.
Like Lisp's complex numbers, and unlike Fortran's, these
complex numbers need not have Float components; rational
complex numbers work fine.  Due to a compiler bug, the
sqrt of a negative Float is not complex, but the sqrt of
a negative non-Float returns the correct Complex answer.

5) NonFiniteNumber class implements four special numbers
representing positive and negative infinity and positive
and negative infinitesimal.

6) Timestamp class implements objects which contain both
a Date and a Time.  Timestamp class>>new is guaranteed
to return a unique Timestamp, by stalling the process
if necessary.

"

Number subclass: #Complex
  instanceVariableNames: 
    'real imaginary '
  classVariableNames: ''
  poolDictionaries: '' !


!Complex class methods !
 
fromFloat: aFloat
        "Coerce a Float to Complex."
    ^self real: aFloat imaginary: 0.0!
 
fromFraction: aFraction
        "Coerce a Fraction to Complex."
    ^self real: aFraction!

fromInteger: anInteger
        "Coerce a Integer to Complex."
    ^self real: anInteger!
  
real: re
        "Create a new complex number with the given
        real part and imaginary part zero."
    ^self basicNew real: re imaginary: 0!
   
real: re imaginary: im
        "Create a new complex number with the given
        real and imaginary parts."
    ^self basicNew real: re imaginary: im! !



!Complex methods !
 
* aNumber
        "Return the product of the receiver and the argument."
     | re im |
    (aNumber class == Complex) ifTrue:
        [re := aNumber real.
        im := aNumber imaginary.
        ^Complex
            real: real * re - (imaginary * im)
            imaginary: real * im + (imaginary * re)]
    ifFalse:
        [^super * aNumber]!

+ aNumber
        "Return the sum of the receiver and the argument."
    (aNumber class == Complex) ifTrue:
        [^Complex
            real: aNumber real + real
            imaginary: aNumber imaginary + imaginary]
    ifFalse:
        [^super + aNumber]!
   
- aNumber
        "Return the difference of the receiver and the argument."
    (aNumber class ==  Complex) ifTrue:
        [^Complex
            real: real - aNumber real
            imaginary: imaginary - aNumber imaginary]
    ifFalse:
        [^super - aNumber]!
   
/ aNumber
        "Return the quotient of the receiver and the argument."
    | re im denominator |
    (aNumber class == Complex) ifTrue:
        [re := aNumber real.
        im := aNumber imaginary.
        denominator := re * re + (im * im).
        ^Complex
            real: re * real + (im * imaginary) / denominator
            imaginary: im * imaginary - (re * real) / denominator]
    ifFalse:
        [^super / aNumber]!
   
< aNumber

    ^self error: 'Complex numbers not ordered'!

= aNumber
        "Answer true if receiver equals aNumber."
    aNumber class == Complex ifTrue:
        [^real = aNumber real and:
            [imaginary = aNumber imaginary]]
    ifFalse:
        [^super = aNumber]!
 
abs
        "Return the magnitude (or absolute value)
        of the complex number."
    ^((real * real) + (imaginary * imaginary)) sqrt!
   
asPoint
        "Return the complex number as a point."
    ^real @ imaginary!

conjugated
        "Return the complex conjugate of this complex number."
    ^Complex real: real imaginary: imaginary negated!
   
generalizer
        "Answer a message which converts other numbers
        to Complex."
    ^#fromComplex:!
  
imaginary
        "Return the imaginary part of the complex number."
    ^imaginary!
  
negated
        "Answer the negation of the receiver."
    ^Complex real: real negated
        imaginary: imaginary negated!
 
phase
        "Answer the phase of the receiver in radians.
        The phase of zero is zero."
    (real = 0 and: [imaginary = 0]) ifTrue:
        [^0]
    ifFalse:
        [^imaginary asFloat arcTan: real asFloat]!
  
printOn: aStream
    aStream nextPutAll: '('.
    real storeOn: aStream.
    aStream nextPutAll: ' + '.
    imaginary storeOn: aStream.
    aStream nextPutAll: 'i)'!
  
real
        "Return the real part of the complex number."
    ^real!
 
real: re imaginary: im
        "Private - Initialize instance variables."
    ((re isKindOf: Complex) or:
        [im isKindOf: Complex]) ifTrue:
            [self error: 'No hypercomplex numbers'].
    real := re.
    imaginary := im.!
  
reciprocal
        "Answer 1 divided by the receiver."
    (Complex real: 1) / self.!
 
sign
        "Answer a complex number with the same
        phase as the receiver and unit magnitude.
        The sign of a complex zero is zero."
    (imaginary = 0) & (real = 0) ifTrue:
        [^self]
    ifFalse:
        [^self / self abs]!
 
sqrt
        "Return the square root of the receiver"
    | re im |
    (imaginary = 0 and: [real >= 0])
        ifTrue:    [^real sqrt].
    im := (self abs - real / 2) sqrt.
    re := imaginary / (im * 2).
    ^Complex real: re imaginary: im! !

Number subclass: #NonFiniteNumber
  instanceVariableNames: 
    'negative infinite infinitesimal '
  classVariableNames: 
    'NegativeInfinitesimal PrintNames PositiveInfinitesimal PositiveInfinity Zero FiniteNumberCache PositiveFinite NegativeFinite Negatives Reciprocals NegativeInfinity '
  poolDictionaries: ''  !


!NonFiniteNumber class methods !
 
fromFloat: aNumber
        "Coerce aNumber to the appropriate NonFiniteNumber.
        Store the actual Number in the FiniteNumberCache
        (for use by various operators)."
    FiniteNumberCache := aNumber.
    aNumber = 0 ifTrue: [^Zero].
    aNumber negative ifTrue: [^NegativeFinite] ifFalse: [^PositiveFinite]!

fromFraction: aNumber
        "Coerce aNumber to the appropriate NonFiniteNumber.
        Store the actual Number in the FiniteNumberCache
        (for use by various operators)."
    FiniteNumberCache := aNumber.
    aNumber = 0 ifTrue: [^Zero].
    aNumber negative ifTrue: [^NegativeFinite] ifFalse: [^PositiveFinite]!
 
fromInteger: aNumber
        "Coerce aNumber to the appropriate NonFiniteNumber.
        Store the actual Number in the FiniteNumberCache
        (for use by various operators)."
    FiniteNumberCache := aNumber.
    aNumber = 0 ifTrue: [^Zero].
    aNumber negative ifTrue: [^NegativeFinite] ifFalse: [^PositiveFinite]!
  
initDictionaries
        "Private - Set up class dictionaries."
    Negatives := IdentityDictionary new.
    Negatives
        at: PositiveInfinity put: NegativeInfinity;
        at: NegativeInfinity put: PositiveInfinity;
        at: PositiveInfinitesimal put: NegativeInfinitesimal;
        at: NegativeInfinitesimal put: PositiveInfinitesimal;
        at: PositiveFinite put: NegativeFinite;
        at: NegativeFinite put: PositiveFinite;
        at: Zero put: Zero.
    Reciprocals := IdentityDictionary new.
    Reciprocals
        at: PositiveInfinity put: PositiveInfinitesimal;
        at: NegativeInfinity put: NegativeInfinitesimal;
        at: PositiveInfinitesimal put: PositiveInfinity;
        at: NegativeInfinitesimal put: NegativeInfinity;
        at: PositiveFinite put: PositiveFinite;
        at: NegativeFinite put: NegativeFinite.
    PrintNames := IdentityDictionary new.
    PrintNames
        at: PositiveInfinity put: #PositiveInfinity;
        at: NegativeInfinity put: #NegativeInfinity;
        at: PositiveInfinitesimal put: #PositiveInfinitesimal;
        at: NegativeInfinitesimal put: #NegativeInfinitesimal.!
 
initialize
        "Set up class variables.  These are the only instances
        of NonFiniteNumber class."
    PositiveInfinity := self basicNew
        negative: false
        infinite: true
        infinitesimal: false.
    NegativeInfinity := self basicNew
        negative: true
        infinite: true
        infinitesimal: false.
    PositiveInfinitesimal := self basicNew
        negative: false
        infinite: false
        infinitesimal: true.
    NegativeInfinitesimal := self basicNew
        negative: true
        infinite: false
        infinitesimal: true.
    PositiveFinite := self basicNew
        negative: false
        infinite: false
        infinitesimal: false.
    NegativeFinite := self basicNew
        negative: true
        infinite: false
        infinitesimal: false.
    Zero := self basicNew
        negative: false
        infinite: false
        infinitesimal: false.
    self initDictionaries.!
  
negativeInfinitesimal
        "Answer a negative infinitesimal."
    ^NegativeInfinitesimal!
  
negativeInfinity
        "Answer negative infinity."
    ^NegativeInfinity!
   
positiveInfinitesimal
        "Answer a positive infinitesimal."
    ^PositiveInfinitesimal!
  
positiveInfinity
        "Answer positive infinity."
    ^PositiveInfinity!
   
release
        "Clear class variables."
    PositiveInfinity :=
    NegativeInfinity :=
    PositiveInfinitesimal :=
    NegativeInfinitesimal :=
    PositiveFinite :=
    NegativeFinite :=
    Zero :=
    Negatives :=
    Reciprocals :=
    PrintNames := nil.! !



!NonFiniteNumber methods !
   
* aNumber
        "Answer the product of the receiver and aNumber."
    (aNumber isKindOf: NonFiniteNumber) ifFalse:
        [^super * aNumber].
    (self == Zero or: [aNumber == Zero]) ifTrue:
        [^FiniteNumberCache]. "answer the right kind of zero"
    ((infinite and: [aNumber infinitesimal])
        or:
    [infinitesimal and: [aNumber infinite]]) ifTrue:
        [^self error: 'Cannot multiply infinite and infinitesimal values'].
    self finite ifTrue:
        [^aNumber withSign: self]
    ifFalse:
        [^self withSign: aNumber].!
   
+ aNumber
        "Answer the sum of the receiver and aNumber."
    | answer |
    (aNumber isKindOf: NonFiniteNumber) ifFalse:
        [^super + aNumber].
    infinite ifTrue:
        [^self addToInfinity: aNumber].
    aNumber infinite ifTrue:
        [^aNumber addToInfinity: self].
    infinitesimal ifTrue:
        [^self addToInfinitesimal: aNumber].
    aNumber infinitesimal ifTrue:
        [^aNumber addToInfinitesimal: self].!

- aNumber
        "Answer the difference between the receiver and
        aNumber."
    (aNumber isKindOf: NonFiniteNumber) ifTrue:
        [^self + aNumber negated]
    ifFalse:
        [super - aNumber]!
 
/ aNumber
        "Answer the quotient of the receiver and aNumber."
    (aNumber isKindOf: NonFiniteNumber) ifTrue:
        [^self * aNumber reciprocal]
    ifFalse:
        [super / aNumber]!
  
// aNumber
        "Answer integer quotient of receiver by aNumber."
    ^self invalidMessage!

< aNumber
        "Answer true if the receiver is less than aNumber."
    (aNumber isKindOf: NonFiniteNumber) ifTrue:
        [^(self + aNumber negated) negative]
    ifFalse:
        [^super < aNumber]!

= aNumber
        "Answer true if the receiver is equal to aNumber."
    (aNumber isKindOf: NonFiniteNumber) ifTrue:
        [^self == aNumber]
    ifFalse:
        [^super = aNumber]!
   
\\ aNumber
        "Answer integer remainder of receiver mod aNumber."
    ^self invalidMessage!
  
addToInfinitesimal: aNonFiniteNumber
        "Private - Add aNonFiniteNumber to the receiver,
        which is infinitesimal.  A NonFiniteNumber is
        not infinite."
    (aNonFiniteNumber infinitesimal and:
    [aNonFiniteNumber negative ~= negative]) ifTrue:
        [^self error: 'Cannot add infinitesimals with different signs'].
    aNonFiniteNumber == Zero ifTrue:
        [^self]
    ifFalse:
        [^FiniteNumberCache]!
 
addToInfinity: aNonFiniteNumber
        "Private - Add aNonFiniteNumber to the receiver,
        which is infinite."
    (aNonFiniteNumber infinite and:
    [aNonFiniteNumber negative ~= negative]) ifTrue:
        [^self error: 'Cannot add infinities with different signs'].
    ^self!
 
finite
        "Private - Answer true if the receiver is finite."
    ^(infinite | infinitesimal) not!

generalizer
        "Answer a message that can be sent to other classes
        to coerce a NonFiniteNumber into that class."
    ^#fromNonFiniteNumber:!

hash
        "Integer hash value for receiver."
    ^self basicHash!
  
infinite
        "Answer true if the receiver is infinite."
    ^infinite!

infinitesimal
        "Answer true if the receiver is infinitesimal."
    ^infinitesimal!
 
negated
        "Answer the receiver negated."
    ^Negatives at: self!
   
negative
        "Answer true if the receiver is negative."
    ^negative!

negative: flag1 infinite: flag2 infinitesimal: flag3
        "Private - Initialize instance variables."
    negative := flag1.
    infinite := flag2.
    infinitesimal := flag3.!
  
positive
        "Answer true if the receiver is positive."
    ^negative not!

printOn: aStream
        "Print a string representing the receiver on aStream."
    (PrintNames at: self ifAbsent: [^FiniteNumberCache])
        printOn: aStream.!
  
reciprocal
        "Answer the reciprocal of the receiver.
        It is an error to take the reciprocal of zero."
    ^Reciprocals at: self ifAbsent:
        [^self error: 'Cannot take the reciprocal of zero']!
 
withSign: aNonFiniteNumber
        "Private - Combine the signs of the receiver and
        aNonFiniteNumber, according to the rule for multiplication,
        and apply the sign to the receiver, which is returned."
    aNonFiniteNumber negative ifTrue:
        [^self negated]
    ifFalse:
        [^self]! !

Magnitude subclass: #Timestamp
  instanceVariableNames: 
    'date time '
  classVariableNames: 
    'LastTimestamp '
  poolDictionaries: '' !


!Timestamp class methods !
   
date: aDate time: aTime
        "Answer a new Timestamp initialized by aDate and aTime."
    ^super new date: aDate time: aTime!
  
new
        "Issue a new Timestamp, set to the current date and time.
        This Timestamp will be distinct from all previous Timestamps."
    | aTimestamp interrupts |
    interrupts := Process enableInterrupts: false.
    [aTimestamp := self date: Date today time: Time now.
     aTimestamp == LastTimestamp] whileTrue:
        [1 to: 1000 do: [:i | nil]].
    LastTimestamp := aTimestamp.
    Process enableInterrupts: interrupts.
    ^aTimestamp.! !



!Timestamp methods !
   
< aTimestamp
        "Answer true if the receiver strictly precedes aTimestamp."
    date < aTimestamp date ifTrue: [^true].
    date = aTimestamp date ifTrue: [^time < aTimestamp time].
    ^false.!
 
= aTimestamp
        "Answer true if the receiver and aTimestamp are equal."
    aTimestamp class == self class ifFalse: [^false].
    aTimestamp date = date ifFalse: [^false].
    aTimestamp time = time ifFalse: [^false].
    ^true!
  
date
        "Answer the date associated with aTimestamp."
    ^date!
 
date: aDate time: aTime
        "Private - Initialize receiver."
    date := aDate.
    time := aTime.!
  
printOn: aStream
        "Print a visible representation of the receiver on aStream."
    date printOn: aStream.
    aStream nextPutAll: ' '.
    time printOn: aStream.!
   
time
        "Answer the time associated with aTimestamp."
    ^time! !
! Magnitude methods !   
< aMagnitude
        "Answer true if the receiver is less
         than aMagnitude, else answer false."
    ^aMagnitude > self! !

! Magnitude methods ! 
<= aMagnitude
        "Answer true if the receiver is less than
         or equal to aMagnitude, else answer false."
    ^(self > aMagnitude) not! !

! Magnitude methods !  
> aMagnitude
        "Answer true if the receiver is greater
         than aMagnitude, else answer false."
    ^aMagnitude < self! !

! Magnitude methods !  
>= aMagnitude
        "Answer true if the receiver is greater than
         or equal to aMagnitude, else answer false."
    ^(self < aMagnitude) not! !

! Character methods !   
to: aCharacter
        "Answer a CharacterInterval for the characters between
         the receiver and the argument aCharacter where
         each character is the successor of the previous
        character."
    ^CharacterInterval from: self to: aCharacter! !

! Character methods !  
to: aCharacter by: iNumber
        "Answer a CharacterInterval for the characters between
         the receiver and the argument aCharacter where each
         character's value is the previous character's value
         plus the argument iNumber."
    ^CharacterInterval from: self to: aCharacter by: iNumber! !

! Character methods !
to: aCharacter by: iNumber do: aBlock
        "Evaluate the one argument block aBlock for the
         characters between the receiver and the argument
         aCharacter where each character's value is the
        previous character's value plus the argument iNumber."
    | index limit |
    index := self asciiValue.
    limit := aCharacter asciiValue.
    iNumber > 0
        ifTrue: [
            [index <= limit] whileTrue: [
                aBlock value: (Character value: index).
                index := index + iNumber]]
        ifFalse: [
            [limit <= index] whileTrue: [
                aBlock value: (Character value: index).
                index := index + iNumber]]! !

! Character methods !   
to: aCharacter do: aBlock
        "Evaluate the one argument block aBlock for the
         characters between the receiver and the argument
         aCharacter where each character is the successor of
        the previous character."
    | index limit |
    index := self asciiValue.
    limit := aCharacter asciiValue.
    [index <= limit]
        whileTrue: [
            aBlock value: (Character value: index).
            index := index + 1]! !

! Date methods !   
easter
        "Answer a new Date which represents Easter for the year
        specified by the receiver.  Uses Knuth algorithm 1.3.2E."
    | y g c x z d e n |
    y := self year.                             "year number"
    g := (y \\ 19) + 1.                   "golden number"
    c := (y // 100) + 1.                  "century number"
    x := (3 * c // 4) - 12.               "number of non-leaps"
    z := (((8 * c) + 5) // 25) - 5.      "lunar orbital correction"
    d := (5 * y // 4) - x - 10.           "find Sunday"
    e := (11 * g) + 20 + z - x \\ 30.        "epact"
    (e = 25) & (g > 11) ifTrue: [e := e + 1].
    e = 24 ifTrue: [e := e + 1].
    n := 44 - e.                                  "find full moon"
    n < 21 ifTrue: [n := n + 30].
    n := n + 7 - (d + n \\ 7).
    n > 31 ifTrue:
        [^Date newDay: n - 31 month: #April year: y]
    ifFalse:
        [^Date newDay: n month: #March year: y]! !

! Number class methods !
fromComplex: aNumber
        "Dummy coercion from Complex."
    ^aNumber! !

! Number class methods ! 
fromFloat: aNumber
        "Dummy coercion from Float."
    ^aNumber! !

! Number class methods ! 
fromFraction: aNumber
        "Dummy coercion from Fraction."
    ^aNumber! !

! Number class methods !   
fromInteger: aNumber
        "Dummy coercion from Integer."
    ^aNumber! !

! Number class methods ! 
fromNonFiniteNumber: aNonFiniteNumber
        "Dummy coercion from NonFiniteNumber."
    ^aNonFiniteNumber! !

! Number class methods !   
fromPoint: aPoint
        "Dummy coercion from Point."
    ^aPoint! !

! Number methods ! 
* aNumber
        "Answer the result of multiplying
         the receiver by aNumber."
    | lhs rhs |
    lhs := aNumber class perform: self generalizer
        with: self.
    rhs := self class perform: aNumber generalizer
        with: aNumber.
    lhs generalizer == rhs generalizer ifTrue:
        [^lhs * rhs]
    ifFalse:
        [self error: 'Impossible mixed-mode operation']! !

! Number methods !  
+ aNumber
        "Answer the sum of the receiver and aNumber."
    | lhs rhs |
    lhs := aNumber class perform: self generalizer
        with: self.
    rhs := self class perform: aNumber generalizer
        with: aNumber.
    lhs generalizer == rhs generalizer ifTrue:
        [^lhs + rhs]
    ifFalse:
        [self error: 'Impossible mixed-mode operation']! !

! Number methods !  
- aNumber
        "Answer the difference between
         the receiver and aNumber."
    | lhs rhs |
    lhs := aNumber class perform: self generalizer
        with: self.
    rhs := self class perform: aNumber generalizer
        with: aNumber.
    lhs generalizer == rhs generalizer ifTrue:
        [^lhs - rhs]
    ifFalse:
        [self error: 'Impossible mixed-mode operation']! !

! Number methods !
/ aNumber
        "Answer the result of dividing
         the receiver by aNumber."
    | lhs rhs |
    lhs := aNumber class perform: self generalizer
        with: self.
    rhs := self class perform: aNumber generalizer
        with: aNumber.
    lhs generalizer == rhs generalizer ifTrue:
        [^lhs / rhs]
    ifFalse:
        [self error: 'Impossible mixed-mode operation']! !

! Number methods ! 
// aNumber
        "Answer the integer result of dividing the
         receiver by aNumber with truncation
         towards negative infinity."
    | lhs rhs |
    lhs := aNumber class perform: self generalizer
        with: self.
    rhs := self class perform: aNumber generalizer
        with: aNumber.
    lhs generalizer == rhs generalizer ifTrue:
        [^lhs // rhs]
    ifFalse:
        [self error: 'Impossible mixed-mode operation']! !

! Number methods !   
< aNumber
        "Answer true if the receiver is less
         than aNumber, else answer false."
    | lhs rhs |
    lhs := aNumber class perform: self generalizer
        with: self.
    rhs := self class perform: aNumber generalizer
        with: aNumber.
    lhs generalizer == rhs generalizer ifTrue:
        [^lhs < rhs]
    ifFalse:
        [self error: 'Impossible mixed-mode operation']! !

! Number methods !   
= aNumber
        "Answer true if the receiver is equal to
         aNumber, else answer false."
    | lhs rhs |
    (aNumber isKindOf: Number) ifFalse:
        [^false].
    lhs := aNumber class perform: self generalizer
        with: self.
    rhs := self class perform: aNumber generalizer
        with: aNumber.
    lhs generalizer == rhs generalizer ifTrue:
        [^lhs = rhs]
    ifFalse:
        [self error: 'Impossible mixed-mode operation']! !

! Number methods !
\\ aNumber
        "Answer the integer remainder after dividing
         the receiver by aNumber with truncation
         towards negative infinity."
    | lhs rhs |
    lhs := aNumber class perform: self generalizer
        with: self.
    rhs := self class perform: aNumber generalizer
        with: aNumber.
    lhs generalizer == rhs generalizer ifTrue:
        [^lhs \\ rhs]
    ifFalse:
        [self error: 'Impossible mixed-mode operation']! !

! Number methods ! 
finite
        "Answer true if the receiver is a finite number."
    ^true! !

! Number methods ! 
i
        "Answer the receiver as an imaginary number."
    ^Complex real: 0 imaginary: self! !

! Number methods !   
infinite
        "Answer true if the receiver is infinite."
    ^false! !

! Number methods ! 
infinitesimal
        "Answer true if the receiver is infinitesimal."
    ^false! !

! Number methods !   
sqrt
        "Answer a Float or Complex which is the
         square root of the receiver."
    ((self isKindOf: Complex)
        or: [self < 0]) ifTrue:
            [^(Complex fromFloat: self asFloat) sqrt]
    ifFalse: [^self asFloat sqrt].! !


! Float class methods !  
fromFraction: aFraction
        "Answer a floating point representation
         of the argument aFraction."
    ^aFraction numerator asFloat /
        aFraction denominator asFloat! !

! Float methods ! 
* aNumber
        "Answer the result of multiplying
         the receiver by aNumber."
    <primitive: 49>
    aNumber class == Float
        ifTrue: [self class noMathChip: [:result |
            FloatLibrary multiply: self by: aNumber result: result.
            ^result]]
        ifFalse: [^super * aNumber]! !

! Float methods !
+ aNumber
        "Answer sum of the receiver and aNumber."
    <primitive: 41>
    aNumber class == Float
        ifTrue: [self class noMathChip: [:result |
            FloatLibrary add: self to: aNumber result: result.
            ^result]]
        ifFalse: [^super + aNumber]! !

! Float methods ! 
- aNumber
        "Answer the difference between
         the receiver and aNumber."
    <primitive: 42>
    aNumber class == Float
        ifTrue: [self class noMathChip: [:result |
            FloatLibrary subtract: aNumber from: self result: result.
            ^result]]
        ifFalse: [^super - aNumber]! !

! Float methods !
/ aNumber
        "Answer the result of dividing
         the receiver by aNumber."
    <primitive: 50>
    aNumber class == Float
        ifTrue: [self class noMathChip: [:result |
            FloatLibrary divide: self by: aNumber result: result.
            ^result]]
        ifFalse: [^super / aNumber]! !

! Float methods ! 
< aNumber
        "Answer true if the receiver is less
         than aNumber, else answer false."
    <primitive: 43>
    aNumber class == Float
        ifTrue: [self class noMathChip: [:result |
            ^FloatLibrary less: self than: aNumber]]
        ifFalse: [^super < aNumber]! !

! Float methods !   
<= aNumber
        "Answer true if the receiver is less than
         or equal to aNumber, else answer false."
    aNumber class == Float ifTrue:
        [^(aNumber < self) not]
    ifFalse: [^super <= aNumber]! !

! Float methods !   
= aNumber
        "Answer true if the receiver is equal
         to aNumber, else answer false."
    <primitive: 47>
    aNumber class == Float
        ifTrue: [self class noMathChip: [:result |
            ^FloatLibrary equal: self to: aNumber]]
        ifFalse: [^super = aNumber]! !

! Float methods ! 
> aNumber
        "Answer true if the receiver is greater
         than aNumber, else answer false."
    aNumber class == Float ifTrue:
        [^aNumber asFloat < self]
    ifFalse: [^super > aNumber]! !

! Float methods !
>= aNumber
        "Answer true if the receiver is greater than
         or equal to aNumber, else answer false."
    aNumber class == Float ifTrue:
        [^(self < aNumber) not]
    ifFalse: [^super >= aNumber]! !

! Float methods !
arcTan: x
        "Answers the arc tangent of the receiver divided
        by x.  Defined even if x = 0 provided the receiver
        is not zero."
        x = 0.0 ifTrue:
            [self < 0.0 ifTrue: [^Float pi / -2.0].
            self > 0.0 ifTrue: [^Float pi / 2.0].
            ^0.0 / 0.0]
        ifFalse:
            [^(self / x) arcTan]! !

! Float methods !  
generalizer
        "Answer a message which can be sent to a class
        to transform a Float into an instance of that class."
    ^#fromFloat:! !

! Fraction class methods ! 
fromInteger: anInteger
        "Answer a Fraction representing
         the argument anInteger."
    ^self numerator: anInteger denominator: 1! !

! Fraction methods !  
* aNumber
        "Answer the result of multiplying
         the receiver by aNumber."
    aNumber class == Fraction ifTrue:
        [^(numerator * aNumber numerator) /
            (denominator * aNumber denominator)]
    ifFalse: [^super * aNumber]! !

! Fraction methods !
+ aNumber
        "Answer sum of the receiver and aNumber."
    aNumber class == Fraction ifTrue:
        [^((numerator * aNumber denominator) +
            (denominator * aNumber numerator)) /
                (denominator * aNumber denominator)]
    ifFalse: [^super + aNumber]! !

! Fraction methods !   
- aNumber
        "Answer the difference between
         the receiver and aNumber."
    aNumber class == Fraction ifTrue:
        [^((numerator * aNumber denominator) -
            (denominator * aNumber numerator)) /
                (denominator * aNumber denominator)]
    ifFalse: [^super - aNumber]! !

! Fraction methods ! 
/ aNumber
        "Answer the result of dividing
         the receiver by aNumber."
    aNumber class == Fraction ifTrue:
        [^(numerator * aNumber denominator) /
            (denominator * aNumber numerator)]
    ifFalse: [^super / aNumber]! !

! Fraction methods !   
// aNumber
        "Answer the integer quotient after dividing
         the receiver by aNumber with truncation
         towards negative infinity."
    aNumber class == Fraction ifTrue:
        [^(numerator * aNumber denominator) //
            (denominator * aNumber numerator)]
    ifFalse: [^super // aNumber]! !

! Fraction methods !   
< aNumber
        "Answer true if the receiver is less
         than aNumber, else answer false."
    aNumber class == Fraction ifTrue:
        [^(numerator * aNumber denominator) <
            (denominator * aNumber numerator)]
    ifFalse: [^super < aNumber]! !

! Fraction methods ! 
<= aNumber
        "Answer true if the receiver is less than
         or equal to aNumber, else answer false."
    aNumber class == Fraction ifTrue:
        [^(numerator * aNumber denominator) <=
            (denominator * aNumber numerator)]
    ifFalse: [^super <= aNumber]! !

! Fraction methods !  
= aNumber
        "Answer true if the receiver is equal
         to aNumber, else answer false."
    aNumber class == Fraction ifTrue:
        [^numerator = aNumber numerator and:
                [denominator = aNumber denominator]]
    ifFalse: [^super = aNumber]! !

! Fraction methods ! 
> aNumber
        "Answer true if the receiver is greater
         than aNumber, else answer false."
    aNumber class == Fraction ifTrue:
        [^(numerator * aNumber denominator) >
            (denominator * aNumber numerator)]
    ifFalse: [^super > aNumber]! !

! Fraction methods !  
>= aNumber
        "Answer true if the receiver is greater than
         or equal to aNumber, else answer false."
    aNumber class == Fraction ifTrue:
        [^(denominator * aNumber numerator) <=
            (numerator * aNumber denominator)]
    ifFalse: [^super >= aNumber]! !

! Fraction methods !   
\\ aNumber
        "Answer the integer remainder after dividing
         the receiver by aNumber with truncation
         towards negative infinity."
    aNumber class == Fraction ifTrue:
        [^(numerator * aNumber denominator) \\
            (denominator * aNumber numerator)]
    ifFalse: [^super \\ aNumber]! !

! Fraction methods !  
generalizer
        "Answer a message which can be sent to a class
        to transform a Fraction into an instance of that class."
    ^#fromFraction:! !

! Integer methods !  
* aNumber
        "Answer the result of multiplying
         the receiver by aNumber."
    <primitive: 29>
    ^super * aNumber! !

! Integer methods ! 
+ aNumber
        "Answer the sum of the receiver and aNumber."
    <primitive: 21>
    ^super + aNumber! !

! Integer methods ! 
- aNumber
        "Answer the difference between
         the receiver and aNumber."
    <primitive: 22>
    ^super - aNumber! !

! Integer methods !   
/ aNumber
        "Answer the result of dividing
         the receiver by aNumber."
    | numerator denominator gcd |
    ((aNumber isKindOf: Integer) or:
        [aNumber class == Fraction])
        ifFalse: [^super / aNumber].
    numerator := self * aNumber denominator.
    (denominator := aNumber numerator) < 0
        ifTrue: [
            denominator := 0 - denominator.
            numerator := 0 - numerator].
    (gcd := numerator gcd: denominator) = denominator
        ifTrue: [^numerator // gcd]
        ifFalse: [
            ^Fraction
                numerator: numerator // gcd
                denominator: denominator // gcd]! !

! Integer methods !
< aNumber
        "Answer true if the receiver is less
         than aNumber, else answer false."
    <primitive: 23>
    ^super < aNumber! !

! Integer methods !  
<= aNumber
        "Answer true if the receiver is less than
         or equal to aNumber, else answer false."
    <primitive: 25>
    ^super <= aNumber! !

! Integer methods !
= aNumber
        "Answer true if the receiver is equal
         to aNumber, else answer false."
    <primitive: 27>
    ^super = aNumber! !

! Integer methods !   
> aNumber
        "Answer true if the receiver is greater
         than aNumber, else answer false."
    <primitive: 24>
    ^super > aNumber! !

! Integer methods !   
>= aNumber
        "Answer true if the receiver is greater than
         or equal to aNumber, else answer false."
    <primitive: 26>
    ^super >= aNumber! !

! Integer methods ! 
generalizer
        "Answer a message which can be sent to a class
        to transform an Integer into an instance of that class."
    ^#fromInteger:! !


! Point class methods !  
fromComplex: aComplex
        "Coerce aComplex to a Point."
    ^Point new x: aComplex real; y: aComplex imaginary! !

! Point class methods !
fromFloat: aFloat
        "Coerce aFloat to a Point."
    ^Point new x: aFloat; y: aFloat! !

! Point class methods ! 
fromFraction: aFraction
        "Coerce aFraction to a Point."
    ^Point new x: aFraction; y: aFraction! !

! Point class methods !  
fromInteger: anInteger
        "Coerce anInteger to a Point."
    ^Point new x: anInteger; y: anInteger! !

! Point methods ! 
generalizer
        "Answer a message which can be sent to a class
        to transform a Point into an instance of that class."
    ^#fromPoint:! !

-- 
cowan@marob.masa.com			(aka ...!hombre!marob!cowan)
			e'osai ko sarji la lojban