;; Limits for the C version for compatibility
MAX_PREC MAX_EMAX MIN_EMIN MIN_ETINY))
-(pk 0)
(define-syntax-rule (aif it p . l) (let ((it p)) (if it . l)))
#|
(define __version__ "1.70")
;; Highest version of the spec this complies with
;; See http://speleotrove.com/decimal/
-(pk 1)
(define DecimalTuple (namedtuple "DecimalTuple" "sign,digits,exponent"))
-(pk 2)
+
;; Rounding
(define ROUND_DOWN 'ROUND_DOWN)
(define ROUND_HALF_UP 'ROUND_HALF_UP)
(define ROUND_UP 'ROUND_UP)
(define ROUND_HALF_DOWN 'ROUND_HALF_DOWN)
(define ROUND_05UP 'ROUND_05UP)
-(pk 3)
+
;; Compatibility with the C version
(define MAX_PREC 425000000)
(define MAX_EMAX 425000000)
(define MIN_EMIN -425000000)
-(pk 4)
+
(if (= maxsize (- (ash 1 63) 1))
(begin
(set! MAX_PREC 999999999999999999)
(set! MAX_EMAX 999999999999999999)
(set! MIN_EMIN -999999999999999999)))
-(pk 5)
+
(define MIN_ETINY (- MIN_EMIN (- MAX_PREC 1)))
-(pk 6)
+
;; Context
(define-inlinable (cx-prec x) (rawref x 'prec))
(define-inlinable (cx-emax x) (rawref x 'Emax))
Otherwise (the signal is trapped), only equality comparisons and explicit
conversions are silent. All other mixed operations raise FloatOperation.
")
-(pk 7)
+
;; List of public traps and flags
(define _signals
- (vector Clamped DivisionByZero Inexact Overflow Rounded
- Underflow InvalidOperation Subnormal FloatOperation))
-(pk 8)
+ (list Clamped DivisionByZero Inexact Overflow Rounded
+ Underflow InvalidOperation Subnormal FloatOperation))
+
;; Map conditions (per the spec) to signals
(define _condition_map
`((,ConversionSyntax . ,InvalidOperation)
(,DivisionImpossible . ,InvalidOperation)
(,DivisionUndefined . ,InvalidOperation)
(,InvalidContext . ,InvalidOperation)))
-(pk 9)
+
;; Valid rounding modes
(define _rounding_modes
(list ROUND_DOWN ROUND_HALF_UP ROUND_HALF_EVEN ROUND_CEILING
ROUND_FLOOR ROUND_UP ROUND_HALF_DOWN ROUND_05UP))
-(pk 10)
+
;; ##### Context Functions ##################################################
;; The getcontext() and setcontext() function manage access to a thread-local
(fluid-ref *context*))
(define (setcontext context)
(fluid-set! *context* context))
-(pk 11)
+
;; ##### Decimal class #######################################################
;; Do not subclass Decimal from numbers.Real and do not register it as such
(else
(raise (TypeError
(format #f "Cannot convert ~a to Decimal" value))))))
-(pk 12)
+
(define-inlinable (divmod x y)
(values (quotient x y) (modulo x y)))
((cx-error context) Clamped "Division by infinity")
(_dec_from_triple sign "0" (cx-etiny context))))))
-(pk 13)
+
(define-python-class Decimal (object)
"Floating point class for decimal arithmetic."
((self a b)
(_mk self __init__ a b))))
- (define from_float (pk 1
+ (define from_float
(classmethod
(lambda (cls f)
"Converts a float to a decimal number, exactly.
(res (_dec_from_triple sign m e)))
(if (eq? cls Decimal)
res
- (cls res)))))))))
+ (cls res))))))))
(define _isnan
(lambda (self)
(else 0)))
0)))
- (define _isinfinity (pk 1 1
+ (define _isinfinity
(lambda (self)
"Returns whether the number is infinite
(if (eq? (ref self '_sign) 1)
-1
1)
- 0))))
+ 0)))
(define _check_nans
(lam (self (= other None) (= context None))
(else 0))
0))))
- (define __bool__ (pk 1 2
+ (define __bool__
(lambda (self)
"Return True if self is nonzero; otherwise return False.
NaNs and infinities are considered nonzero.
"
- (or (ref self '_is_special) (not (equal? (ref self '_int) "0"))))))
+ (or (ref self '_is_special) (not (equal? (ref self '_int) "0")))))
(define _cmp
(lambda (self other)
#f)
(else (= ((ref self '_cmp) other) 0))))))
- (define _xlt (pk 1 3
+ (define _xlt
(lambda (<)
(lam (self other (= context None))
(let* ((so (_convert_for_comparison self other #:equality_op #t))
other)
((bool ((ref self '_compare_check_nans) other context))
#f)
- (else (< ((ref self '_cmp) other) 0))))))))
+ (else (< ((ref self '_cmp) other) 0)))))))
(define __lt__ (lambda x (apply (_xlt < ) x)))
(define __le__ (lambda x (apply (_xlt <= ) x)))
(define __gt__ (lambda x (apply (_xlt > ) x)))
(define __ge__ (lambda x (apply (_xlt >= ) x)))
- (define compare (pk 1 4
+ (define compare
(lam (self other (= context None))
"Compare self to other. Return a decimal value:
(ref other '_is_special)))
(aif it ((ref self '_check_nans) other context)
it
- (Decimal ((ref self '_cmp) other))))))))
+ (Decimal ((ref self '_cmp) other)))))))
(define __hash__
(lambda (self)
(values (numerator x)
(denominator x))))))
- (define __repr__ (pk 1 5
+ (define __repr__
(lambda (self)
"Represents the number as an instance of Decimal."
;# Invariant: eval(repr(d)) == d
- (format #f "Decimal('~a')" (str self)))))
+ (format #f "Decimal('~a')" (str self))))
(define __str__
(lam (self (= eng #f) (= context None))
((ref ans '_fix) context)))))
- (define __pos__ (pk 1 6
+ (define __pos__
(lam (self (= context None))
"Returns a copy, unless it is a sNaN.
((ref self 'copy_abs))
(Decimal self))))
- ((ref ans '_fix) context))))))
+ ((ref ans '_fix) context)))))
(define __abs__
(lam (self (= round #t) (= context None))
(set! ans (Decimal result))
((ref ans '_fix) context)))))
- (define __radd__ __add__)
+ (define __radd__ (lambda x (apply __add__ x)))
(define __sub__
(lam (self other (= context None))
((norm-op self other) it it)
((ref other '__mod__) self #:context context))))
- (define remainder_near (pk 2
+ (define remainder_near
(lam (self other (= context None))
"
Remainder nearest to 0- abs(remainder-near) <= other/2
(set! sign (- 1 sign))
(set! r (- r)))
(let ((ans (_dec_from_triple sign (str r) ideal_exponent)))
- ((ref ans '_fix) context)))))))))))
+ ((ref ans '_fix) context))))))))))
(define __floordiv__
(lam (self other (= context None))
(_dec_from_triple sign (str base) 0)))))
- (define _power_exact (pk 3
+ (define _power_exact
(lambda (self other p)
"Attempt to compute self**other exactly.
(min (- xe ideal_exponent)
(- p (len str_xc))))
0)))
- (_dec_from_triple 0 (+ str_xc (* '0' zeros)) (- xe zeros))))))))
+ (_dec_from_triple 0 (+ str_xc (* '0' zeros)) (- xe zeros)))))))
(define __pow__
(lam (self other (= modulo None) (= context None))
rounding)))
ans)))))
- (define to_integral_exact (pk 4
+ (define to_integral_exact
(lam (self (= rounding None) (= context None))
"Rounds to a nearby integer.
((cx-error context) Rounded)
- ans))))))
+ ans)))))
(define to_integral_value
(lam (self (= rounding None) (= context None))
(set context 'rounding rounding)
ans))))
- (define is_canonical (pk 5
+ (define is_canonical
(lambda (self)
"Return True if self is canonical; otherwise return False.
Currently, the encoding of a Decimal instance is always
canonical, so this method returns True for any Decimal.
"
- #t)))
+ #t))
(define is_finite
(lambda (self)
(list->string (reverse l))))
0)))))))
- (define logical_and (logical_* logand))
- (define logical_or (logical_* logior))
- (define logical_xor (logical_* logxor))
+ (define logical_and (lambda x (apply (logical_* logand) x)))
+ (define logical_or (lambda x (apply (logical_* logior) x)))
+ (define logical_xor (lambda x (apply (logical_* logxor) x)))
(define logical_invert
(lam (self (= context None))
((ref ans '_fix) context))))))
- (define max_mag (x_mag (lambda (x) x)))
- (define min_mag (x_mag not))
+ (define max_mag (lambda y (apply (x_mag (lambda (x) x)) y)))
+ (define min_mag (lambda y (apply (x_mag not) y)))
(define next_minus
(lam (self (= context None))
ans))))
- (define number_class (pk 6
+ (define number_class
(lam (self (= context None))
"Returns an indication of the class of self.
;; just a normal, regular, boring number, :)
(if (bool (ref self '_sign))
"-Normal"
- "+Normal")))))
+ "+Normal"))))
(define radix
(lambda (self)
(set self '_is_special special)
self)))
-(pk 14)
+
;; Register Decimal as a kind of Number (an abstract base class).
;; However, do not register it as Real (because Decimals are not
;; interoperable with floats).
(setcontext (ref self 'saved_context)))))
(define DefaultContext #f)
-(pk 15)
+
(define-syntax-rule (setq s q m)
- (set s 'q (if (eq? q None) (ref m 'q) q)))
+ (if (eq? q None)
+ (if (bool m)
+ (set s 'q (ref m 'q)))
+ (set s 'q q)))
(define-python-class Context (object)
"Contains the context for a Decimal instance.
(setq self Emax dc)
(setq self capitals dc)
(setq self clamp dc)
-
+
(set self '_ignored_flags
(if (eq? _ignored_flags None)
(py-list)
((equal? name "clamp")
((ref self '_set_integer_check) name value 0 1))
((equal? name "rounding")
- (if (not (member (string->symbol value) _rounding_modes))
+ (if (not (member value _rounding_modes))
;; raise TypeError even for strings to have consistency
;; among various implementations.
(raise (TypeError (format #f "~a: invalid rounding mode" value))))
- (rawset self (string->symbol name) (string->symbol value)))
+ (rawset self (string->symbol name) value))
((or (equal? name "flags") (equal? name "traps"))
((ref self '_set_signal_dict) name value))
((equal? name "_ignored_flags")
;;##### Integer arithmetic functions used by ln, log10, exp and __pow__ #####
-(pk 1)
+
(define _nbits (ref int 'bit_length))
(define _decimal_lshift_exact
(set self 'digits (pylist-slice (py-rstrip (ref self 'digits)) "0") None -1 None))
(int (pylist-slice (ref self 'digits) None (+ p 1) None)))))
-(pk 2)
+
(define _log10_digits (ref (_Log10Memoize) 'getdigits))
(define _iexp
#:Emin -999999
#:capitals 1
#:clamp 0))
-
+(pk 3 1)
;; Pre-made alternate contexts offered by the specification
;; Don't change these; the user should be able to select these
;; contexts and be able to reproduce results from other implementations
#:rounding ROUND_HALF_UP
#:traps (list DivisionByZero Overflow InvalidOperation Clamped Underflow)
#:flags '()))
-
+(pk 3 2)
(define ExtendedContext
(Context
#:prec 9
projects / software / python-on-guile.git / commitdiff
