!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: fractio.gs,v 1.12 2008-01-09 22:50:10 stever Exp $
!
! Superclass Hierarchy:
!   Fraction, Number, Magnitude, Object.
!
!=========================================================================

removeallmethods Fraction
removeallclassmethods Fraction

category: 'For Documentation Installation only'
classmethod: Fraction
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'A Fraction is a Number represented as the ratio of two Integers.'.
doc documentClassWith: txt.

txt := (GsDocText new) details:
'The numerator of the Fraction (an Integer).'.
doc documentInstVar: #numerator with: txt.

txt := (GsDocText new) details:
'The denominator of the Fraction (an Integer).'.
doc documentInstVar: #denominator with: txt.

txt := (GsDocText new) details:
'Do not send class Fraction the message new.  Fractions created in that way are
 meaningless and cannot be handled properly by GemStone''s associative access
 mechanism.  To create a new Fraction, use one of the instance creation methods
 listed here.'.
doc documentClassCategory: #'Instance Creation' with: txt.

self description: doc.
%

category: 'Instance Creation'
classmethod: Fraction
fromStream: aStream

"Returns a Fraction from the stream.  The stream must contain two Integers
 separated by a slash.  (There may be blanks around the slash.)  Generates an
 error if the stream contains anything else, or if an attempt is made to read
 beyond the end of the stream."

| ch n d |

self _checkReadStream: aStream forClass: CharacterCollection.

ch := aStream next.
[ ch isEquivalent: $ ]
whileTrue:
  [ ch := aStream next ].
aStream position: (aStream position - 1).
n := Integer fromStream: aStream.
ch := aStream next.
[ ch isEquivalent: $ ]
whileTrue:
  [ ch := aStream next ].
aStream position: (aStream position - 1).
(aStream next isEquivalent: $/)
ifFalse:[ ^ self _errIncorrectFormat: aStream ].
ch := aStream next.
[ ch isEquivalent: $ ]
whileTrue:
  [ ch := aStream next ].
aStream position: (aStream position - 1).
d := Integer fromStream: aStream.
^ Fraction numerator: n denominator: d
%

category: 'Instance Creation'
classmethod: Fraction
numerator: numInt denominator: denomInt

"Returns an instance of Fraction with numerator numInt and denominator
 denomInt.  If that Fraction can be reduced, this method returns the
 corresponding Integer instead.  The result is made invariant.

 If either argument (numerator or denominator) is not an Integer, that
 argument is truncated to the corresponding Integer."

^ (self new _setNumerator: numInt denominator: denomInt) 
    _reduce immediateInvariant
%

category: 'Accessing'
method: Fraction
at: anIndex

"Disallowed."

self shouldNotImplement: #at:
%

category: 'Accessing'
method: Fraction
at: anIndex put: aNumber

"Disallowed.  You may not change the value of a Fraction."

self shouldNotImplement: #at:put:
%

category: 'Accessing'
method: Fraction
denominator

"Returns the denominator of the receiver."

^denominator
%

category: 'Accessing'
method: Fraction
instVarAt: anIndex put: aValue

"Disallowed.  You may not change the value of a Fraction."

self shouldNotImplement: #instVarAt:put:
%

category: 'Accessing'
method: Fraction
numerator

"Returns the numerator of the receiver."

^numerator
%

category: 'Accessing'
method: Fraction
size: anInteger

"Disallowed.  You may not change the size of a Fraction."

self shouldNotImplement: #size:
%

category: 'Private'
method: Fraction
_setNumerator: n denominator: d

"If either the numerator or denominator is not an Integer, this method performs
 the truncation.  It then assigns the numerator and denominator.  

 The receiver must still be variant.  The sender is responsible for making the
 receiver invariant."

(d = 0) ifTrue: [
  "must check that n is a Number since this method
   can be sent by Fraction|numerator:denominator:
   with any arguments"
  n _validateClass: Number.
  ^ n _errorDivideByZero 
  ].

"truncate arguments if needed."
numerator := n truncated.
denominator := d truncated abs.
(d < 0) ifTrue: [numerator := numerator negated] .

%

category: 'Private'
method: Fraction
_reduce

""

| gcd |

