extensions.st
changeset 5293 db346a540bf9
parent 5292 975a4c7373cb
child 5296 825d2a1ce06a
--- a/extensions.st	Mon Nov 25 15:22:11 2019 +0100
+++ b/extensions.st	Mon Nov 25 15:23:34 2019 +0100
@@ -18,6 +18,19 @@
     "Modified (comment): / 25-07-2017 / 16:06:19 / cg"
 ! !
 
+!ArithmeticValue methodsFor:'converting'!
+
+asQuadFloat
+    "return a quadFloat with same value"
+
+    "WARNING: could loose precision here, if not redefined in concrete classes which
+     have more than float precision (i.e. LargeIntegers and Fractions)"
+
+    ^ self asFloat asQuadFloat "/ subclassResponsibility
+
+    "Created: / 07-06-2019 / 02:28:54 / Claus Gittinger"
+! !
+
 !ArithmeticValue methodsFor:'double dispatching'!
 
 differenceFromQDouble:aQDouble
@@ -869,6 +882,20 @@
 
 !Float methodsFor:'coercing & converting'!
 
+asOctaFloat
+    "return an octaFloat with same value as receiver"
+
+    ^ OctaFloat fromFloat:self
+
+    "
+     123 asFloat asOctaFloat
+     0 asFloat asOctaFloat
+     0.0 asOctaFloat
+    "
+! !
+
+!Float methodsFor:'coercing & converting'!
+
 asQDouble
     "return a QDouble with my value"
 
@@ -881,6 +908,80 @@
     "Created: / 13-06-2017 / 16:48:57 / cg"
 ! !
 
+!Float methodsFor:'coercing & converting'!
+
+asQuadFloat
+    "return a quadFloat with same value as receiver"
+
+    ^ QuadFloat fromFloat:self
+
+    "
+     123 asFloat asQuadFloat
+     0 asFloat asQuadFloat
+     0.0 asQuadFloat
+    "
+
+    "Created: / 07-06-2019 / 02:28:26 / Claus Gittinger"
+    "Modified (comment): / 10-06-2019 / 21:51:04 / Claus Gittinger"
+! !
+
+!Fraction methodsFor:'coercing & converting'!
+
+asQuadFloat
+    "return a QuadFloat with (approximately) my value.
+     Since floats have a limited precision, you usually loose bits when doing this."
+
+    |num den numShift denShift numBits rslt|
+
+    (numerator class == SmallInteger and:[denominator class == SmallInteger]) ifTrue:[
+        ^ (numerator asQuadFloat) / (denominator asQuadFloat)
+    ].
+
+    "Do it the hard way: reduce magnitude and undo reduction on the quotient"
+
+    numBits := QuadFloat precision * 2.    "number of bits to preserve (conservative)"
+    num := numerator abs.
+    numShift := numBits - num highBit. "(num highBit - bits) negated"
+    numShift < 0 ifTrue:[num := num bitShift:numShift] ifFalse:[ numShift := 0].
+
+    den :=  denominator.
+    denShift := numBits - den highBit. "(den highBit - bits) negated"
+    denShift < 0 ifTrue:[den := den bitShift:denShift] ifFalse:[denShift := 0].
+
+    rslt := (num asQuadFloat / den asQuadFloat) * (2 raisedToInteger:denShift-numShift).
+    numerator negative ifTrue:[ ^ rslt negated ].
+    ^ rslt.
+
+    "
+      (5/9) asQuadFloat
+      (-5/9) asQuadFloat
+      (Fraction basicNew setNumerator:500000000000 denominator:900000000000) asQuadFloat = (5/9) asQuadFloat
+      (Fraction basicNew setNumerator:500000000001 denominator:900000000000) asQuadFloat = (5/9) asQuadFloat
+      (500000000001/900000000000) asQuadFloat
+      (-500000000001/900000000000) asQuadFloat
+      (500000000001/900000000000) asQuadFloat = (5/9) asQuadFloat
+
+      (500000000000/9) asQuadFloat
+      (5/900000000000) asQuadFloat
+      89012345678901234567 asFloat / 123456789123456789 asQuadFloat
+      (89012345678901234567 / 123456789123456789) asQuadFloat
+      (-89012345678901234567 / 123456789123456789) asQuadFloat
+
+      (
+       180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125
+        /
+       180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250
+      ) asQuadFloat
+
+      180338700661043257034670206806167960222709397862806840937993331366591676308781197477183367018067356365812757479444845320188679437752013593674158587947149815441890236037219685250845721864713487208757788709113534916165172927384095182655935222723385253851776639985379367854545495930551624041981995105743408203125
+         asQuadFloat /
+      180331613628627651967947866455016278082980736719853750685591387625058011528928110602436691256100991596843001549483950600930062886280582766771424470965440873615557144641435276844465734361353086032476712374317224249252177316815544331763696909434844464464323192083930469387098582956241443753242492675781250
+         asQuadFloat
+    "
+
+    "Created: / 07-06-2019 / 02:32:19 / Claus Gittinger"
+! !
+
 !Integer methodsFor:'coercing & converting'!
 
 asOctaFloat
@@ -950,6 +1051,32 @@
     "
 ! !
 
+!LimitedPrecisionReal methodsFor:'coercing & converting'!
+
+asOctaFloat
+    ^ OctaFloat fromLimitedPrecisionReal:self
+
+    "Created: / 07-06-2019 / 02:30:07 / Claus Gittinger"
+! !
+
+!LimitedPrecisionReal methodsFor:'coercing & converting'!
+
+asQuadFloat
+    ^ QuadFloat fromLimitedPrecisionReal:self
+
+    "Created: / 07-06-2019 / 02:30:07 / Claus Gittinger"
+! !
+
+!LongFloat methodsFor:'coercing & converting'!
+
+asQuadFloat
+    "return a QuadFloat with same value as the receiver"
+
+    ^ QuadFloat fromLongFloat:self
+
+    "Created: / 07-06-2019 / 02:46:30 / Claus Gittinger"
+! !
+
 !Object methodsFor:'dependents-interests'!
 
 addInterest:anInterest
@@ -1612,6 +1739,16 @@
     self expressInterestIn:anAspect for:anObject sendBack:anAspect
 ! !
 
+!ShortFloat methodsFor:'coercing & converting'!
+
+asQuadFloat
+    "return a QuadFloat with same value as the receiver"
+
+    ^ QuadFloat fromShortFloat:self
+
+    "Created: / 07-06-2019 / 02:29:14 / Claus Gittinger"
+! !
+
 !Stream methodsFor:'stacked computing streams'!
 
 collecting:aBlock