"
 COPYRIGHT (c) 1988 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.
"

ArithmeticValue subclass:#Number
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'Magnitude-Numbers'
!

!Number class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1988 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
"
    abstract superclass for all kinds of numbers
"
! !

!Number class methodsFor:'instance creation'!

readFrom:aStringOrStream onError:exceptionBlock
    "return the next Number from the (character-)stream aStream;
     skipping all whitespace first; return the value of exceptionBlock,
     if no number can be read."

    |str nextChar radix value negative signExp freakOut|

    str := aStringOrStream readStream.

    ErrorSignal handle:[:ex |
        ^ exceptionBlock value
    ] do:[
        nextChar := str skipSeparators.
        nextChar isNil ifTrue:[^ exceptionBlock value].

        freakOut := [^ exceptionBlock value].

        (nextChar == $-) ifTrue:[
            negative := true.
            nextChar := str nextPeek
        ] ifFalse:[
            negative := false.
            (nextChar == $+) ifTrue:[
                nextChar := str nextPeek
            ]
        ].
        nextChar isDigit ifFalse:[
            ^ exceptionBlock value.
"/          value := super readFrom:str.
"/          negative ifTrue:[value := value negated].
"/          ^ value
        ].
        value := Integer readFrom:str radix:10 onError:freakOut.
        nextChar := str peek.
        ((nextChar == $r) or:[ nextChar == $R]) ifTrue:[
            str next.
            radix := value.
            value := Integer readFrom:str radix:radix onError:freakOut.
        ] ifFalse:[
            radix := 10
        ].
        (nextChar == $.) ifTrue:[
            nextChar := str nextPeek.
            (nextChar notNil and:[nextChar isDigitRadix:radix]) ifTrue:[
                value := value asFloat 
                         + (Number readMantissaFrom:str radix:radix).
                nextChar := str peek
            ]
        ].
        ((nextChar == $e) or:[nextChar == $E]) ifTrue:[
            nextChar := str nextPeek.
            signExp := 1.
            (nextChar == $+) ifTrue:[
                nextChar := str nextPeek
            ] ifFalse:[
                (nextChar == $-) ifTrue:[
                    nextChar := str nextPeek.
                    signExp := -1
                ]
            ].
            (nextChar notNil and:[(nextChar isDigitRadix:radix)]) ifTrue:[
                value := value asFloat 
                         * (10.0 raisedToInteger:
                                    ((Integer readFrom:str radix:radix onError:freakOut) * signExp))
            ]
        ].
        negative ifTrue:[
            ^ value negated
        ].
        ^ value
    ]

    "
     Number readFrom:(ReadStream on:'54.32e-01')      
     Number readFrom:(ReadStream on:'12345678901234567890') 
     Number readFrom:(ReadStream on:'16rAAAAFFFFAAAAFFFF') 
     Number readFrom:'16rAAAAFFFFAAAAFFFF' 
     Number readFrom:'0.000001'  
     '+00000123.45' asNumber  
    "

    "Modified: 20.2.1996 / 20:24:19 / cg"
!

readSmalltalkSyntaxFrom:aStream
    "ST-80 compatibility (thanks to a note from alpha testers)
     read and return the next Number in smalltalk syntax from the 
     (character-)stream aStream."

    ^ Compiler evaluate:aStream compile:false "/ self readFrom:aStream.

    "
     Number readSmalltalkSyntaxFrom:(ReadStream on:'54.32e-01')    
     Number readSmalltalkSyntaxFrom:(ReadStream on:'12345678901234567890')
     Number readSmalltalkSyntaxFrom:(ReadStream on:'16rAAAAFFFFAAAAFFFF')
     Number readSmalltalkSyntaxFrom:(ReadStream on:'(1/10)') 
     Number readFrom:(ReadStream on:'(1/10)') 
     Number readSmalltalkSyntaxFrom:(ReadStream on:'+00000123.45')  
     Number readFrom:(ReadStream on:'+00000123.45')  
    "