"reduce to form using least common denominator."
(numerator == 0) ifTrue: [ ^0 ].
gcd := numerator gcd: denominator.
numerator := numerator // gcd.
denominator := denominator // gcd.
(denominator == 1) ifTrue:[ 
  ^ numerator 
  ].
^ self 
%

category: 'Formatting'
method: Fraction
asString

"Returns a String of the form 'numerator/denominator'."

| result |
result := numerator asString .
result add: $/ ; addAll: denominator asString .
^ result
%

category: 'Converting'
method: Fraction
asScaledDecimal: scale

"Returns a ScaledDecimal representation of the receiver."

^ ScaledDecimal numerator: numerator denominator: denominator scale: scale.
%

! asFloat rewritten for fix 36173
category: 'Converting'
method: Fraction
asFloat

"Returns an instance of SmallDouble or Float that has the value of the receiver."
| nParts dParts mantiss exp |

numerator == nil ifTrue:[ ^ PlusSignalingNaN ] .
denominator == nil ifTrue:[ ^ PlusSignalingNaN ] .

"avoid loss of precision by handling mantissa and exponents separately"
nParts := numerator _floatParts .
dParts := denominator _floatParts .
mantiss := (nParts at:1) / (dParts at:1) .
exp := (nParts at:2) - (dParts at:2) .
^ mantiss * (2.0 raisedToInteger: exp ) 
%


category: 'Converting'
method: Fraction
asDecimalFloat

"Returns an instance of DecimalFloat that has the value of the receiver."

numerator == nil ifTrue:[ ^ DecimalPlusSignalingNaN ] .
denominator == nil ifTrue:[ ^ DecimalPlusSignalingNaN ] .
^ numerator asDecimalFloat / denominator asDecimalFloat
%

category: 'Converting'
method: Fraction
asFraction

"(R) Returns the receiver."

^self
%

category: 'Converting'
method: Fraction
_coerce: aNumber

"Reimplemented from Number."

^aNumber asFraction
%

category: 'Converting'
method: Fraction
_generality

"Reimplemented from Number."

^70
%

category: 'Comparing'
method: Fraction
~= aFraction

"Returns true if the receiver is not equal to aFraction; returns false
 otherwise."


(numerator == nil) | (denominator == nil) ifTrue:[ ^ true "bugfix 33880" ].
(aFraction isKindOf: Fraction) ifTrue:[
  (aFraction numerator == nil) | (aFraction denominator == nil) ifTrue:[
     ^ true "bugfix 33880"
     ].
  ].

^super ~= aFraction
%

category: 'Comparing'
method: Fraction
>= aFraction

"Returns true if the receiver is greater than aFraction; returns false
 otherwise."

((((numerator == nil) _or: [denominator == nil]) _or:
[aFraction numerator == nil]) _or: [aFraction denominator == nil])
  ifTrue: [^ false ].
"need to handle NaNs correctly"
^aFraction <= self
%

category: 'Comparing'
method: Fraction
> aFraction

"Returns true if the receiver is greater than aFraction; returns false
 otherwise."

((((numerator == nil) _or: [denominator == nil]) _or:
[aFraction numerator == nil]) _or: [aFraction denominator == nil])
  ifTrue: [^ false ].
^super > aFraction
%

category: 'Comparing'
method: Fraction
<= aFraction

"Returns true if the receiver is less than or equal to aFraction; returns false
 otherwise."

(aFraction _getKind > 4) 
  ifTrue: [ 
    "NaN"
    ^ false 
  ].
((((numerator == nil) _or: [denominator == nil]) _or:
[aFraction numerator == nil]) _or: [aFraction denominator == nil])
  ifTrue: [^ false ].
^super <= aFraction
%

! edits to fix 36653
category: 'Comparing'
method: Fraction
< aFraction

"Returns true if the receiver is less than aFraction; returns false otherwise."

((((numerator == nil) _or: [denominator == nil]) _or:
[aFraction numerator == nil]) _or: [aFraction denominator == nil])
  ifTrue: [^ false ].
(aFraction _class == Fraction) ifTrue: [
  (aFraction numerator == 0) ifTrue: [  
    ^ numerator < 0
  ] ifFalse: [
    ^ (numerator * aFraction denominator) < (denominator * aFraction numerator)
  ]
] ifFalse: [
  ^self _retry: #< coercing: aFraction
]
%

category: 'Comparing'
method: Fraction
= aFraction

