limited shortFloat support
authorClaus Gittinger <cg@exept.de>
Wed, 17 Apr 1996 12:43:09 +0200
changeset 1200 cc16f7a00b52
parent 1199 c37d927155e2
child 1201 24a5faa7e305
limited shortFloat support
ArithVal.st
ArithmeticValue.st
Fraction.st
LPReal.st
LimitedPrecisionReal.st
SFloat.st
ShortFloat.st
--- a/ArithVal.st	Wed Apr 17 12:32:29 1996 +0200
+++ b/ArithVal.st	Wed Apr 17 12:43:09 1996 +0200
@@ -282,6 +282,14 @@
     ^ self truncated
 !
 
+asShortFloat
+    "return a shortFloat with same value"
+
+   ^ self asFloat asShortFloat
+
+    "Modified: 17.4.1996 / 12:21:35 / cg"
+!
+
 coerce:aNumber
     "convert aNumber into an instance of the receivers class and return it."
 
@@ -314,34 +322,37 @@
 
 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."
+     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."
 
     |myGenerality otherGenerality|
 
     (aSymbol == #=) ifTrue:[
-	(aNumber respondsTo:#generality) ifFalse:[^ false]
+        (aNumber respondsTo:#generality) ifFalse:[^ false]
     ] ifFalse:[
-	(aNumber respondsTo:#generality) ifFalse:[
-	    self error:'retry:coercing: argument is not a number'.
-	    ^ self
-	]
+        (aNumber respondsTo:#generality) ifFalse:[
+            self error:'retry:coercing: argument is not a number'.
+            ^ self
+        ]
     ].
+
     myGenerality := self generality.
     otherGenerality := aNumber generality.
     (myGenerality > otherGenerality) ifTrue:[
-	^ self perform:aSymbol with:(self coerce:aNumber)
+        ^ self perform:aSymbol with:(self coerce:aNumber)
     ].
     (myGenerality < otherGenerality) ifTrue:[
-	^ (aNumber coerce:self) perform:aSymbol with:aNumber
+        ^ (aNumber coerce:self) perform:aSymbol with:aNumber
     ].
     self error:'retry:coercing: oops - same generality'
+
+    "Modified: 17.4.1996 / 12:38:40 / cg"
 ! !
 
 !ArithmeticValue methodsFor:'double dispatching'!
@@ -367,6 +378,15 @@
     ^ anInteger retry:#- coercing:self
 !
 
+differenceFromShortFloat:aShortFloat
+    "the receiver does not know how to subtract from a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#- coercing:self
+
+    "Created: 17.4.1996 / 12:33:16 / cg"
+!
+
 lessFromFloat:aFloat
     "the receiver does not know how to compare to a float -
      retry the operation by coercing to higher generality"
@@ -388,6 +408,15 @@
     ^ anInteger retry:#< coercing:self
 !
 
+lessFromShortFloat:aShortFloat
+    "the receiver does not know how to compare to a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#< coercing:self
+
+    "Modified: 17.4.1996 / 12:33:33 / cg"
+!
+
 productFromFloat:aFloat
     "the receiver does not know how to multiply a float -
      retry the operation by coercing to higher generality"
@@ -409,6 +438,15 @@
     ^ anInteger retry:#* coercing:self
 !
 
+productFromShortFloat:aShortFloat
+    "the receiver does not know how to multiply a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#* coercing:self
+
+    "Created: 17.4.1996 / 12:33:48 / cg"
+!
+
 quotientFromFloat:aFloat
     "the receiver does not know how to divide a float -
      retry the operation by coercing to higher generality"
@@ -430,6 +468,15 @@
     ^ anInteger retry:#/ coercing:self
 !
 
+quotientFromShortFloat:aShortFloat
+    "the receiver does not know how to divide a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#/ coercing:self
+
+    "Created: 17.4.1996 / 12:34:00 / cg"
+!
+
 sumFromFloat:aFloat
     "the receiver does not know how to add a float -
      retry the operation by coercing to higher generality"
@@ -449,6 +496,15 @@
      retry the operation by coercing to higher generality"
 
     ^ anInteger retry:#+ coercing:self
+!
+
+sumFromShortFloat:aShortFloat
+    "the receiver does not know how to add a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#+ coercing:self
+
+    "Created: 17.4.1996 / 12:34:10 / cg"
 ! !
 
 !ArithmeticValue methodsFor:'misc math'!
@@ -669,6 +725,6 @@
 !ArithmeticValue class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ArithVal.st,v 1.18 1996-04-13 12:35:23 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ArithVal.st,v 1.19 1996-04-17 10:42:32 cg Exp $'
 ! !
 ArithmeticValue initialize!
--- a/ArithmeticValue.st	Wed Apr 17 12:32:29 1996 +0200
+++ b/ArithmeticValue.st	Wed Apr 17 12:43:09 1996 +0200
@@ -282,6 +282,14 @@
     ^ self truncated
 !
 
+asShortFloat
+    "return a shortFloat with same value"
+
+   ^ self asFloat asShortFloat
+
+    "Modified: 17.4.1996 / 12:21:35 / cg"
+!
+
 coerce:aNumber
     "convert aNumber into an instance of the receivers class and return it."
 
@@ -314,34 +322,37 @@
 
 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."
+     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."
 
     |myGenerality otherGenerality|
 
     (aSymbol == #=) ifTrue:[
-	(aNumber respondsTo:#generality) ifFalse:[^ false]
+        (aNumber respondsTo:#generality) ifFalse:[^ false]
     ] ifFalse:[
-	(aNumber respondsTo:#generality) ifFalse:[
-	    self error:'retry:coercing: argument is not a number'.
-	    ^ self
-	]
+        (aNumber respondsTo:#generality) ifFalse:[
+            self error:'retry:coercing: argument is not a number'.
+            ^ self
+        ]
     ].
+
     myGenerality := self generality.
     otherGenerality := aNumber generality.
     (myGenerality > otherGenerality) ifTrue:[
-	^ self perform:aSymbol with:(self coerce:aNumber)
+        ^ self perform:aSymbol with:(self coerce:aNumber)
     ].
     (myGenerality < otherGenerality) ifTrue:[
-	^ (aNumber coerce:self) perform:aSymbol with:aNumber
+        ^ (aNumber coerce:self) perform:aSymbol with:aNumber
     ].
     self error:'retry:coercing: oops - same generality'
+
+    "Modified: 17.4.1996 / 12:38:40 / cg"
 ! !
 
 !ArithmeticValue methodsFor:'double dispatching'!
@@ -367,6 +378,15 @@
     ^ anInteger retry:#- coercing:self
 !
 
+differenceFromShortFloat:aShortFloat
+    "the receiver does not know how to subtract from a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#- coercing:self
+
+    "Created: 17.4.1996 / 12:33:16 / cg"
+!
+
 lessFromFloat:aFloat
     "the receiver does not know how to compare to a float -
      retry the operation by coercing to higher generality"
@@ -388,6 +408,15 @@
     ^ anInteger retry:#< coercing:self
 !
 
+lessFromShortFloat:aShortFloat
+    "the receiver does not know how to compare to a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#< coercing:self
+
+    "Modified: 17.4.1996 / 12:33:33 / cg"
+!
+
 productFromFloat:aFloat
     "the receiver does not know how to multiply a float -
      retry the operation by coercing to higher generality"
@@ -409,6 +438,15 @@
     ^ anInteger retry:#* coercing:self
 !
 
+productFromShortFloat:aShortFloat
+    "the receiver does not know how to multiply a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#* coercing:self
+
+    "Created: 17.4.1996 / 12:33:48 / cg"
+!
+
 quotientFromFloat:aFloat
     "the receiver does not know how to divide a float -
      retry the operation by coercing to higher generality"
@@ -430,6 +468,15 @@
     ^ anInteger retry:#/ coercing:self
 !
 
+quotientFromShortFloat:aShortFloat
+    "the receiver does not know how to divide a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#/ coercing:self
+
+    "Created: 17.4.1996 / 12:34:00 / cg"
+!
+
 sumFromFloat:aFloat
     "the receiver does not know how to add a float -
      retry the operation by coercing to higher generality"
@@ -449,6 +496,15 @@
      retry the operation by coercing to higher generality"
 
     ^ anInteger retry:#+ coercing:self
+!
+
+sumFromShortFloat:aShortFloat
+    "the receiver does not know how to add a shortFloat -
+     retry the operation by coercing to higher generality"
+
+    ^ aShortFloat retry:#+ coercing:self
+
+    "Created: 17.4.1996 / 12:34:10 / cg"
 ! !
 
 !ArithmeticValue methodsFor:'misc math'!
@@ -669,6 +725,6 @@
 !ArithmeticValue class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.18 1996-04-13 12:35:23 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.19 1996-04-17 10:42:32 cg Exp $'
 ! !
 ArithmeticValue initialize!
--- a/Fraction.st	Wed Apr 17 12:32:29 1996 +0200
+++ b/Fraction.st	Wed Apr 17 12:43:09 1996 +0200
@@ -11,10 +11,10 @@
 "
 
 Number subclass:#Fraction
-	 instanceVariableNames:'numerator denominator'
-	 classVariableNames:'FractionOne FractionZero'
-	 poolDictionaries:''
-	 category:'Magnitude-Numbers'
+	instanceVariableNames:'numerator denominator'
+	classVariableNames:'FractionOne FractionZero'
+	poolDictionaries:''
+	category:'Magnitude-Numbers'
 !
 
 !Fraction class methodsFor:'documentation'!
@@ -268,6 +268,14 @@
     ^ self asInteger asLargeInteger
 !
 
+asShortFloat
+    "return a shortFloat with (approximately) my value"
+
+    ^ (numerator asShortFloat) / (denominator asShortFloat)
+
+    "Created: 17.4.1996 / 12:21:08 / cg"
+!
+
 coerce:aNumber
     "return aNumber converted into receivers type"
 
@@ -470,6 +478,6 @@
 !Fraction class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.27 1996-04-02 22:01:58 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.28 1996-04-17 10:43:09 cg Exp $'
 ! !
 Fraction initialize!
--- a/LPReal.st	Wed Apr 17 12:32:29 1996 +0200
+++ b/LPReal.st	Wed Apr 17 12:43:09 1996 +0200
@@ -11,10 +11,10 @@
 "
 
 Number subclass:#LimitedPrecisionReal
-	 instanceVariableNames:''
-	 classVariableNames:''
-	 poolDictionaries:''
-	 category:'Magnitude-Numbers'
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Magnitude-Numbers'
 !
 
 !LimitedPrecisionReal class methodsFor:'documentation'!
@@ -76,28 +76,52 @@
 * aNumber
     "return the product of the receiver and the argument, aNumber"
 
-    ^ aNumber productFromDouble:self asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber productFromDouble:self asDouble
+
+    ^ aNumber productFromFloat:self asFloat
+
+    "Modified: 17.4.1996 / 12:35:36 / cg"
 !
 
 + aNumber
     "return the sum of the receiver and the argument, aNumber"
 
-    ^ aNumber sumFromDouble:self asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber sumFromDouble:self asDouble
+
+    ^ aNumber sumFromFloat:self asFloat
+
+    "Modified: 17.4.1996 / 12:35:55 / cg"
 !
 
 - aNumber
     "return the difference of the receiver and the argument, aNumber"
 
-    ^ aNumber differenceFromDouble:self asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber differenceFromDouble:self asDouble
+
+    ^ aNumber differenceFromFloat:self asFloat
+
+    "Modified: 17.4.1996 / 12:36:07 / cg"
 !
 
 / aNumber
     "return the quotient of the receiver and the argument, aNumber"
 
     ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
-	^ DivisionByZeroSignal raise.
+        ^ DivisionByZeroSignal raise.
     ].
-    ^ aNumber quotientFromDouble:self asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber quotientFromDouble:self asDouble
+
+    ^ aNumber quotientFromFloat:self asFloat
+
+    "Modified: 17.4.1996 / 12:36:21 / cg"
 !
 
 // aNumber
@@ -166,7 +190,13 @@
 coerce:aNumber
     "return aNumber converted into receivers type"
 
-    ^ aNumber asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber asDouble
+
+    ^ aNumber asFloat
+
+    "Modified: 17.4.1996 / 12:36:46 / cg"
 !
 
 generality
@@ -281,6 +311,14 @@
      the argument, aStream"
 
     aStream nextPutAll:self printString
+!
+
+printString
+    "return a printed representation of the receiver"
+
+    ^ self subclassResponsibility
+
+    "Created: 17.4.1996 / 12:12:20 / cg"
 ! !
 
 !LimitedPrecisionReal methodsFor:'testing'!
@@ -318,5 +356,5 @@
 !LimitedPrecisionReal class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/LPReal.st,v 1.11 1995-12-07 21:35:42 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/LPReal.st,v 1.12 1996-04-17 10:41:53 cg Exp $'
 ! !
--- a/LimitedPrecisionReal.st	Wed Apr 17 12:32:29 1996 +0200
+++ b/LimitedPrecisionReal.st	Wed Apr 17 12:43:09 1996 +0200
@@ -11,10 +11,10 @@
 "
 
 Number subclass:#LimitedPrecisionReal
-	 instanceVariableNames:''
-	 classVariableNames:''
-	 poolDictionaries:''
-	 category:'Magnitude-Numbers'
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Magnitude-Numbers'
 !
 
 !LimitedPrecisionReal class methodsFor:'documentation'!
@@ -76,28 +76,52 @@
 * aNumber
     "return the product of the receiver and the argument, aNumber"
 
-    ^ aNumber productFromDouble:self asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber productFromDouble:self asDouble
+
+    ^ aNumber productFromFloat:self asFloat
+
+    "Modified: 17.4.1996 / 12:35:36 / cg"
 !
 
 + aNumber
     "return the sum of the receiver and the argument, aNumber"
 
-    ^ aNumber sumFromDouble:self asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber sumFromDouble:self asDouble
+
+    ^ aNumber sumFromFloat:self asFloat
+
+    "Modified: 17.4.1996 / 12:35:55 / cg"
 !
 
 - aNumber
     "return the difference of the receiver and the argument, aNumber"
 
-    ^ aNumber differenceFromDouble:self asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber differenceFromDouble:self asDouble
+
+    ^ aNumber differenceFromFloat:self asFloat
+
+    "Modified: 17.4.1996 / 12:36:07 / cg"
 !
 
 / aNumber
     "return the quotient of the receiver and the argument, aNumber"
 
     ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
-	^ DivisionByZeroSignal raise.
+        ^ DivisionByZeroSignal raise.
     ].
-    ^ aNumber quotientFromDouble:self asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber quotientFromDouble:self asDouble
+
+    ^ aNumber quotientFromFloat:self asFloat
+
+    "Modified: 17.4.1996 / 12:36:21 / cg"
 !
 
 // aNumber
@@ -166,7 +190,13 @@
 coerce:aNumber
     "return aNumber converted into receivers type"
 
-    ^ aNumber asDouble
+"/ as soon as Float are float & Double are doubles,
+"/ use:
+"/    ^ aNumber asDouble
+
+    ^ aNumber asFloat
+
+    "Modified: 17.4.1996 / 12:36:46 / cg"
 !
 
 generality
@@ -281,6 +311,14 @@
      the argument, aStream"
 
     aStream nextPutAll:self printString
+!
+
+printString
+    "return a printed representation of the receiver"
+
+    ^ self subclassResponsibility
+
+    "Created: 17.4.1996 / 12:12:20 / cg"
 ! !
 
 !LimitedPrecisionReal methodsFor:'testing'!
@@ -318,5 +356,5 @@
 !LimitedPrecisionReal class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/LimitedPrecisionReal.st,v 1.11 1995-12-07 21:35:42 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/LimitedPrecisionReal.st,v 1.12 1996-04-17 10:41:53 cg Exp $'
 ! !
--- a/SFloat.st	Wed Apr 17 12:32:29 1996 +0200
+++ b/SFloat.st	Wed Apr 17 12:43:09 1996 +0200
@@ -285,6 +285,14 @@
     "return a ShortFloat with same value as the receiver - thats me"
 
     ^ self
+!
+
+generality
+    "return the generality value - see ArithmeticValue>>retry:coercing:"
+
+    ^ 70
+
+
 ! !
 
 !ShortFloat methodsFor:'comparing'!
@@ -306,7 +314,9 @@
 %}.
     ^ aNumber lessFromShortFloat:self
 
-
+    "
+     1.0 asShortFloat > (1/3)
+    "
 !
 
 <= aNumber
@@ -512,5 +522,5 @@
 !ShortFloat class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/SFloat.st,v 1.1 1996-04-17 10:30:43 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/SFloat.st,v 1.2 1996-04-17 10:42:07 cg Exp $'
 ! !
--- a/ShortFloat.st	Wed Apr 17 12:32:29 1996 +0200
+++ b/ShortFloat.st	Wed Apr 17 12:43:09 1996 +0200
@@ -285,6 +285,14 @@
     "return a ShortFloat with same value as the receiver - thats me"
 
     ^ self
+!
+
+generality
+    "return the generality value - see ArithmeticValue>>retry:coercing:"
+
+    ^ 70
+
+
 ! !
 
 !ShortFloat methodsFor:'comparing'!
@@ -306,7 +314,9 @@
 %}.
     ^ aNumber lessFromShortFloat:self
 
-
+    "
+     1.0 asShortFloat > (1/3)
+    "
 !
 
 <= aNumber
@@ -512,5 +522,5 @@
 !ShortFloat class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.1 1996-04-17 10:30:43 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.2 1996-04-17 10:42:07 cg Exp $'
 ! !