! !

!Number class methodsFor:'error reporting'!

raise:aSignalSymbol receiver:someNumber selector:sel arg:arg errorString:text 
    "ST-80 compatible signal raising. Provided for PD numeric classes"

    |msg|

    msg := MessageSend
		receiver:someNumber
		selector:sel
		arguments:(Array with:arg).
    ^ (self perform:aSignalSymbol)
	 raiseRequestWith:msg 
	 errorString:text 
	 in:thisContext sender

    "
     Number raise:#domainErrorSignal
	    receiver:1.0
	    selector:#sin
	    arg:nil
	    errorString:'foo bar test'
    "
!

raise:aSignalSymbol receiver:someNumber selector:sel errorString:text 
    "ST-80 compatible signal raising. Provided for PD numeric classes"

    |msg|

    msg := MessageSend
		receiver:someNumber
		selector:sel
		arguments:#().
    ^ (self perform:aSignalSymbol)
	 raiseRequestWith:msg 
	 errorString:text 
	 in:thisContext sender

    "
     Number raise:#domainErrorSignal
	    receiver:1.0
	    selector:#foo 
	    errorString:'foo bar test'
    "
! !

!Number class methodsFor:'private'!

readMantissaFrom:aStream radix:radix
    "helper for readFrom: -
     return the mantissa from the (character-)stream aStream;
     no whitespace-skipping; error if no number available"

    |nextChar value factor|

    value := 0.0.
    factor := 1.0 / radix.
    nextChar := aStream peek.
    [nextChar notNil and:[nextChar isDigitRadix:radix]] whileTrue:[
	value := value + (nextChar digitValue * factor).
	factor := factor / radix.
	nextChar := aStream nextPeek
    ].
    ^ value
! !

!Number methodsFor:'coercing'!

coerce:aNumber
    "return aNumber converted into receivers type"

    ^ self subclassResponsibility
!

generality
    "return the generality value - see ArithmeticValue>>retry:coercing:"

    ^ 40