"Returns true if the receiver is equal to aFraction; returns false otherwise."

(aFraction isKindOf: Fraction)
  ifTrue: [
    ((((numerator == nil) _or: [denominator == nil]) _or:
    [aFraction numerator == nil]) _or: [aFraction denominator == nil])
    ifTrue: [^ false ].
  ].
(aFraction _class == Fraction)
  ifTrue: [
    (aFraction numerator == 0)
      ifTrue: [^numerator == 0]
      ifFalse: [
        ^aFraction numerator = numerator
        _and: [aFraction denominator = denominator]
      ]
  ]
  ifFalse: [^self _retry: #= coercing: aFraction]
%

! hash inherited from Number

category: 'Truncation and Rounding'
method: Fraction
truncated

"Returns the integer that is closest to the receiver, on the same side
 of the receiver as zero is located."

^numerator quo: denominator
%

category: 'Arithmetic'
method: Fraction
* aFraction

"Returns the result of multiplying the receiver by aFraction."

(aFraction _class == Fraction)
  ifTrue: [^(Fraction
           numerator: numerator * aFraction numerator
           denominator: denominator * aFraction denominator)]
  ifFalse: [^self _retry: #* coercing: aFraction]
%

category: 'Arithmetic'
method: Fraction
+ aFraction

"Returns the sum of the receiver and aFraction."

| commonDenominator newNumerator |
(aFraction _class == Fraction)
   ifTrue:
      [(denominator = aFraction denominator)
         ifTrue: [^(Fraction
                  numerator: numerator + aFraction numerator
                  denominator: denominator)].
      commonDenominator := denominator lcm: aFraction denominator.
      newNumerator := numerator
                     * (commonDenominator / denominator)
                     + (aFraction numerator *
                        (commonDenominator / aFraction denominator)).
      ^(Fraction
         numerator: newNumerator
         denominator: commonDenominator)]
   ifFalse: [^self _retry: #+ coercing: aFraction]
%

category: 'Arithmetic'
method: Fraction
- aFraction

"Returns the difference between the receiver and aFraction."

(aFraction _class == Fraction)
  ifTrue: [^self + aFraction negated]
  ifFalse: [^self _retry: #- coercing: aFraction]
%

category: 'Arithmetic'
method: Fraction
/ aFraction

"Returns the result of dividing the receiver by aFraction."

(aFraction _class == Fraction)
  ifTrue: [^self * aFraction reciprocal]
  ifFalse: [^self _retry: #/ coercing: aFraction]
%

category: 'Arithmetic'
method: Fraction
negated

"Returns a Number that is the negation of the receiver."

^Fraction numerator: numerator negated denominator: denominator
%

category: 'Arithmetic'
method: Fraction
reciprocal

"Returns 1 divided by the receiver.  Generates an error if the receiver is 0."

(numerator == 0) ifTrue: [ ^ self _errorDivideByZero].
(numerator == 1) ifTrue: [^denominator].
(numerator == -1) ifTrue: [^denominator negated].
^Fraction numerator: denominator denominator: numerator
%

category: 'Storing and Loading'
classmethod: Fraction
loadFrom: passiveObj

"Reads from passiveObj the passive form of an object.  Converts the object to
 its active form by loading the information into a new instance of the receiver.
 Returns the new instance."

| inst num den |

passiveObj readNamedIV.
num := passiveObj ivValue.
passiveObj readNamedIV.
den := passiveObj ivValue.
  
passiveObj skipNamedInstVars.

inst := self numerator: num denominator: den.
passiveObj hasRead: inst.
^inst.
%

category: 'Storing and Loading'
method: Fraction
writeTo: passiveObj

"Converts the receiver to its passive form and writes that information on
 passiveObj."

"Reimplemented from Number since the receiver has a non-literal representation."

^super basicWriteTo: passiveObj
%

category: 'Testing'
method: Fraction
even

"(R) Returns true if the receiver is an even integer, false otherwise."
^ false.
%

category: 'Testing'
method: Fraction
odd

"(R) Returns true if the receiver is an odd integer, false otherwise."
^ false.
%

category: 'Indexing Support'
method: Fraction
_isNaN

"Returns whether the receiver is quiet NaN or signaling NaN.
 This method is only to be used by the indexing subsystem."

^ (numerator == nil) _or: [denominator == nil]
%