!

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 comapre for same value (=), return false if
    the argument is not a Number. 
    If the generalities are the same, create an error message."

    |myGenerality otherGenerality|

    (aSymbol == #=) ifTrue:[
	(aNumber respondsTo:#generality) ifFalse:[^ false]
    ] ifFalse:[
	(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)
    ].
    (myGenerality < otherGenerality) ifTrue:[
	^ (aNumber coerce:self) perform:aSymbol with:aNumber
    ].
    self error:'retry:coercing: oops - same generality'
! !

!Number methodsFor:'converting'!

@ aNumber
    "return a Point with the receiver as x-coordinate and the argument
     as y-coordinate"

%{  /* NOCONTEXT */

    /*
     * I cannot tell if this special code is worth anything
     */
    if (__CanDoQuickNew(sizeof(struct __point))) {
	OBJ newPoint;
	int spc;

	__qCheckedAlignedNew(newPoint, sizeof(struct __point));
	_InstPtr(newPoint)->o_class = Point;
	_PointInstPtr(newPoint)->p_x = self;
	_PointInstPtr(newPoint)->p_y = aNumber;
	if (! __bothSmallInteger(self, aNumber)) {
	    spc = __qSpace(newPoint);
	    __STORE_SPC(newPoint, aNumber, spc);
	    __STORE_SPC(newPoint, self, spc);
	}
	RETURN ( newPoint );
    }
%}
.
    ^ Point x:self y:aNumber
!

asPoint
    "return a new Point with the receiver as all coordinates;  
     often used to supply the same value in two dimensions, as with 
     symmetrical gridding or scaling."

%{  /* NOCONTEXT */

    if (__CanDoQuickNew(sizeof(struct __point))) {
	OBJ newPoint;

	__qCheckedAlignedNew(newPoint, sizeof(struct __point));
	_InstPtr(newPoint)->o_class = Point;
	_PointInstPtr(newPoint)->p_x = self;
	_PointInstPtr(newPoint)->p_y = self;
	__STORE(newPoint, self);
	RETURN ( newPoint );
    }
%}.
    ^ Point x:self y:self
!

degreesToRadians
    "interpreting the receiver as radians, return the degrees"

    ^ (self * (Float pi)) / 180.0
!

literalArrayEncoding
    "encode myself as an array literal."

    ^ self

    "Modified: 1.9.1995 / 02:25:26 / claus"
!

radiansToDegrees
    "interpreting the receiver as degrees, return the radians"

    ^ (self * 180.0) / (Float pi)
! !

!Number methodsFor:'intervals'!

to:stop
    "return an interval from receiver up to the argument, incrementing by 1"

    ^ Interval from:self to:stop
!

to:stop by:step
    "return an interval from receiver up to the argument, incrementing by step"

    ^ Interval from:self to:stop by:step
! !

!Number methodsFor:'iteration'!

timesRepeat:aBlock
    "evaluate the argument, aBlock self times"

    |count|

    count := self.
    [count > 0] whileTrue:[
	aBlock value.
	count := count - 1
    ]
!

to:stop by:incr do:aBlock
    "For each element of the interval from the receiver up to the argument stop, incrementing
     by step, evaluate aBlock passing the element as argument."

    |tmp|

    tmp := self.
    (incr > 0) ifTrue:[
	[tmp <= stop] whileTrue:[
	    aBlock value:tmp.
	    tmp := tmp+incr
	]
    ] ifFalse:[
	[tmp >= stop] whileTrue:[
	    aBlock value:tmp.
	    tmp := tmp+incr
	]
    ]
!

to:stop by:incr doWithBreak:aBlock
    "For each element of the interval from the receiver up to the argument stop, incrementing
     by step, evaluate aBlock passing the element as argument.
     Pass a break argument, to allow for premature exit of the loop."

    |tmp break|

    break := [^ self].
    tmp := self.
    (incr > 0) ifTrue:[
	[tmp <= stop] whileTrue:[
	    aBlock value:tmp value:break.
	    tmp := tmp+incr
	]
    ] ifFalse:[
	[tmp >= stop] whileTrue:[
	    aBlock value:tmp value:break.
	    tmp := tmp+incr
	]
    ]

    "
     1 to:100 by:5 doWithBreak:[:index :break |
	Transcript showCr:index printString.
	index > 50 ifTrue:[
	    break value
	].
     ]
    "
!

to:stop do:aBlock
    "For each element of the interval from the receiver up to the argument stop,
     evaluate aBlock, passing the number as argument."

    |tmp|

    tmp := self.
    [tmp <= stop] whileTrue:[
	aBlock value:tmp.
	tmp := tmp+1
    ]
!

to:stop doWithBreak:aBlock
    "For each element of the interval from the receiver up to the argument stop,
     evaluate aBlock, passing the number as argument.
     Pass a break argument, to allow for premature exit of the loop."

    |tmp break|

    break := [^ self].
    tmp := self.
    [tmp <= stop] whileTrue:[
	aBlock value:tmp value:break.
	tmp := tmp+1
    ]

    "
     1 to:10 doWithBreak:[:index :break |
	Transcript showCr:index printString.
	index > 5 ifTrue:[
	    break value
	].
     ]
    "
! !

!Number methodsFor:'printing & storing'!

storeOn:aStream
    "append a string for storing the receiver onto the argument,
     aStream - since numbers are literals,they store as they print."

    ^ self printOn:aStream
!

storeString
    "return a string for storing 
     - since numbers are literals, they store as they print."

    ^ self printString
! !

!Number methodsFor:'testing'!

isLiteral
    "return true, if the receiver can be used as a literal
     (i.e. can be used in constant arrays)"

    ^ true
!

isNumber
    "return true, if the receiver is a kind of number"

    ^ true
!

isZero
    ^ self = 0
! !

!Number class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Number.st,v 1.27 1996-02-20 19:34:33 cg Exp $'
! !