decimals division

[software/python-on-guile.git] / modules / language / python / module / decimal.scm

(define-module (language python module decimal)
  #:use-module ((language python module collections) #:select (namedtuple))
  #:use-module ((language python module itertools) #:select (chain repeat))
  #:use-module ((language python module sys) #:select (maxsize hash_info))
  #:use-module (language python module)
  #:use-module ((language python module python) #:select
                (isinstance str float int tuple classmethod pow property
                            complex range reversed (format . str-format)))
  #:use-module (language python list)
  #:use-module (language python number)
  #:use-module (language python string)
  #:use-module (language python for)
  #:use-module (language python try)
  #:use-module (language python hash)
  #:use-module (language python dict)
  #:use-module (language python def)
  #:use-module (language python exceptions)
  #:use-module (language python bool)
  #:use-module (language python module)
  #:use-module (oop pf-objects)
  #:use-module (oop goops)
  #:use-module (language python module re)
  #:use-module (ice-9 control)
  #:use-module ((ice-9 match) #:select ((match . ice:match)))
  #:export
  (        ;; Two major classes
   Decimal Context

           ;; Named tuple representation
           DecimalTuple

           ;; Contexts
           DefaultContext BasicContext ExtendedContext
                    
           ;; Exceptions
           DecimalException Clamped InvalidOperation DivisionByZero
           Inexact Rounded Subnormal Overflow Underflow
           FloatOperation

           ;; Exceptional conditions that trigger InvalidOperation
           DivisionImpossible InvalidContext ConversionSyntax DivisionUndefined

           ;; Constants for use in setting up contexts
           ROUND_DOWN ROUND_HALF_UP ROUND_HALF_EVEN ROUND_CEILING
           ROUND_FLOOR ROUND_UP ROUND_HALF_DOWN ROUND_05UP

           ;; Functions for manipulating contexts
           setcontext getcontext localcontext

           ;; Limits for the C version for compatibility
           MAX_PREC  MAX_EMAX MIN_EMIN MIN_ETINY))

(define-syntax-rule (aif it p . l) (let ((it p)) (if (bool it) . l)))

(define-syntax-rule (D x) (lambda () x))

#|
This is the copyright information of the file ported over to scheme
# Copyright (c) 2004 Python Software Foundation.
# All rights reserved.

# Written by Eric Price <eprice at tjhsst.edu>
#    and Facundo Batista <facundo at taniquetil.com.ar>
#    and Raymond Hettinger <python at rcn.com>
#    and Aahz <aahz at pobox.com>
#    and Tim Peters

# This module should be kept in sync with the latest updates of the
# IBM specification as it evolves.  Those updates will be treated
# as bug fixes (deviation from the spec is a compatibility, usability
# bug) and will be backported.  At this point the spec is stabilizing
# and the updates are becoming fewer, smaller, and less significant.
|#

(define guile:modulo (@ (guile) modulo))

(define __name__   "decimal")
(define __xname__  __name__)
(define __version__ "1.70")
;; Highest version of the spec this complies with
;; See http://speleotrove.com/decimal/

(define DecimalTuple (namedtuple "DecimalTuple" "sign,digits,exponent"))

;; Rounding
(define ROUND_DOWN      'ROUND_DOWN)
(define ROUND_HALF_UP   'ROUND_HALF_UP)
(define ROUND_HALF_EVEN 'ROUND_HALF_EVEN)
(define ROUND_CEILING   'ROUND_CEILING)
(define ROUND_FLOOR     'ROUND_FLOOR)
(define ROUND_UP        'ROUND_UP)
(define ROUND_HALF_DOWN 'ROUND_HALF_DOWN)
(define ROUND_05UP      'ROUND_05UP)

;; Compatibility with the C version
(define MAX_PREC 425000000)
(define MAX_EMAX 425000000)
(define MIN_EMIN -425000000)

(if (= maxsize  (- (ash 1 63) 1))
    (begin
      (set! MAX_PREC 999999999999999999)
      (set! MAX_EMAX 999999999999999999)
      (set! MIN_EMIN -999999999999999999)))

(define MIN_ETINY  (- MIN_EMIN (- MAX_PREC 1)))

;; Context
(define-inlinable (cx-prec     x) (rawref x 'prec))
(define-inlinable (cx-emax     x) (rawref x 'Emax))
(define-inlinable (cx-emin     x) (rawref x 'Emin))
(define-inlinable (cx-etiny    x) ((ref x 'Etiny)))
(define-inlinable (cx-etop     x) ((ref x 'Etop)))
(define-inlinable (cx-copy     x) ((ref x 'copy)))
(define-inlinable (cx-clear_flags x) ((ref x 'clear_flags)))
(define-inlinable (cx-raise    x) (ref x '_raise_error))
(define-inlinable (cx-error    x) (ref x '_raise_error))
(define-inlinable (cx-capitals x) (rawref x 'capitals))
(define-inlinable (cx-cap      x) (rawref x 'capitals))
(define-inlinable (cx-rounding x) (rawref x 'rounding))
(define-inlinable (cx-clamp    x) (rawref x 'clamp))
(define-inlinable (cx-traps    x) (rawref x 'traps))
(define-inlinable (cx-flags    x) (rawref x 'flags))

;; Errors

(define-python-class DecimalException (ArithmeticError)
    "Base exception class.

    Used exceptions derive from this.
    If an exception derives from another exception besides this (such as
    Underflow (Inexact, Rounded, Subnormal) that indicates that it is only
    called if the others are present.  This isn't actually used for
    anything, though.

    handle  -- Called when context._raise_error is called and the
               trap_enabler is not set.  First argument is self, second is the
               context.  More arguments can be given, those being after
               the explanation in _raise_error (For example,
               context._raise_error(NewError, '(-x)!', self._sign) would
               call NewError().handle(context, self._sign).)

    To define a new exception, it should be sufficient to have it derive
    from DecimalException.
    "
    
    (define handle
      (lambda (self context . args)
        (values))))


(define-python-class Clamped (DecimalException)
    "Exponent of a 0 changed to fit bounds.

    This occurs and signals clamped if the exponent of a result has been
    altered in order to fit the constraints of a specific concrete
    representation.  This may occur when the exponent of a zero result would
    be outside the bounds of a representation, or when a large normal
    number would have an encoded exponent that cannot be represented.  In
    this latter case, the exponent is reduced to fit and the corresponding
    number of zero digits are appended to the coefficient ('fold-down').
    ")

(define-python-class InvalidOperation (DecimalException)
    "An invalid operation was performed.

    Various bad things cause this:

    Something creates a signaling NaN
    -INF + INF
    0 * (+-)INF
    (+-)INF / (+-)INF
    x % 0
    (+-)INF % x
    x._rescale( non-integer )
    sqrt(-x) , x > 0
    0 ** 0
    x ** (non-integer)
    x ** (+-)INF
    An operand is invalid

    The result of the operation after these is a quiet positive NaN,
    except when the cause is a signaling NaN, in which case the result is
    also a quiet NaN, but with the original sign, and an optional
    diagnostic information.
    "
    (define handle
      (lambda (self context . args)
        (if (bool args)
            (let ((ans  (_dec_from_triple
                         (ref (car args) '_sign)
                         (ref (car args) '_int)
                         "n" #t)))
              ((ref ans '_fix_nan) context))
            _NaN))))

(define-python-class ConversionSyntax (InvalidOperation)
    "Trying to convert badly formed string.

    This occurs and signals invalid-operation if a string is being
    converted to a number and it does not conform to the numeric string
    syntax.  The result is [0,qNaN].
    "
    (define handle
      (lambda x _NaN)))

(define-python-class DivisionByZero (DecimalException ZeroDivisionError)
    "Division by 0.

    This occurs and signals division-by-zero if division of a finite number
    by zero was attempted (during a divide-integer or divide operation, or a
    power operation with negative right-hand operand), and the dividend was
    not zero.

    The result of the operation is [sign,inf], where sign is the exclusive
    or of the signs of the operands for divide, or is 1 for an odd power of
    -0, for power.
    "

    (define handle
      (lambda (self context sign . args)
        (pylist-ref _SignedInfinity sign))))

(define-python-class DivisionImpossible (InvalidOperation)
    "Cannot perform the division adequately.

    This occurs and signals invalid-operation if the integer result of a
    divide-integer or remainder operation had too many digits (would be
    longer than precision).  The result is [0,qNaN].
    "

    (define handle
      (lambda x _NaN)))

(define-python-class DivisionUndefined (InvalidOperation ZeroDivisionError)
    "Undefined result of division.

    This occurs and signals invalid-operation if division by zero was
    attempted (during a divide-integer, divide, or remainder operation), and
    the dividend is also zero.  The result is [0,qNaN].
    "

    (define handle
      (lambda x _NaN)))

(define-python-class Inexact (DecimalException)
    "Had to round, losing information.

    This occurs and signals inexact whenever the result of an operation is
    not exact (that is, it needed to be rounded and any discarded digits
    were non-zero), or if an overflow or underflow condition occurs.  The
    result in all cases is unchanged.

    The inexact signal may be tested (or trapped) to determine if a given
    operation (or sequence of operations) was inexact.
    ")

(define-python-class InvalidContext (InvalidOperation)
    "Invalid context.  Unknown rounding, for example.

    This occurs and signals invalid-operation if an invalid context was
    detected during an operation.  This can occur if contexts are not checked
    on creation and either the precision exceeds the capability of the
    underlying concrete representation or an unknown or unsupported rounding
    was specified.  These aspects of the context need only be checked when
    the values are required to be used.  The result is [0,qNaN].
    "

    (define handle
      (lambda x _NaN)))

(define-python-class Rounded (DecimalException)
    "Number got rounded (not  necessarily changed during rounding).

    This occurs and signals rounded whenever the result of an operation is
    rounded (that is, some zero or non-zero digits were discarded from the
    coefficient), or if an overflow or underflow condition occurs.  The
    result in all cases is unchanged.

    The rounded signal may be tested (or trapped) to determine if a given
    operation (or sequence of operations) caused a loss of precision.
    ")

(define-python-class Subnormal (DecimalException)
    "Exponent < Emin before rounding.

    This occurs and signals subnormal whenever the result of a conversion or
    operation is subnormal (that is, its adjusted exponent is less than
    Emin, before any rounding).  The result in all cases is unchanged.

    The subnormal signal may be tested (or trapped) to determine if a given
    or operation (or sequence of operations) yielded a subnormal result.
    ")

(define-python-class Overflow (Inexact Rounded)
    "Numerical overflow.

    This occurs and signals overflow if the adjusted exponent of a result
    (from a conversion or from an operation that is not an attempt to divide
    by zero), after rounding, would be greater than the largest value that
    can be handled by the implementation (the value Emax).

    The result depends on the rounding mode:

    For round-half-up and round-half-even (and for round-half-down and
    round-up, if implemented), the result of the operation is [sign,inf],
    where sign is the sign of the intermediate result.  For round-down, the
    result is the largest finite number that can be represented in the
    current precision, with the sign of the intermediate result.  For
    round-ceiling, the result is the same as for round-down if the sign of
    the intermediate result is 1, or is [0,inf] otherwise.  For round-floor,
    the result is the same as for round-down if the sign of the intermediate
    result is 0, or is [1,inf] otherwise.  In all cases, Inexact and Rounded
    will also be raised.
    "

    (define handle
      (let ((l (list ROUND_HALF_UP ROUND_HALF_EVEN
                     ROUND_HALF_DOWN ROUND_UP)))
        (lambda (self context sign . args)
          (let/ec ret
            (if (memq (ref context 'rounding) l)
                (ret (pylist-ref _SignedInfinity sign)))
            
            (if (= sign 0)
                (if (eq? (ref context 'rounding) ROUND_CEILING)
                    (ret (pylist-ref _SignedInfinity sign))
                    (ret (_dec_from_triple
                          sign
                          (* "9" (cx-prec context))
                          (+ (- (cx-emax context) (cx-prec context)) 1)))))

            (if (= sign 1)
                (if (eq? (ref context 'rounding) ROUND_FLOOR)
                    (ret (pylist-ref _SignedInfinity sign))
                    (ret (_dec_from_triple
                          sign
                          (* "9" (cx-prec context))
                          (+ (- (cx-emax context) (cx-prec context)) 1))))))))))


(define-python-class Underflow (Inexact Rounded Subnormal)
    "Numerical underflow with result rounded to 0.

    This occurs and signals underflow if a result is inexact and the
    adjusted exponent of the result would be smaller (more negative) than
    the smallest value that can be handled by the implementation (the value
    Emin).  That is, the result is both inexact and subnormal.

    The result after an underflow will be a subnormal number rounded, if
    necessary, so that its exponent is not less than Etiny.  This may result
    in 0 with the sign of the intermediate result and an exponent of Etiny.

    In all cases, Inexact, Rounded, and Subnormal will also be raised.
    ")

(define-python-class FloatOperation (DecimalException TypeError)
    "Enable stricter semantics for mixing floats and Decimals.

    If the signal is not trapped (default), mixing floats and Decimals is
    permitted in the Decimal() constructor, context.create_decimal() and
    all comparison operators. Both conversion and comparisons are exact.
    Any occurrence of a mixed operation is silently recorded by setting
    FloatOperation in the context flags.  Explicit conversions with
    Decimal.from_float() or context.create_decimal_from_float() do not
    set the flag.

    Otherwise (the signal is trapped), only equality comparisons and explicit
    conversions are silent. All other mixed operations raise FloatOperation.
    ")

;; List of public traps and flags
(define _signals
  (list Clamped DivisionByZero Inexact Overflow Rounded
        Underflow InvalidOperation Subnormal FloatOperation))

;; Map conditions (per the spec) to signals
(define _condition_map
  (dict
   `((,ConversionSyntax   . ,InvalidOperation)
     (,DivisionImpossible . ,InvalidOperation)
     (,DivisionUndefined  . ,InvalidOperation)
     (,InvalidContext     . ,InvalidOperation))))

;; 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))

;; ##### Context Functions ##################################################

;; The getcontext() and setcontext() function manage access to a thread-local
;; current context.
(define *context* (make-fluid #f))
(define (getcontext)
  (fluid-ref *context*))
(define (setcontext context)
  (fluid-set! *context* context))

;; ##### Decimal class #######################################################

;; Do not subclass Decimal from numbers.Real and do not register it as such
;; (because Decimals are not interoperable with floats).  See the notes in
;; numbers.py for more detail.

(define _dec_from_triple
  (lam (sign coefficient exponent (= special #f))
    "Create a decimal instance directly, without any validation,
    normalization (e.g. removal of leading zeros) or argument
    conversion.

    This function is for *internal use only*.
    "
    (Decimal sign coefficient exponent special)))

(define (get-parsed-sign m)
  (if (equal? ((ref m 'group) "sign") "-")
      1
      0))

(define (get-parsed-int m)
  ((ref m 'group) "int"))

(define (get-parsed-frac m)
  (let ((r ((ref m 'group) "frac")))
    (if (eq? r None)
        ""
        r)))

(define (get-parsed-exp m)
  (let ((r ((ref m 'group) "exp")))
    (if (eq? r None)
        0
        (string->number r))))

(define (get-parsed-diag m)
  ((ref m 'group) "diag"))

(define (get-parsed-sig m)
  ((ref m 'group) "signal"))

(def (_mk self __init__ (= value "0") (= context None))
       "Create a decimal point instance.

        >>> Decimal('3.14')              # string input
        Decimal('3.14')
        >>> Decimal((0, (3, 1, 4), -2))  # tuple (sign, digit_tuple, exponent)
        Decimal('3.14')
        >>> Decimal(314)                 # int
        Decimal('314')
        >>> Decimal(Decimal(314))        # another decimal instance
        Decimal('314')
        >>> Decimal('  3.14  \\n')        # leading and trailing whitespace okay
        Decimal('3.14')
        "

        ;; Note that the coefficient, self._int, is actually stored as
        ;; a string rather than as a tuple of digits.  This speeds up
        ;; the "digits to integer" and "integer to digits" conversions
        ;; that are used in almost every arithmetic operation on
        ;; Decimals.  This is an internal detail: the as_tuple function
        ;; and the Decimal constructor still deal with tuples of
        ;; digits.

        ;; From a string
        ;; REs insist on real strings, so we can too.
        (cond
         ((isinstance value str)
            (let ((m (_parser (scm-str value))))
              (if (not (bool m))
                (let ((context (if (eq? context None)
                                   (getcontext)
                                   context)))
                  ((cx-raise context)
                   ConversionSyntax
                   (+ "Invalid literal for Decimal: " value))))

              (let ((sign     (get-parsed-sign m))
                    (intpart  (get-parsed-int  m))
                    (fracpart (get-parsed-frac m))
                    (exp      (get-parsed-exp  m))
                    (diag     (get-parsed-diag m))
                    (signal   (get-parsed-sig  m)))
                
                (set self '_sign sign)
                
                (if (not (eq? intpart None))
                    (begin
                      (set self '_int (str (int (+ intpart fracpart))))
                      (set self '_exp (- exp (len fracpart)))
                      (set self '_is_special #f))
                    (begin
                      (if (not (eq? diag None))
                          (begin
                            ;; NaN
                            (set self '_int
                                 (py-lstrip (str (int (if (bool diag)
                                                          diag
                                                          "0")))
                                            "0"))
                            (if signal
                                (set self '_exp 'N)
                                (set self '_exp 'n)))
                          (begin
                            ;; infinity
                            (set self '_int "0")
                            (set self '_exp 'F)))
                      (set self '_is_special #t))))))
         
        ;; From an integer         
        ((isinstance value int)
         (if (>= value 0)
             (set self '_sign 0)
             (set self '_sign 1))
         (set self '_exp 0)
         (set self '_int (str (abs value)))
         (set self '_is_special #f))
        
        ;; From another decimal
        ((isinstance value Decimal)
            (set self '_exp        (ref value '_exp       ))
            (set self '_sign       (ref value '_sign      ))
            (set self '_int        (ref value '_int       ))
            (set self '_is_special (ref value '_is_special)))

        ;; From an internal working value
        ((isinstance value _WorkRep)
         (set self '_exp        (int (ref value 'exp)))
         (set self '_sign       (ref value 'sign))
         (set self '_int        (str (ref value 'int)))
         (set self '_is_special #f))

        ;; tuple/list conversion (possibly from as_tuple())
        ((isinstance value (list list tuple))
            (if (not (= (len value) 3))
                (raise (ValueError
                        (+ "Invalid tuple size in creation of Decimal "
                           "from list or tuple.  The list or tuple "
                           "should have exactly three elements."))))
            ;; # process sign.  The isinstance test rejects floats
            (let ((v0 (pylist-ref value 0))
                  (v1 (pylist-ref value 1))
                  (v2 (pylist-ref value 2)))
              (if (not (and (isinstance v0 int)
                            (or (= v0 0) (= v0 1))))
                  (raise (ValueError
                          (+ "Invalid sign.  The first value in the tuple "
                             "should be an integer; either 0 for a "
                             "positive number or 1 for a negative number."))))
              (set self '_sign v0)
            (if (eq? v2 'F)
                (begin
                  (set self '_int "0")
                  (set self '_exp v2)
                  (set self 'is_special #t))
                (let ((digits (py-list)))
                  ;; process and validate the digits in value[1]
                  (for ((digit : v1)) ()
                       (if (and (isinstance digit int)
                                (<= 0 digit)
                                (<= digit 9))
                           ;; skip leading zeros
                           (if (or (bool digits) (> digit 0))
                               (pylist-append! digits digit))
                           (raise (ValueError
                                   (+ "The second value in the tuple must "
                                      "be composed of integers in the range "
                                      "0 through 9.")))))
                  
                  (cond
                   ((or (eq? v2 'n) (eq? v2 'N))
                    (begin
                      ;; NaN: digits form the diagnostic
                      (set self '_int  (py-join "" (map str digits)))
                      (set self '_exp  v2)
                        (set self '_is_special #t)))
                   ((isinstance v2  int)
                    ;; finite number: digits give the coefficient
                    (set self '_int (py-join "" (map str digits)))
                    (set self '_exp v2)
                    (set self '_is_special #f))
                   (else
                    (raise (ValueError
                            (+ "The third value in the tuple must "
                               "be an integer, or one of the "
                               "strings 'F', 'n', 'N'.")))))))))

        ((isinstance value float)
         (let ((context (if (eq? context None)
                            (getcontext)
                            context)))
           ((cx-error context)
            FloatOperation
            (+ "strict semantics for mixing floats and Decimals are "
               "enabled"))
           
           (__init__ self ((ref Decimal 'from_float) value))))

        (else
         (raise (TypeError
                 (format #f "Cannot convert ~a to Decimal" value))))))

(define-inlinable (divmod x y)
  (values (quotient x y) (modulo x y)))

(define-syntax twix
  (syntax-rules (when let let* if)
    ((_ a) a)
    ((_ (let () a ...) . l)
     (begin a ... (twix . l)))

    ((_ (let ((a aa) ...) b ...) . l)
     (let ((a aa) ...) b ... (twix . l)))
    ((_ (let (a ...)) . l)
     (a ... (twix . l)))
    ((_ (let* (a ...) b ...) . l)
     (let* (a ...) b ... (twix . l)))
    ((_ (if . u) . l)
     (begin (if . u) (twix . l)))
    ((_ (when . u) . l)
     (begin (when . u) (twix . l)))
    ((_ (a it code ...) . l)
     (aif it a (begin code ...) (twix . l)))))

(define-syntax-rule (norm-op self op)
  (begin
    (set! op (_convert_other op))
    (if (eq? op NotImplemented)
        op
        #f)))

(define-syntax-rule (get-context context code)
  (let ((context (if (eq? context None)
                     (getcontext)
                     context)))
    code))

(define-syntax-rule (un-special self context)
  (if (ref self '_is_special)
      (let ((ans ((ref self '_check_nans) #:context context)))
        (if (bool ans)
            ans
            #f))
      #f))

(define-syntax-rule (bin-special o1 o2 context)
  (if (or (ref o1  '_is_special)
          (ref o2  '_is_special))
      (or (un-special o1 context) (un-special o2 context))
      #f))

(define-syntax-rule (add-special self other context)
  (or (bin-special self other context)
      (if (bool ((ref self '_isinfinity)))
          ;; If both INF, same sign =>
          ;; same as both, opposite => error.
          (if (and (not (= (ref self '_sign) (ref other '_sign)))
                   (bool ((ref other '_isinfinity))))
              ((cx-error context) InvalidOperation "-INF + INF")
              (Decimal self))         
          (if (bool ((ref other '_isinfinity)))
              (Decimal other) ; Can't both be infinity here
              #f))))

(define-syntax-rule (mul-special self other context resultsign)
  (if (or (ref self '_is_special) (ref other '_is_special))
      (twix
       ((bin-special self other context) it it)
               
       ((if (bool ((ref self '_isinfinity)))
            (if (not (bool other))
                ((cx-error context) InvalidOperation "(+-)INF * 0")
                (pylist-ref _SignedInfinity resultsign))
            #f) it it)

       (if (bool ((ref other '_isinfinity)))
           (if (not (bool self))
               ((cx-error context) InvalidOperation "(+-)INF * 0")
               (pylist-ref _SignedInfinity resultsign))
           #f))
      #f))

(define-syntax-rule (div-special self other context sign)
  (if (or (ref self '_is_special) (ref other '_is_special))
      (twix
       ((bin-special self other context) it it)
       
       ((and (bool ((ref self '_isinfinity))) (bool ((ref other '_isinfinity)))) it
        ((cx-error context) InvalidOperation "(+-)INF/(+-)INF"))

       ((bool ((ref self '_isinfinity))) it
        (pylist-ref _SignedInfinity sign))

       ((bool ((ref other '_isinfinity))) it
        ((cx-error context) Clamped "Division by infinity")
        (_dec_from_triple sign  "0" (cx-etiny context))))
      #f))
        

(define-python-class Decimal (object)
    "Floating point class for decimal arithmetic."
    
    
    ;; Generally, the value of the Decimal instance is given by
    ;;  (-1)**_sign * _int * 10**_exp
    ;; Special values are signified by _is_special == True

    (define __init__
      (case-lambda
       ((self sign coefficient exponent special)
        (set self '_sign       sign)
        (set self '_int        coefficient)
        (set self '_exp        exponent)
        (set self '_is_special special))
       
       ((self)
        (_mk self __init__))
       ((self a)
        (_mk self __init__ a))
       ((self a b)
        (_mk self __init__ a b))))

    (define from_float
      (classmethod
       (lambda (cls f)
        "Converts a float to a decimal number, exactly.

        Note that Decimal.from_float(0.1) is not the same as Decimal('0.1').
        Since 0.1 is not exactly representable in binary floating point, the
        value is stored as the nearest representable value which is
        0x1.999999999999ap-4.  The exact equivalent of the value in decimal
        is 0.1000000000000000055511151231257827021181583404541015625.

        >>> Decimal.from_float(0.1)
        Decimal('0.1000000000000000055511151231257827021181583404541015625')
        >>> Decimal.from_float(float('nan'))
        Decimal('NaN')
        >>> Decimal.from_float(float('inf'))
        Decimal('Infinity')
        >>> Decimal.from_float(-float('inf'))
        Decimal('-Infinity')
        >>> Decimal.from_float(-0.0)
        Decimal('-0')

        "
        (define (frexp x)
          (if (< x 0) (set! x (- x)))
          
          (let lp ((l (string->list (format #f "~e" x))) (r1 '()))
            (ice:match l
               ((#\. . l)
                (let lp ((l l) (r2 '()))
                  (ice:match l
                    ((#\E . l)
                     (let* ((n (length r2))
                            (m (list->string (append (reverse r1) (reverse r2))))
                            (e (+ (- n) (string->number (list->string l)))))
                       (cons m e)))
                    ((x . l)
                     (lp l (cons x r2))))))
               
               ((x . l)
                (lp l (cons x r1))))))

        (cond
         ((isinstance f  int)                ; handle integer inputs
          (cls f))
         ((not (isinstance f float))
          (raise (TypeError "argument must be int or float.")))
         ((or (inf? f) (nan? f))
          (cls (cond
                ((nan? f)          "Nan")
                ((eq? f (inf))     "Inf")
                ((eq? f (- (inf))) "-Inf"))))
         (else
          (let* ((sign (if (>= f 0) 0 1))
                 (me   (frexp f))
                 (m    (car me))
                 (e    (cdr me))
                 (res  (_dec_from_triple sign m e)))
            (if (eq? cls Decimal)
                res
                (cls res))))))))
    
    (define _isnan
      (lambda (self)
        "Returns whether the number is not actually one.

        0 if a number
        1 if NaN
        2 if sNaN
        "
        (if (ref self '_is_special)
            (let ((exp (ref self '_exp)))
              (cond
               ((eq? exp 'n) 1)
               ((eq? exp 'N) 2)
               (else         0)))
            0)))
    
    (define _isinfinity 
      (lambda (self)
        "Returns whether the number is infinite

        0 if finite or not a number
        1 if +INF
        -1 if -INF
        "
        (if (eq? (ref self '_exp) 'F)
            (if (eq? (ref self '_sign) 1)
                -1
                1)
            0)))
    
    (define _check_nans
      (lam (self (= other None) (= context None))
        "Returns whether the number is not actually one.

        if self, other are sNaN, signal
        if self, other are NaN return nan
        return 0

        Done before operations.
        "

        (let ((self_is_nan ((ref self '_isnan)))
              (other_is_nan
               (if (eq? other None)
                   #f
                   ((ref other '_isnan)))))
          
          (if (or (bool self_is_nan) (bool other_is_nan))
              (let ((context (if (eq? context None)
                                 (getcontext)
                                 context)))
                (cond
                 ((eq? self_is_nan 2)
                  ((cx-error context) InvalidOperation "sNaN" self))
                 ((eq? other_is_nan 2)
                  ((cx-error context) InvalidOperation "sNaN" other))
                 ((bool self_is_nan)
                  ((ref self '_fix_nan) context))
                 (else
                  ((ref other '_fix_nan) context))))
              0))))
                 

    (define _compare_check_nans
      (lambda (self other context)
        "Version of _check_nans used for the signaling comparisons
        compare_signal, __le__, __lt__, __ge__, __gt__.

        Signal InvalidOperation if either self or other is a (quiet
        or signaling) NaN.  Signaling NaNs take precedence over quiet
        NaNs.

        Return 0 if neither operand is a NaN.

        "
        (let ((context (if (eq? context None)
                           (getcontext)
                           context)))

          (if (or (ref self  '_is_special)
                  (ref other '_is_special))
              (cond
               (((ref self 'is_snan))
                ((cx-error context)
                 InvalidOperation
                 "comparison involving sNaN" self))

               (((ref other 'is_snan))
                ((cx-error context)
                 InvalidOperation
                 "comparison involving sNaN" other))
                
               (((ref self 'is_qnan))
                ((cx-error context)
                 InvalidOperation
                 "comparison involving NaN" self))

               (((ref other 'is_qnan))
                ((cx-error context)
                 InvalidOperation
                 "comparison involving NaN" other))
               
               (else 0))
              0))))

    (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")))))

    (define _cmp
      (lambda (self other)
        "Compare the two non-NaN decimal instances self and other.

        Returns -1 if self < other, 0 if self == other and 1
        if self > other.  This routine is for internal use only."

        (let ((self_sign  (ref self  '_sign))
              (other_sign (ref other '_sign)))
          (cond
           ((or (ref self '_is_special) (ref other '_is_special))
            (let ((self_inf  ((ref self  '_isinfinity)))
                  (other_inf ((ref other '_isinfinity))))
              (cond
               ((eq? self_inf other_inf) 0)
               ((< self_inf other_inf)  -1)
               (else                     1))))
            
           ;; check for zeros;  Decimal('0') == Decimal('-0')
           ((not (bool self))
            (if (not (bool other))
                0
                (let ((s (ref other '_sign)))
                  (if (= s 0)
                      -1
                      1))))
           ((not (bool other))
            (let ((s (ref self '_sign)))
              (if (= s 0)
                  1
                  -1)))
          
           ((< other_sign self_sign)
            -1)
           ((< self_sign other_sign)
            1)

           (else
            (let ((self_adjusted  ((ref self  'adjusted)))
                  (other_adjusted ((ref other 'adjusted)))
                  (self_exp       (ref self  '_exp))
                  (other_exp      (ref other '_exp)))
              (cond
               ((= self_adjusted other_adjusted)
                (let ((self_padded  (+ (ref self '_int)
                                       (* "0" (- self_exp  other_exp))))
                      (other_padded (+ (ref other '_int)
                                       (* "0" (- other_exp  self_exp)))))
                  (cond
                   ((equal? self_padded other_padded)
                    0)
                   ((< self_padded other_padded)
                    (if (= self_sign 0)
                        -1
                        1))
                   (else
                    (if (= self_sign 0)
                        1
                        -1)))))
               ((> self_adjusted other_adjusted)
                (if (= self_sign 0)
                    1
                    -1))
               (else
                (if (= self_sign 0)
                    -1
                    1)))))))))
    
    ;; Note: The Decimal standard doesn't cover rich comparisons for
    ;; Decimals.  In particular, the specification is silent on the
    ;; subject of what should happen for a comparison involving a NaN.
    ;; We take the following approach:
    ;;
    ;;   == comparisons involving a quiet NaN always return False
    ;;   != comparisons involving a quiet NaN always return True
    ;;   == or != comparisons involving a signaling NaN signal
    ;;      InvalidOperation, and return False or True as above if the
    ;;      InvalidOperation is not trapped.
    ;;   <, >, <= and >= comparisons involving a (quiet or signaling)
    ;;      NaN signal InvalidOperation, and return False if the
    ;;      InvalidOperation is not trapped.
    ;;    ;; This behavior is designed to conform as closely as possible to
    ;; that specified by IEEE 754.
    
    (define __eq__
      (lam (self other (= context None))
           (let* ((so    (_convert_for_comparison self other #:equality_op #t))
                  (self  (car so))
                  (other (cdr so)))
             
             (cond
              ((eq? other NotImplemented)
               other)
              ((bool ((ref self '_check_nans) other context))
               #f)
              (else (= ((ref self '_cmp) other) 0))))))

    (define _xlt 
      (lambda (<)
        (lam (self other (= context None))
             (let* ((so (_convert_for_comparison self other #:equality_op #t))
                    (self  (car so))
                    (other (cdr so)))
             
               (cond
                ((eq? other NotImplemented)
                 other)
                ((bool ((ref self '_compare_check_nans) other context))
                 #f)
                (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 
      (lam (self other (= context None))
        "Compare self to other.  Return a decimal value:

        a or b is a NaN ==> Decimal('NaN')
        a < b           ==> Decimal('-1')
        a == b          ==> Decimal('0')
        a > b           ==> Decimal('1')
        "
        (let ((other (_convert_other other #:raiseit #t)))
          ;; Compare(NaN, NaN) = NaN
          (if (or (ref self '_is_special)
                  (and (bool other)
                       (ref other '_is_special)))
              (let ((it ((ref self '_check_nans) other context)))
                (if (bool it)
                    it
                    (Decimal ((ref self '_cmp) other))))))))

    (define __hash__
      (lambda (self)
        "x.__hash__() <==> hash(x)"

        ;; In order to make sure that the hash of a Decimal instance
        ;; agrees with the hash of a numerically equal integer, float
        ;; or Fraction, we follow the rules for numeric hashes outlined
        ;; in the documentation.  (See library docs, 'Built-in Types').
        (cond
         ((ref self '_is_special)
          (cond
           (((ref self 'is_snan))
            (raise (TypeError "Cannot hash a signaling NaN value.")))
           (((ref self 'is_snan))
            (hash (nan) pyhash-N))
           ((= 1 (ref self '_sign))
            (hash (- (inf)) pyhash-N))
           (else
            (hash (inf) pyhash-N))))
            
         (else
          (let* ((exp (ref self '_exp))
                 (exp_hash
                  (if (>= exp 0)
                      (pow 10            exp     pyhash-N)
                      (pow _PyHASH_10INV (- exp) pyhash-N)))
                 
                 (hash_
                  (modulo (* (int (ref self '_int)) exp_hash)
                           pyhash-N))

                 (ans
                  (if (>= self 0) hash_ (- hash_))))
            (if (= ans -1) -2 ans))))))
    
    (define as_tuple
      (lambda (self)
        "Represents the number as a triple tuple.

        To show the internals exactly as they are.
        "
        (DecimalTuple (ref self '_sign)
                      (tuple (map int (ref self '_int)))
                      (ref self '_exp))))

    (define as_integer_ratio
      (lambda (self)
        "Express a finite Decimal instance in the form n / d.

        Returns a pair (n, d) of integers.  When called on an infinity
        or NaN, raises OverflowError or ValueError respectively.

        >>> Decimal('3.14').as_integer_ratio()
        (157, 50)
        >>> Decimal('-123e5').as_integer_ratio()
        (-12300000, 1)
        >>> Decimal('0.00').as_integer_ratio()
        (0, 1)
        "
        (if (ref self '_is_special)
            (if ((ref self 'is_nan))
                (raise (ValueError
                        "cannot convert NaN to integer ratio"))
                (raise (OverflowError
                        "cannot convert Infinity to integer ratio"))))

        (if (not (bool self))
            (values 0 1)
            (let* ((s (ref self '_sign))
                   (n (int (ref self '_int)))
                   (e (ref self '_exp))
                   (x
                    (* n (if (> exp 0)
                             (expt 10 exp)
                             (/ 1 (expt 10 (- expt)))))))
              (values (numerator x)
                      (denominator x))))))
    
    (define __repr__
      (lambda (self)
        "Represents the number as an instance of Decimal."
        ;# Invariant:  eval(repr(d)) == d
        (format #f "Decimal('~a')" (str self))))

    (define __str__
      (lam (self  (= eng #f) (= context None))
        "Return string representation of the number in scientific notation.

        Captures all of the information in the underlying representation.
        "
        (let* ((sign         (if (= (ref self '_sign) 0) "" "-"))
               (exp          (ref self '_exp))
               (i            (ref self '_int))
               (leftdigits   (+ exp (len i)))
               (dotplace     #f)
               (intpart      #f)
               (fracpart     #f)
               (exppart      #f))
          (cond
           ((ref self '_is_special)
            (cond
             ((eq? (ref self '_exp) 'F)
              (+ sign "Infinity"))
             ((eq? (ref self '_exp) 'n)
              (+ sign  "NaN" (ref self '_int)))
             (else ; self._exp == 'N'
              (+ sign  "sNaN" (ref self '_int)))))
           (else
            ;; dotplace is number of digits of self._int to the left of the
            ;; decimal point in the mantissa of the output string (that is,
            ;; after adjusting the exponent)
            (cond
             ((and (<= exp 0) (> leftdigits  -6))
              ;; no exponent required
              (set! dotplace leftdigits))
             
             ((not eng)
              ;; usual scientific notation: 1 digit on left of the point
              (set! dotplace 1))
             
             ((equal? i "0")
              ;; engineering notation, zero
              (set! dotplace (- (modulo (+ leftdigits 1) 3) 1)))
             (else
              ;; engineering notation, nonzero
              (set! dotplace (- (modulo (+ leftdigits 1) 3) 1))))

            (cond
             ((<= dotplace 0)
              (set! intpart "0")
              (set! fracpart (+ "." (* "0" (- dotplace)) i)))
             ((>= dotplace (len i))
              (set! intpart (+ i (* "0" (- dotplace (len i)))))
              (set! fracpart ""))
             (else
              (set! intpart (pylist-slice i None dotplace None))
              (set! fracpart (+ "." (pylist-slice i dotplace None None)))))

            (cond
             ((= leftdigits dotplace)
              (set! exppart ""))
             (else
              (let ((context (if (eq? context None)
                                 (getcontext)
                                 context)))
                (set! exppart
                      (+ (pylist-ref '("e" "E") (cx-capitals context))
                         (format #f "~@d" (- leftdigits dotplace)))))))
            
            (+ sign intpart fracpart exppart))))))
    
    (define to_eng_string
      (lam (self (= context None))
        "Convert to a string, using engineering notation if an exponent is needed.
        Engineering notation has an exponent which is a multiple of 3.  This
        can leave up to 3 digits to the left of the decimal place and may
        require the addition of either one or two trailing zeros.
        "
        ((ref self '__str__) #:eng #t #:contect context)))

    (define __neg__
      (lam (self (= context None))
        "Returns a copy with the sign switched.

        Rounds, if it has reason.
        "
        (pk '__neg__)
        (twix 
         ((un-special self context) it it)
         (let () (pk 1))
         (let* ((context (if (eq? context None)
                             (getcontext)
                             context))
                (ans     (if (pk (and (not (bool self))
                                  (not (eq? (cx-rounding context)
                                            ROUND_FLOOR))))
                             ;; -Decimal('0') is Decimal('0'),
                             ;; not Decimal('-0'), except
                             ;; in ROUND_FLOOR rounding mode.
                             ((pk (ref self 'copy_abs)))
                             ((pk (ref self 'copy_negate))))))      
           ((ref ans '_fix) context)))))

    (define __pos__
      (lam (self (= context None))
        "Returns a copy, unless it is a sNaN.

        Rounds the number (if more than precision digits)
        "
        (twix
         ((un-special self context) it it)
         
         (let* ((context (if (eq? context None)
                             (getcontext)
                             context))
                (ans     (if (and (not (bool self))
                                  (not (eq? (cx-rounding context)
                                            ROUND_FLOOR)))
                             ;; -Decimal('0') is Decimal('0'),
                             ;; not Decimal('-0'), except
                             ;; in ROUND_FLOOR rounding mode.
                             ((ref self 'copy_abs))
                             (Decimal self))))

           ((ref ans '_fix) context)))))

    (define __abs__
      (lam (self  (= round #t) (= context None))
        "Returns the absolute value of self.

        If the keyword argument 'round' is false, do not round.  The
        expression self.__abs__(round=False) is equivalent to
        self.copy_abs().
        "
        (twix
         ((not (bool round)) it
          ((ref self 'copy_abs)))

         ((un-special self context) it it)

         (if (= (ref self '_sign) 1)
             ((ref self '__neg__) #:context context)
             ((ref self '__pos__) #:context context)))))
    

    (define __add__
      (lam (self other (= context None))
        "Returns self + other.

        -INF + INF (or the reverse) cause InvalidOperation errors.
        "
        (twix
         ((norm-op self other) it it)
         (let (get-context context))

         ((add-special self other context) it it)

         (let* ((negativezero 0)
                (self_sign    (ref self  '_sign))
                (other_sign   (ref other '_sign))
                (self_exp     (ref self  '_exp))
                (other_exp    (ref other '_exp))
                (prec         (cx-prec context))
                (exp          ((@ (guile) min) self_exp other_exp))                 
                (sign         #f)
                (ans          #f))
          
           (if (and (eq? (cx-rounding context) ROUND_FLOOR)
                    (not (= self_sign other_sign)))
               ;; If the answer is 0, the sign should be negative,
               ;; in this case.
               (set! negativezero 1)))

         ((if (and (not (bool self)) (not (bool other)))
              (begin
                (set! sign ((@ (guile) min) self_sign other_sign))
                (if (= negativezero 1)
                    (set! sign 1))
                (set! ans (_dec_from_triple sign "0" exp))
                (set! ans ((ref ans '_fix) context))
                ans)
              #f) it it)

         ((if (not (bool self))
              (begin
                (set! exp ((@ (guile) max) exp (- other_exp prec 1)))
                (set! ans ((ref other '_rescale) exp
                           (cx-rounding context)))
                (set! ans ((ref ans '_fix) context))
                ans)
              #f) it it)

         ((if (not (bool other))
              (begin
                (set! exp ((@ (guile) max) exp (- self_exp prec 1)))
                (set! ans ((ref self '_rescale) exp
                           (cx-rounding context)))
                (set! ans ((ref ans '_fix) context))
                ans)
              #f) it it)
                
         (let* ((op1    (_WorkRep self))
                (op2    (_WorkRep other))
                (ab     (_normalize op1 op2 prec))
                (op1    (car  ab))
                (op2    (cdr  ab))
                (result (_WorkRep))))

         ((cond
           ((not (= (ref op1 'sign) (ref op2 'sign)))
            ;; Equal and opposite
            (twix
             ((equal? self other) it
              (set! ans (_dec_from_triple negativezero "0" exp))
              (set! ans ((ref ans '_fix) context))
              ans)
                    
             (begin
               (if (< self other)
                   (let ((t op1))
                     (set! op1 op2)
                     (set! op2 t)))
                    
               (if (= (ref op1 'sign) 1)                        
                   (let ((t (ref op1 'sign)))
                     (set result 'sign 1)
                     (set op1 'sign (ref op2 'sign))
                     (set op2 'sign t))
                   (set result 'sign 0))
               #f)))
           ((= (ref op1 'sign) 1)
            (set result 'sign 1)
            #f)

           (else
            (set result 'sign 0)
            #f)) it it)

         (begin
           (if (= (ref op2 'sign) 0)
               (set result 'int (+ (ref op1 'int) (ref op2 'int)))
               (set result 'int (- (ref op1 'int) (ref op2 'int))))

           (set result 'exp (ref op1 'exp))
           (set! ans (Decimal result))
           ((ref ans '_fix) context)))))

    (define __radd__ (lambda x (apply __add__ x)))

    (define __sub__
      (lam (self other (= context None))
        "Return self - other"
        (twix
         ((norm-op self other)            it it)
         ((bin-special self other context) it it)
         ((ref self '__add__)
          ((ref other 'copy_negate)) #:context context))))

    (define  __rsub__
      (lam (self other (= context None))
        "Return other - self"
        (twix
         ((norm-op self other) it it)
         ((ref other '__sub__) self  #:context context))))

    (define __mul__
      (lam (self other (= context None))
        "Return self * other.

        (+-) INF * 0 (or its reverse) raise InvalidOperation.
        "
        (twix
         ((norm-op self other) it it)    
         (let (get-context context))
         
         (let ((resultsign (logxor (ref self  '_sign)
                                   (ref other '_sign)))))

         ((mul-special self other context resultsign) it it)

         (let ((resultexp (+ (ref self '_exp) (ref other '_exp)))))

         ;; Special case for multiplying by zero
         ((or (not (bool self)) (not (bool other))) it
          (let ((ans (_dec_from_triple resultsign "0" resultexp)))
            ((ref ans '_fix) context)))
         
         ;; Special case for multiplying by power of 10
         ((equal? (ref self '_int) "1") it
          (let ((ans (_dec_from_triple resultsign (ref other '_int) resultexp)))
            ((ref ans '_fix) context)))

         ((equal? (ref other '_int) "1") it
          (let ((ans (_dec_from_triple resultsign (ref self '_int) resultexp)))
            ((ref ans '_fix) context)))

         (let* ((op1 (_WorkRep self))
                (op2 (_WorkRep other))
                (ans (_dec_from_triple resultsign
                                       (str (* (ref op1 'int) (ref op2 'int)))
                                       resultexp)))
           ((ref ans '_fix) context)))))
  
    (define __rmul__ __mul__)

    (define __truediv__
      (lam (self other (= context None))
        "Return self / other."
        (twix
         ((norm-op self other) it it)    
         (let (get-context context))
   
         (let ((sign (logxor (ref self  '_sign)
                             (ref other '_sign)))))

         ((div-special self other context sign) it it)

         ;; Special cases for zeroes
         ((if (not (bool other))
              (if (not (bool self))
                  ((cx-error context) DivisionUndefined "0 / 0")
                  ((cx-error context) DivisionByZero    "x / 0" sign))
              #f) it it)

         (let ((exp    #f)
               (coeff  #f)
               (prec   (cx-prec context))
               (nself  (len (ref self '_int)))
               (nother (len (ref other '_int))))
           (if (not (bool self))
               (begin
                 (set! exp   (- (ref self '_exp) (ref other '_exp)))
                 (set! coeff 0))
               ;; OK, so neither = 0, INF or NaN
               (let ((shift (+ nother (- nself) prec 1))
                     (op1   (_WorkRep self))
                     (op2   (_WorkRep other)))
                 (set! exp (- (ref self '_exp) (ref other '_exp) shift))
                 (call-with-values
                     (lambda ()
                       (if (>= shift 0)
                           (divmod (* (ref op1 'int) (expt 10 shift))
                                   (ref op2 'int))
                           (divmod (ref op1 'int)
                                   (* (ref op2 'int) (expt 10 shift)))))
                   (lambda (coeff- remainder)
                     (set! coeff
                           (if (not (= remainder 0))
                               ;; result is not exact adjust to ensure
                               ;; correct rounding
                               (if (= (modulo coeff- 5) 0)
                                   (+ coeff- 1)
                                   coeff)
                               (let ((ideal_exp (- (ref self '_exp)
                                                   (ref other '_exp))))
                                 (let lp ((coeff- coeff-) (exp- exp))
                                   (if (and (< exp- ideal_exp)
                                            (= (modulo coeff- 10) 0))
                                       (lp (/ coeff- 10) (+ exp- 1))
                                       (begin
                                         (set! exp exp-)
                                         coeff-))))))))))
                              
           
           (let ((ans (_dec_from_triple sign (str coeff) exp)))
             ((ref ans '_fix) context))))))

    (define _divide
      (lambda (self other context)      
        "Return (self // other, self % other), to context.prec precision.

        Assumes that neither self nor other is a NaN, that self is not
        infinite and that other is nonzero.
        "
        (apply values
        (twix
         (let (let ((sign
                     (logxor (ref self  '_sign)
                             (ref other '_sign)))
                    (ideal_exp
                     (if (bool ((ref other '_isinfinity)))
                         (ref self '_exp)
                         ((@ (guile) min) (ref self 'exp) (ref other '_exp))))
                    (expdiff
                     (- ((ref self 'adjusted)) ((ref other 'adjusted)))))))
         
         ((or (not (bool self))
              (bool ((ref other '_isinfinity)))
              (<= expdiff -1)) it
           (list (_dec_from_triple sign "0" 0)
                 ((ref self '_rescale) ideal_exp (cx-rounding context))))
         
         ((if (<= expdiff  (cx-prec context))
              (let ((op1 (_WorkRep self))
                    (op2 (_WorkRep other)))
                (if (>= (ref op1 'exp) (ref op2 'exp))
                    (set op1 'int (* (ref op1 'int)
                                     (expt 10 (- (ref op1 'exp)
                                                 (ref op2 'exp)))))
                    (set op2 'int (* (ref op2 'int)
                                     (expt 10 (- (ref op2 'exp)
                                                 (ref op1 'exp))))))
                (call-with-values (lambda () (divmod (ref op1 'int)
                                                     (ref op2 'int)))
                  (lambda (q r)         
                    (if (< q (expt 10 (cx-prec context)))
                        (list (_dec_from_triple sign (str q) 0)
                              (_dec_from_triple (ref self '_sign)
                                                (str r)
                                                ideal_exp))
                        #f))))
              #f) it it)
         (begin
           ;; Here the quotient is too large to be representable
           (let ((ans ((cx-raise context) DivisionImpossible
                       "quotient too large in //, % or divmod")))
             (list ans ans)))))))

    (define __rtruediv__
      (lam (self other (= context None))
        "Swaps self/other and returns __truediv__."
        (twix
         ((norm-op self other) it it)    
         ((ref other '__truediv__) self #:context context))))
    
    (define __divmod__
      (lam (self other (= context None))
        "
        Return (self // other, self % other)
        "
        (apply values
        (twix
         ((norm-op self other) it it)    

         (let (get-context context))
         
         ((add-special self other context) it it)
         
         (((ref self '_check_nans) other context) it
          (list it it))

         (let (let ((sign
                     (logxor (ref self  '_sign)
                             (ref other '_sign))))))

         ((bool ((ref self '_isinfinity))) it
          (if (bool ((ref other '_isinfinity)))
              (let ((ans ((cx-error context) InvalidOperation
                          "divmod(INF, INF)")))
                (list ans ans))
              (list (list-ref _SignedInfinity sign)
                    ((cx-raise context) InvalidOperation "INF % x"))))

         ((not (bool other)) it
          (if (not (bool self))
              (let ((ans ((cx-error context) DivisionUndefined
                          "divmod(0, 0)")))
                (list ans ans))
              (list ((cx-error context) DivisionByZero "x // 0" sign)
                    ((cx-error context) InvalidOperation "x % 0"))))
             
         (call-with-values (lambda () ((ref self '_divide) other context))
           (lambda (quotient remainder)
             (let ((remainder ((ref remainder '_fix) context)))
               (list quotient remainder))))))))

    (define __rdivmod__
      (lam (self other (= context None))
        "Swaps self/other and returns __divmod__."
        (twix
         ((norm-op self other) it it)    
         ((ref other '__divmod__) self #:context context))))

    (define __mod__
      (lam (self other (= context None))
        "
        self % other
        "
        (twix
         ((norm-op self other) it it)    

         (let (get-context context))

         ((bin-special self other context) it it)

         ((bool ((ref self '_isinfinity))) it
          ((cx-error context) InvalidOperation "INF % x"))
         
         ((not (bool other)) it
          (if (bool self)
              ((cx-error context) InvalidOperation  "x % 0")          
              ((cx-error context) DivisionUndefined "0 % 0")))

         (let* ((remainder ((ref self '_divide) other context)))
           ((ref remainder '_fix) context)))))

    (define __rmod__
      (lam (self other (= context None))
        "Swaps self/other and returns __mod__."
        (twix
         ((norm-op self other) it it)    
         ((ref other '__mod__) self #:context context))))

    (define remainder_near
      (lam (self other (= context None))
        "
        Remainder nearest to 0-  abs(remainder-near) <= other/2
        "
        (twix
         ((norm-op self other) it it)

         (let (get-context context))

         ((bin-special self other context) it it)

         ;; self == +/-infinity -> InvalidOperation
         ((bool ((ref self '_isinfinity))) it
          ((cx-error context) InvalidOperation "remainder_near(infinity, x)"))

         ;; other == 0 -> either InvalidOperation or DivisionUndefined
         ((not (bool other)) it
          (if (not (bool self))
              ((cx-error context) InvalidOperation  "remainder_near(x, 0)")
              ((cx-error context) DivisionUndefined "remainder_near(0, 0)")))

         ;; other = +/-infinity -> remainder = self
         ((bool ((ref other '_isinfinity))) it
          (let ((ans (Decimal self)))
            ((ref ans '_fix) context)))

         ;; self = 0 -> remainder = self, with ideal exponent
         (let (let ((ideal_exponent ((@ (guile) min) (ref self '_exp) (ref other '_exp))))))

         ((not (bool self)) it
          (let ((ans (_dec_from_triple (ref self '_sign) "0" ideal_exponent)))
            ((ref ans '_fix) context)))

         ;; catch most cases of large or small quotient
         (let (let ((expdiff
                     (- ((ref self 'adjusted)) ((ref other 'adjusted)))))))
         
        ((>= expdiff (+ (cx-prec context) 1)) it
         ;; expdiff >= prec+1 => abs(self/other) > 10**prec
         ((cx-error context) DivisionImpossible))
        
        ((<= expdiff -2) it
         ;; expdiff <= -2 => abs(self/other) < 0.1
         (let ((ans ((ref self '_rescale)
                     ideal_exponent (cx-rounding context))))
           ((ref ans '_fix) context)))

        (let ((op1  (_WorkRep self))
              (op2  (_WorkRep other)))

          ;; adjust both arguments to have the same exponent, then divide
          (if (>= (ref op1 'exp) (ref op2 'exp))
              (set op1 'int (* (ref op1 'int)
                               (expt 10 (- (ref op1 'exp) (ref op2 'exp)))))
              (set op2 'int (* (ref op2 'int)
                               (expt 10 (- (ref op2 'exp) (ref op1 'exp))))))
          
          (call-with-values (lambda () (divmod (ref op1 'int) (ref op2 'int)))
            (lambda (q r)

              ;; remainder is r*10**ideal_exponent; other is +/-op2.int *
              ;; 10**ideal_exponent.   Apply correction to ensure that
              ;; abs(remainder) <= abs(other)/2
              (if (> (+ (* 2 r)  + (logand q 1)) (ref op2 'int))
                  (set! r (- r (ref op2 'int)))
                  (set! q (+ q 1)))

              (if (>= q (expt 10 (cx-prec context)))
                  ((cx-error context) DivisionImpossible)
                  (let ((sign (ref self '_sign)))
                    (if (< r 0)
                        (set! sign (- 1 sign))
                        (set! r    (- r)))
                    (let ((ans (_dec_from_triple sign (str r) ideal_exponent)))
                      ((ref ans '_fix) context))))))))))

    (define __floordiv__
      (lam (self other (= context None))
        "self // other"
        (twix
         ((norm-op self other) it it)

         (let (get-context context))

         ((bin-special self other context) it it)

         ((bool ((ref self '_isinfinity))) it
          (if (bool ((ref other '_isinfinity)))
               ((cx-error context) InvalidOperation "INF // INF")
               (pylist-ref _SignedInfinity (logxor (ref self  '_sign)
                                                   (ref other '_sign)))))

         ((not (bool other)) it
          (if (bool self)
              ((cx-error context) DivisionByZero    "x // 0"
               (logxor (ref self  '_sign) (ref other '_sign)))
              ((cx-error context) DivisionUndefined "0 // 0")))

         ((ref self '_divide) other context))))

    (define __rfloordiv__
      (lam (self other (= context None))
        "Swaps self/other and returns __floordiv__."
        (twix
         ((norm-op self other) it it)    
         ((ref other '__floordiv__) self #:context context))))

    (define __float__
      (lambda (self)
        "Float representation."
        (if ((ref self '_isnan))
            (if ((ref self 'is_snan))
                (raise (ValueError "Cannot convert signaling NaN to float"))
                (if (= (ref self '_sign))
                    (- (nan))
                    (nan)))
            (if ((ref self '_isspecial))
                (if (= (ref self '_sign))
                    (- (inf))
                    (inf))
                (float (str self))))))
    
    (define __int__
      (lambda (self)
        "Converts self to an int, truncating if necessary."
        (if ((ref self '_isnan))
            (raise (ValueError "Cannot convert NaN to integer"))
            (if ((ref self '_isspecial))
                (raise (OverflowError "Cannot convert infinity to integer"))
                (let ((s (if (= (ref self '_sign) 1) -1 1)))
                  (if (>= (ref self '_exp) 0)
                      (* s (int (ref self '_int)) (expt 10 (ref self '_exp)))
                      (* s (int (or (bool (pylist-slice (ref self '_int)
                                                    None (ref self '_exp) None))
                                    "0")))))))))

    (define __trunc__ __int__)

    (define real
      (property (lambda (self) self)))
    
    (define imag
      (property
       (lambda (self)
         (Decimal 0))))

    (define conjugate
      (lambda (self) self))
    
    (define __complex__
      (lambda (self)
        (complex (float self))))

    (define _fix_nan
      (lambda (self context)
        "Decapitate the payload of a NaN to fit the context"
        (let ((payload (ref self '_int))
              
              ;; maximum length of payload is precision if clamp=0,
              ;; precision-1 if clamp=1.
              (max_payload_len
               (- (ref context 'prec)
                  (ref context 'clamp))))
          
          (if (> (len payload)  max_payload_len)
              (let ((payload (py-lstrip
                              (pylist-slice payload
                                            (- (len payload) max_payload_len)
                                            None None)  "0")))
                (_dec_from_triple (ref self '_sign) payload (ref self '_exp)
                                  #t))
              (Decimal self)))))

    (define _fix 
      (lambda (self context)
        "Round if it is necessary to keep self within prec precision.

        Rounds and fixes the exponent.  Does not raise on a sNaN.

        Arguments:
        self - Decimal instance
        context - context used.
        "

        (twix
         (let () (pk 3 1))
         ((ref self '_is_special) it
          (if ((ref self '_isnan))
              ;; decapitate payload if necessary
              ((ref self '_fix_nan) context)

              ;; self is +/-Infinity; return unaltered
              (Decimal self)))
         (let () (pk 3 2))
         ;; if self is zero then exponent should be between Etiny and
         ;; Emax if clamp==0, and between Etiny and Etop if clamp==1.
         (let ((Etiny (cx-etiny context))
               (Etop  (cx-etop  context))))
         (let () (pk 3 3))
         ((not (bool self)) it
          (let* ((exp_max (if (= (cx-clamp context) 0)
                              (cx-emax context)
                              Etop))
                 (new_exp ((@ (guile) min) ((@ (guile) max) (ref self '_exp) Etiny) exp_max)))
            (if (not (= new_exp (ref self '_exp)))
                (begin
                  ((cx-error context) Clamped)
                  (_dec_from_triple (ref self '_sign) "0" new_exp))
                (Decimal self))))
         (let () (pk 3 4))
         ;; exp_min is the smallest allowable exponent of the result,
         ;; equal to max(self.adjusted()-context.prec+1, Etiny)
         (let ((exp_min (+ (len (ref self '_int))
                           (ref self '_exp)
                           (- (cx-prec context))))))
         ((> exp_min Etop) it
          ;; overflow: exp_min > Etop iff self.adjusted() > Emax
          (let ((ans ((cx-error context) Overflow "above Emax"
                      (ref self '_sign))))
            ((cx-error context) Inexact)
            ((cx-error context) Rounded)
            ans))
         (let () (pk 3 5))
         (let* ((self_is_subnormal (< exp_min Etiny))
                (exp_min           (if self_is_subnormal Etiny exp_min))))
         (let () (pk 3 6))
         ;; round if self has too many digits
         ((< (ref self '_exp) exp_min) it
          (let ((digits (+ (len (ref self '_int))
                           (ref self '_exp)
                           (- exp_min))))
            (pk 3 7)
            (if (< digits 0)
                (set! self (_dec_from_triple (ref self '_sign)
                                             "1" (- exp_min 1)))
                (set! digits 0))
            
            (for ((k v : (ref self '_pick_rounding_function))) ()
                 (pk k (v)))
            
            (pk 3 8)
            (let* ((ans #f)
                   (rounding_method (pk 'me (pylist-ref
                                     (ref self '_pick_rounding_function)
                                     (pk 'r (cx-rounding context)))))
                   (changed (rounding_method self digits))
                   (coeff   (or (bool (pylist-slice (ref self '_int)
                                                    None digits None)) "0")))
              (pk 3 9)
              (if (> changed  0)
                  (begin
                    (set! coeff (str (+ (int coeff) 1)))
                    (if (> (len coeff) (cx-prec context))
                        (begin
                          (set! coeff (pylist-slice coeff None -1 None))
                          (set! exp_min (+ exp_min  1))))))
              (pk 3 10)
              ;; check whether the rounding pushed the exponent out of range
              (if (> exp_min  Etop)
                  (set! ans
                        ((cx-error context) Overflow "above Emax"
                         (ref self '_sign)))
                  (set! ans (_dec_from_triple (ref self '_sign) coeff exp_min)))
              (pk 3 11)
              ;; raise the appropriate signals, taking care to respect
              ;; the precedence described in the specification
              (if (and changed self_is_subnormal)
                  ((cx-error context) Underflow))
              (pk 3 12)
              (if self_is_subnormal
                  ((cx-error context) Subnormal))
              (pk 3 13)
              (if changed
                  ((cx-error context) Inexact))
              (pk 3 14)
              ((cx-error context) Rounded)

              (pk 3 15)
              (if (not (bool ans))
                  ;; raise Clamped on underflow to 0
                  ((cx-error context) Clamped))

              ans)))
         
         (let () (pk 3 7))
         
         (begin
           (if self_is_subnormal
               ((cx-error context) Subnormal))

           (let () (pk 4))
           ;; fold down if clamp == 1 and self has too few digits
           (if (and (= (cx-clamp context) 1) (> (ref self '_exp) Etop))
               (begin
                 ((cx-error context) Clamped)
                 (let () (pk 5))
                 (let ((self_padded  (+ (ref self '_int)
                                        (* "0"
                                           (- (ref self '_exp) Etop)))))
                   (let () (pk 6))
                   (_dec_from_triple (ref self '_sign) self_padded Etop)))
               
               ;; here self was representable to begin with; return unchanged
               (Decimal self))))))
    
    

    ;; for each of the rounding functions below:
    ;;   self is a finite, nonzero Decimal
    ;;   prec is an integer satisfying 0 <= prec < len(self._int)
    ;;
    ;; each function returns either -1, 0, or 1, as follows:
    ;;   1 indicates that self should be rounded up (away from zero)
    ;;   0 indicates that self should be truncated, and that all the
    ;;    digits to be truncated are zeros (so the value is unchanged)
    ;;  -1 indicates that there are nonzero digits to be truncated

    (define _round_down
      (lambda (self prec)
        "Also known as round-towards-0, truncate."
        (if (_all_zeros (ref self '_int) prec)
            0
            -1)))

    (define _round_up
      (lambda (self prec)
        "Rounds away from 0."
        (- (_round_down self prec))))

    (define _round_half_up
      (lambda (self prec)
        "Rounds 5 up (away from 0)"
        (cond
         ((in (pylist-ref (ref self '_int) prec) "56789")
          1)
         ((_all_zeros (ref self '_int) prec)
          0)
         (else -1))))
    
    (define _round_half_down
      (lambda (self prec)
        "Round 5 down"
        (if (_exact_half (ref self '_int) prec)
            -1
            (_round_half_up self prec))))

    (define _round_half_even
      (lambda (self prec)
        "Round 5 to even, rest to nearest."
        (if (and (_exact_half (ref self '_int) prec)
                 (or (= prec 0)
                     (in (pylist-ref (ref self '_int) (- prec 1)) "02468")))
            -1)
       (_round_half_up self prec)))

    (define _round_ceiling
      (lambda (self prec)
        "Rounds up (not away from 0 if negative.)"
        (if (= (ref self '_sign) 1)
            (_round_down self prec)
            (- (_round_down self prec)))))

    (define _round_floor
      (lambda (self prec)
        "Rounds down (not towards 0 if negative)"
        (if (= (ref self '_sign) 1)
            (- (_round_down self prec))
            (_round_down self prec))))
    
    (define _round_05up
      (lambda (self prec)
        "Round down unless digit prec-1 is 0 or 5."
        (if (and prec (not (in (pylist-ref (ref self '_int) (- prec 1) "05"))))
            (_round_down self prec)
            (- (_round_down self prec)))))
    

    (define __round__
      (lam (self  (= n None))
        "Round self to the nearest integer, or to a given precision.

        If only one argument is supplied, round a finite Decimal
        instance self to the nearest integer.  If self is infinite or
        a NaN then a Python exception is raised.  If self is finite
        and lies exactly halfway between two integers then it is
        rounded to the integer with even last digit.

        >>> round(Decimal('123.456'))
        123
        >>> round(Decimal('-456.789'))
        -457
        >>> round(Decimal('-3.0'))
        -3
        >>> round(Decimal('2.5'))
        2
        >>> round(Decimal('3.5'))
        4
        >>> round(Decimal('Inf'))
        Traceback (most recent call last):
          ...
        OverflowError: cannot round an infinity
        >>> round(Decimal('NaN'))
        Traceback (most recent call last):
          ...
        ValueError: cannot round a NaN

        If a second argument n is supplied, self is rounded to n
        decimal places using the rounding mode for the current
        context.

        For an integer n, round(self, -n) is exactly equivalent to
        self.quantize(Decimal('1En')).

        >>> round(Decimal('123.456'), 0)
        Decimal('123')
        >>> round(Decimal('123.456'), 2)
        Decimal('123.46')
        >>> round(Decimal('123.456'), -2)
        Decimal('1E+2')
        >>> round(Decimal('-Infinity'), 37)
        Decimal('NaN')
        >>> round(Decimal('sNaN123'), 0)
        Decimal('NaN123')

        "
        (if (not (eq? n None))
            ;; two-argument form: use the equivalent quantize call
            (if (not (isinstance n int))
                (raise (TypeError
                        "Second argument to round should be integral"))
                (let ((exp (_dec_from_triple 0 "1" (- n))))
                  ((ref self 'quantize) exp)))

            ;; one-argument form§x
            (if (ref self '_is_special)
                (if ((ref self 'is_nan))
                    (raise (ValueError    "cannot round a NaN"))
                    (raise (OverflowError "cannot round an infinity")))
                (int ((ref self '_rescale) 0 ROUND_HALF_EVEN))))))

    (define __floor__
      (lambda (self)
        "Return the floor of self, as an integer.

        For a finite Decimal instance self, return the greatest
        integer n such that n <= self.  If self is infinite or a NaN
        then a Python exception is raised.

        "
        (if (ref self '_is_special)
                (if ((ref self 'is_nan))
                    (raise (ValueError    "cannot round a NaN"))
                    (raise (OverflowError "cannot round an infinity")))
                (int ((ref self '_rescale) 0 ROUND_FLOOR)))))

    (define __ceil__
      (lambda (self)
        """Return the ceiling of self, as an integer.

        For a finite Decimal instance self, return the least integer n
        such that n >= self.  If self is infinite or a NaN then a
        Python exception is raised.

        """
        (if (ref self '_is_special)
            (if ((ref self 'is_nan))
                (raise (ValueError    "cannot round a NaN"))
                (raise (OverflowError "cannot round an infinity")))
            (int ((ref self '_rescale) 0 ROUND_CEILING)))))

    (define fma
      (lam (self other third (= context None))
        "Fused multiply-add.

        Returns self*other+third with no rounding of the intermediate
        product self*other.

        self and other are multiplied together, with no rounding of
        the result.  The third operand is then added to the result,
        and a single final rounding is performed.
        "
        (twix
         (let ((other (_convert_other other #:raiseit #t))
               (third (_convert_other third #:raiseit #t))
               (fin   (lambda (product)
                        ((ref product '__add__) third context)))))
         ;; compute product; raise InvalidOperation if either operand is
         ;; a signaling NaN or if the product is zero times infinity.    
        ((if (or (ref self '_is_special) (ref other '_is_special))
             (twix
              (let (get-context context))
              ((equal? (ref self '_exp) "N")  it
               ((cx-error context) InvalidOperation "sNaN" self))
              ((equal? (ref other '_exp) "N") it
               ((cx-error context) InvalidOperation "sNaN" other))
              ((equal? (ref self '_exp) "n")  it
               (fin self))
              ((equal? (ref other '_exp) "n") it
               (fin other))
              ((equal? (ref self '_exp) "F")  it
               (if (not (bool other))
                   ((cx-error context) InvalidOperation "INF * 0 in fma")
                   (pylist-ref _SignedInfinity
                               (logxor (ref self  '_sign)
                                       (ref other '_sign)))))
              ((equal? (ref other '_exp) "F")  it
               (if (not (bool self))
                   ((cx-error context) InvalidOperation "0 * INF in fma")
                   (pylist-ref _SignedInfinity
                               (logxor (ref self  '_sign)
                                       (ref other '_sign)))))
              #f)) it it)
        
        (fin
         (_dec_from_triple (logxor (ref self '_sign) (ref other '_sign))
                           (str (* (int (ref self '_int))
                                   (int (ref other '_int))))
                           (+ (ref self '_exp) (ref other '_exp)))))))
    
    (define _power_modulo
      (lam (self other modulo (= context None))
        "Three argument version of __pow__"
        (twix
         ((norm-op self other ) it it)
         ((norm-op self modulo) it it)
         (let (get-context context))

         ;; deal with NaNs: if there are any sNaNs then first one wins,
         ;; (i.e. behaviour for NaNs is identical to that of fma)
         (let ((self_is_nan   (ref self   '_isnan))
               (other_is_nan  (ref other  '_isnan))
               (modulo_is_nan (ref modulo '_isnan))))
         
         ((or (bool self_is_nan) (bool other_is_nan) (bool modulo_is_nan)) it
          (cond
           ((= self_is_nan 2)
            ((cx-error context) InvalidOperation "sNaN"  self))
           ((= other_is_nan 2)
            ((cx-error context) InvalidOperation "sNaN"  other))
           ((modulo_is_nan 2)
            ((cx-error context) InvalidOperation "sNaN"  modulo))
           ((bool self_is_nan)
            (_fix_nan self context))
           ((bool other_is_nan)
            (_fix_nan other context))
           (else
            (_fix_nan modulo context))))
         
         ;;check inputs: we apply same restrictions as Python's pow()
         ((not (and ((ref self   '_isinteger))
                    ((ref other  '_isinteger))
                    ((ref modulo '_isinteger)))) it
          ((cx-error context) InvalidOperation
           (+ "pow() 3rd argument not allowed "
              "unless all arguments are integers")))
         
         ((< other 0) it
          ((cx-error context) InvalidOperation
           (+ "pow() 2nd argument cannot be "
              "negative when 3rd argument specified")))

         ((not (bool modulo)) it
             ((cx-error context) InvalidOperation
              "pow() 3rd argument cannot be 0"))

         ;; additional restriction for decimal: the modulus must be less
         ;; than 10**prec in absolute value
         ((>= ((ref modulo 'adjusted)) (cx-prec context)) it
          ((cx-error context) InvalidOperation
           (+ "insufficient precision: pow() 3rd "
              "argument must not have more than "
              "precision digits")))

         ;; define 0**0 == NaN, for consistency with two-argument pow
         ;; (even though it hurts!)
         ((and (not (bool other)) (not (bool self))) it
          ((cx-error context) InvalidOperation
           (+ "at least one of pow() 1st argument "
              "and 2nd argument must be nonzero ;"
              "0**0 is not defined")))

         ;; compute sign of result
         (let ((sign     (if ((ref other '_iseven))
                             0
                             (ref self '_sign)))
               (base     (_WorkRep ((ref self  'to_integral_value))))
               (exponent (_WorkRep ((ref other 'to_integral_value)))))


           ;; convert modulo to a Python integer, and self and other to
           ;; Decimal integers (i.e. force their exponents to be >= 0)
           (set! modulo (abs (int modulo)))

           ;; compute result using integer pow()
           (set! base (guile:modulo
                       (* (guile:modulo (ref base 'int) modulo)
                          (modulo-expt 10 (ref base 'exp) modulo))
                       modulo))
           
           (let lp ((i (ref exponent 'exp)))
             (if (> i 0)
                 (begin
                   (set! base (modulo-expt base 10 modulo))
                   (lp (- i 1)))))
           
           (set! base (modulo-expt base (ref exponent 'int) modulo))
           
           (_dec_from_triple sign (str base) 0)))))

    (define _power_exact 
      (lambda (self other p)
        "Attempt to compute self**other exactly.

        Given Decimals self and other and an integer p, attempt to
        compute an exact result for the power self**other, with p
        digits of precision.  Return None if self**other is not
        exactly representable in p digits.

        Assumes that elimination of special cases has already been
        performed: self and other must both be nonspecial; self must
        be positive and not numerically equal to 1; other must be
        nonzero.  For efficiency, other._exp should not be too large,
        so that 10**abs(other._exp) is a feasible calculation."

        ;; In the comments below, we write x for the value of self and y for the
        ;; value of other.  Write x = xc*10**xe and abs(y) = yc*10**ye, with xc
        ;; and yc positive integers not divisible by 10.

        ;; The main purpose of this method is to identify the *failure*
        ;; of x**y to be exactly representable with as little effort as
        ;; possible.  So we look for cheap and easy tests that
        ;; eliminate the possibility of x**y being exact.  Only if all
        ;; these tests are passed do we go on to actually compute x**y.

        ;; Here's the main idea.  Express y as a rational number m/n, with m and
        ;; n relatively prime and n>0.  Then for x**y to be exactly
        ;; representable (at *any* precision), xc must be the nth power of a
        ;; positive integer and xe must be divisible by n.  If y is negative
        ;; then additionally xc must be a power of either 2 or 5, hence a power
        ;; of 2**n or 5**n.
        ;;
        ;; There's a limit to how small |y| can be: if y=m/n as above
        ;; then:
        ;;
        ;;  (1) if xc != 1 then for the result to be representable we
        ;;      need xc**(1/n) >= 2, and hence also xc**|y| >= 2.  So
        ;;      if |y| <= 1/nbits(xc) then xc < 2**nbits(xc) <=
        ;;      2**(1/|y|), hence xc**|y| < 2 and the result is not
        ;;      representable.
        ;;
        ;;  (2) if xe != 0, |xe|*(1/n) >= 1, so |xe|*|y| >= 1.  Hence if
        ;;      |y| < 1/|xe| then the result is not representable.
        ;;
        ;; Note that since x is not equal to 1, at least one of (1) and
        ;; (2) must apply.  Now |y| < 1/nbits(xc) iff |yc|*nbits(xc) <
        ;; 10**-ye iff len(str(|yc|*nbits(xc)) <= -ye.
        ;;
        ;; There's also a limit to how large y can be, at least if it's
        ;; positive: the normalized result will have coefficient xc**y,
        ;; so if it's representable then xc**y < 10**p, and y <
        ;; p/log10(xc).  Hence if y*log10(xc) >= p then the result is
        ;; not exactly representable.

        ;; if len(str(abs(yc*xe)) <= -ye then abs(yc*xe) < 10**-ye,
        ;; so |y| < 1/xe and the result is not representable.
        ;; Similarly, len(str(abs(yc)*xc_bits)) <= -ye implies |y|
        ;; < 1/nbits(xc).

        (twix
         (let ()
           (define-syntax-rule (clean xc xe n +)
             (let lp ()
               (if (= (modulo xc n) 0)
                   (begin
                     (set! xc (/ xc n))
                     (set! xe (+ xe 1))
                     (lp))))))

         (let* ((x  (_WorkRep self))
                (xc (ref x 'int))
                (xe (ref x 'exp)))
           (clean xc xe 10 +))
         
         (let* ((y  (_WorkRep other))
                (yc (ref y 'int))
                (ye (ref y 'exp)))
           (clean yc ye 10 +))
         
        ;; case where xc == 1: result is 10**(xe*y), with xe*y
        ;; required to be an integer
        ((= xc 1) it
         (set! xe (* xe yc))

         ;; result is now 10**(xe * 10**ye);  xe * 10**ye must be integral
         (clean xe ye 10 +)
         
         (if (< ye 0)
             None
             (let ((exponent (* xe (expt 10 ye)))
                   (zeros    #f))
               (if (= (ref y 'sign) 1)
                   (set! exponent (- exponent)))
               
               ;;if other is a nonnegative integer, use ideal exponent
               (if (and ((ref other '_isinteger)) (= (ref other '_sign) 0))
                   (begin
                     (let ((ideal_exponent (* (ref self '_exp) (int other))))
                       (set! zeros ((@ (guile) min) (- exponent ideal_exponent) (- p 1)))))
                   (set! zeros 0))

               (_dec_from_triple 0 (+ "1" (* "0" zeros)) (- exponent zeros)))))

        ;; case where y is negative: xc must be either a power
        ;; of 2 or a power of 5.
        ((= (ref y 'sign) 1) it
         (let ((last_digit (modulo xc 10)))
           (twix
            (let ((e #f)))
            ((cond
              ((= (modulo last_digit 2) 0)
               ;; quick test for power of 2
               (twix
                ((not (= (logand xc (- xc)) xc)) it
                 None)
                ;; now xc is a power of 2; e is its exponent
                (let () (set! e (- (_nbits xc) 1)))
                
                ;; We now have:
                ;;
                ;;   x = 2**e * 10**xe, e > 0, and y < 0.
                ;;
                ;; The exact result is:
                ;;
                ;;   x**y = 5**(-e*y) * 10**(e*y + xe*y)
                ;;
                ;; provided that both e*y and xe*y are integers.
                ;; Note that if
                ;; 5**(-e*y) >= 10**p, then the result can't be expressed
                ;; exactly with p digits of precision.
                ;;
                ;; Using the above, we can guard against large values of ye.
                ;; 93/65 is an upper bound for log(10)/log(5), so if
                ;;
                ;;   ye >= len(str(93*p//65))
                ;;
                ;; then
                ;;
                ;;   -e*y >= -y >= 10**ye > 93*p/65 > p*log(10)/log(5),
                ;;
                ;; so 5**(-e*y) >= 10**p, and the coefficient of the result
                ;; can't be expressed in p digits.
                
                ;; emax >= largest e such that 5**e < 10**p.
                (let ((emax (quotient (* p 93) 65))))

                ((>= ye (len (str emax))) it
                 None)

                ;; Find -e*y and -xe*y; both must be integers
                (let ()
                  (set! e  (_decimal_lshift_exact (* e  yc) ye))
                  (set! xe (_decimal_lshift_exact (* xe yc) ye)))
                  
                ((or (eq? e None) (eq? xe None)) it
                 None)

                ((> e emax) it
                 None)

                (begin
                  (set! xc (expt 5 e))
                  #f)))
            
              ((= last_digit 5)
               (twix
                ;; e >= log_5(xc) if xc is a power of 5; we have
                ;; equality all the way up to xc=5**2658
                (let* ((e         (quotient (* (_nbits xc) 28) 65))
                       (q         (expt 5 e))
                       (xz        xc)
                       (xc        (quotient q xz))
                       (remainder (modulo   q xz))))
                
                ((not (= remainder 0)) it
                 None)
                
                (let () (clean xc e 5 -))
                
                ;; Guard against large values of ye, using the same logic as in
                ;; the 'xc is a power of 2' branch.  10/3 is an upper bound for
                ;; log(10)/log(2).
                (let ((emax (quotient (* p 10) 3))))

                ((>= ye (len (str emax))) it
                 None)

                (let ()
                  (set! e  (_decimal_lshift_exact (* e  yc) ye))
                  (set! xe (_decimal_lshift_exact (* xe yc) ye)))
                
                ((or (eq? e None) (eq? xe None)) it
                 None)

                ((> e emax) it
                 None)

                (begin
                  (set! xc (expt 2 e))
                  #f)))

              (else
               None)) it it)

            ((>= xc (expt 10 p)) it it)

            (begin
              (set! xe (+ (- e) (- xe)))
              (_dec_from_triple 0 (str xc) xe)))))

        ;; now y is positive; find m and n such that y = m/n
        (let ((m #f) (n #f) (xc_bits (_nbits xc))))
        ((if (>= ye 0)
             (begin
               (set! m (* yc (expt 10 ye)))
               (set! n 1)
               #f)
             (twix
              ((and (not (= xe 0)) (<= (len (str (abs (* yc xe)))) (- ye))) it
               None)
           
              ((and (not (= xc 1))
                    (<= (len (str (* (abs yc) xc_bits))) (- ye))) it
                None)

              (begin
                (set! m yc)
                (set! n (expt 10 (- ye)))

                (let lp()
                  (if (and (= (modulo m 2) 0) (= (modulo n 2) 0))
                      (begin
                        (set! m (quotient m 2))
                        (set! n (quotient n 2)))))
                (let lp()
                  (if (and (= (modulo m 5) 0) (= (modulo n 5) 0))
                      (begin
                        (set! m (quotient m 5))
                        (set! n (quotient n 5)))))
                #f))) it it)
        
        ;; compute nth root of xc*10**xe
        ((if (> n 1)
             (begin
               (twix
                ;; if 1 < xc < 2**n then xc isn't an nth power
                ((and (not (= xc 1)) (<= xc_bits n)) it
                 None)

                ((not (= (modulo xe n) 0)) it
                 None)

                (begin
                  (let ((a (ash 1 (- (quotient (- xc_bits) n)))))
                    (set! xe (quotient xe n))
                
                    ;; compute nth root of xc using Newton's method            
                    (let lp ()
                      (let* ((x (expt a (- n 1)))
                             (q (quotient xc x))
                             (r (modulo   xc x)))
                        (if (<= a q)
                            (if (not (and (= a q) (= r 0)))
                                None
                                (begin
                                  (set! xc a)
                                  #f))
                            (begin
                              (set! a (quotient (+ (* a (- n 1)) q) n))
                              (lp)))))))))
             #f) it it)

        ;; now xc*10**xe is the nth root of the original xc*10**xe
        ;; compute mth power of xc*10**xe

        ;; if m > p*100//_log10_lb(xc) then m > p/log10(xc), hence xc**m >
        ;; 10**p and the result is not representable.
        ((and (> xc 1) (> m (quotient (* p 100) (_log10_lb xc)))) it
         None)

        (let ()
          (set! xc (expt xc m))
          (set! xe (xe * m)))
        
        ((> xc  (expt 10 p)) it
         None)

        (begin
          ;; by this point the result *is* exactly representable
          ;; adjust the exponent to get as close as possible to the ideal
          ;; exponent, if necessary
          (let* ((str_xc (str xc))
                 (zeros (if (and ((ref other '_isinteger))
                                 (= (ref other '_sign) 0))
                            (let ((ideal_exponent
                                   (* (ref self '_exp) (int other))))
                              ((@ (guile) min) (- xe ideal_exponent)
                                   (- p  (len str_xc))))
                            0)))
            (_dec_from_triple 0  (+ str_xc (* '0' zeros)) (- xe zeros)))))))

    (define _pick_rounding_function
      (dict `((,ROUND_DOWN      . ,(D _round_down))
              (,ROUND_UP        . ,(D _round_up  ))
              (,ROUND_HALF_UP   . ,(D _round_half_up))
              (,ROUND_HALF_DOWN . ,(D _round_half_down))
              (,ROUND_HALF_EVEN . ,(D _round_half_even))
              (,ROUND_CEILING   . ,(D _round_ceiling))
              (,ROUND_FLOOR     . ,(D _round_floor))
              (,ROUND_05UP      . ,(D _round_05up)))))

    (define __pow__
      (lam (self other (= modulo None) (= context None))
        "Return self ** other [ % modulo].

        With two arguments, compute self**other.

        With three arguments, compute (self**other) % modulo.  For the
        three argument form, the following restrictions on the
        arguments hold:

         - all three arguments must be integral
         - other must be nonnegative
         - either self or other (or both) must be nonzero
         - modulo must be nonzero and must have at most p digits,
           where p is the context precision.

        If any of these restrictions is violated the InvalidOperation
        flag is raised.

        The result of pow(self, other, modulo) is identical to the
        result that would be obtained by computing (self**other) %
        modulo with unbounded precision but is computed more
        efficiently.  It is always exact.
        "

        (twix
         ((not (eq? modulo None)) it
          ((ref self '_power_modulo) other modulo context))

         ((norm-op self other ) it it)
         (let (get-context context))

         ;; either argument is a NaN => result is NaN
         ((bin-special self other context) it it)

         ;; 0**0 = NaN (!), x**0 = 1 for nonzero x (including +/-Infinity)
         ((not (bool other)) it
          (if (not (bool self))
              ((cx-error context) InvalidOperation "0 ** 0")
              _One))
         
         ;; result has sign 1 iff self._sign is 1 and other is an odd integer
         (let ((result_sign  0)))

         ((if (= (ref self '_sign) 1)
              (twix
                ((if ((ref other '_isinteger))
                     (if (not ((ref other '_iseven)))
                         (begin
                           (set! result_sign 1)
                           #f)
                         #f)
                     ;; -ve**noninteger = NaN
                     ;; (-0)**noninteger = 0**noninteger
                     (if (bool self)
                         ((cx-error context) InvalidOperation 
                          "x ** y with x negative and y not an integer")
                         #f)) it it)
                (begin
                  ;; negate self, without doing any unwanted rounding
                  (set! self ((ref self 'copy_negate)))
                  #f))        
              #f) it it)

        ;; 0**(+ve or Inf)= 0; 0**(-ve or -Inf) = Infinity
        ((not (bool self)) it
         (if (= (ref other '_sign) 0)
             (_dec_from_triple result_sign "0" 0)
             (pylist-ref _SignedInfinity result_sign)))

        ;; Inf**(+ve or Inf) = Inf; Inf**(-ve or -Inf) = 0
        ((bool ((self '_isinfinity))) it
         (if (= (ref other '_sign) 0)
             (pylist-ref _SignedInfinity result_sign)
             (_dec_from_triple result_sign "0" 0)))

        ;; 1**other = 1, but the choice of exponent and the flags
        ;; depend on the exponent of self, and on whether other is a
        ;; positive integer, a negative integer, or neither
        (let ((prec (cx-prec context))))
        
        ((equal? self _One) it
         (let ((exp  #f))             
           (if ((ref other '_isinteger))
               ;; exp = max(self._exp*max(int(other), 0),
               ;; 1-context.prec) but evaluating int(other) directly
               ;; is dangerous until we know other is small (other
               ;; could be 1e999999999)
               (let ((multiplier
                      (cond
                       ((= (ref other '_sign) 1)
                        0)
                       ((> other prec)
                        prec)
                       (else
                        (int other)))))

                 (set! exp (* (ref self '_exp) multiplier))
                 (if (< exp (- 1 prec))
                     (begin
                       (set! exp (- 1 prec))
                       ((cx-error context) Rounded))))
               (begin
                 ((cx-error context) Inexact)
                 ((cx-error context) Rounded)
                 (set! exp (- 1 prec))))

           (_dec_from_triple result_sign  (+ "1" (* "0" (- exp)) exp))))

        ;; compute adjusted exponent of self
        (let ((self_adj ((ref self 'adjusted)))))

        ;; self ** infinity is infinity if self > 1, 0 if self < 1
        ;; self ** -infinity is infinity if self < 1, 0 if self > 1
        ((bool ((ref other '_isinfinity))) it
         (if (eq? (= (ref other '_sign) 0)
                  (< self_adj           0))
             (_dec_from_triple result_sign "0" 0)
             (pylist-ref _SignedInfinity result_sign)))

        ;; from here on, the result always goes through the call
        ;; to _fix at the end of this function.
        (let ((ans   None)
              (exact #f)
              (bound (+ ((ref self '_log10_exp_bound))
                        ((ref other 'adjusted)))))

          ;; crude test to catch cases of extreme overflow/underflow.  If
          ;; log10(self)*other >= 10**bound and bound >= len(str(Emax))
          ;; then 10**bound >= 10**len(str(Emax)) >= Emax+1 and hence
          ;; self**other >= 10**(Emax+1), so overflow occurs.  The test
          ;; for underflow is similar.
        
        (if (eq? (>= self_adj 0) (= (ref other '_sign) 0))
            ;; self > 1 and other +ve, or self < 1 and other -ve
            ;; possibility of overflow
            (if (>= bound (len (str (cx-emax context))))
                (set! ans
                      (_dec_from_triple result_sign "1"
                                        (+ (cx-emax context) 1))))
            
            ;; self > 1 and other -ve, or self < 1 and other +ve
            ;; possibility of underflow to 0
            (let ((Etiny (cx-etiny context)))
              (if (>= bound (len (str (- Etiny))))
                  (set! ans (_dec_from_triple result_sign "1" (- Etiny 1))))))

        ;; try for an exact result with precision +1
        (when (eq? ans None)
          (set! ans ((ref self '_power_exact) other (+ prec 1)))
          (when (not (eq? ans None))          
            (if (= result_sign 1)
                (set! ans (_dec_from_triple 1  (ref ans '_int)
                                            (ref ans '_exp))))
            (set! exact #t)))

        ;; usual case: inexact result, x**y computed directly as exp(y*log(x))
        (when (eq? ans None)
          (let* ((p  prec)
                     
                 (x  (_WorkRep self))
                 (xc (ref x 'int))
                 (xe (ref x 'exp))

                 (y  (_WorkRep other))
                 (yc (ref y 'int))
                 (ye (ref y 'exp)))

            (if (= (ref y 'sign) 1)
                (set! yc (- yc)))

            ;; compute correctly rounded result:  start with precision +3,
            ;; then increase precision until result is unambiguously roundable
            (call-with-values
                (lambda ()
                  (let lp ((extra 3))
                    (call-with-values
                        (lambda () (_dpower xc xe yc ye (+ p extra)))
                      (lambda (coeff exp)                 
                        (if (modulo coeff
                                    (* 5 (expt 10 (- (len (str coeff)) p 1))))
                            (values coeff exp)
                            (lp (+ extra 3)))))))
              (lambda (coeff exp)           
                (set! ans (_dec_from_triple result_sign (str coeff) exp))))))

        ;; unlike exp, ln and log10, the power function respects the
        ;; rounding mode; no need to switch to ROUND_HALF_EVEN here

        ;; There's a difficulty here when 'other' is not an integer and
        ;; the result is exact.  In this case, the specification
        ;; requires that the Inexact flag be raised (in spite of
        ;; exactness), but since the result is exact _fix won't do this
        ;; for us.  (Correspondingly, the Underflow signal should also
        ;; be raised for subnormal results.)  We can't directly raise
        ;; these signals either before or after calling _fix, since
        ;; that would violate the precedence for signals.  So we wrap
        ;; the ._fix call in a temporary context, and reraise
        ;; afterwards.
        (if (and exact (not ((ref other '_isinteger))))
            (begin
              ;; pad with zeros up to length context.prec+1 if necessary; this
              ;; ensures that the Rounded signal will be raised.
              (if (<= (len (ref ans '_int)) prec)
                  (let ((expdiff (+ prec 1 (- (len (ref ans '_int))))))
                    (set! ans (_dec_from_triple (ref ans '_sign)
                                                (+ (ref ans '_int)
                                                   (* "0" expdiff))
                                                (- (ref ans '_exp) expdiff)))))

              ;; create a copy of the current context, with cleared flags/traps
              (let ((newcontext (cx-copy context)))
                (cx-clear_flags newcontext)

                (for ((exception : _signals)) ()
                     (pylist-set! (cx-traps newcontext) exception 0)
                     (values))

                ;; round in the new context
                (set! ans ((ref ans '_fix) newcontext))

                ;; raise Inexact, and if necessary, Underflow
                ((cx-error newcontext) Inexact)
                (if (bool (pylist-ref (cx-flags newcontext) Subnormal))
                    ((cx-error newcontext) Underflow))

                ;; propagate signals to the original context; _fix could
                ;; have raised any of Overflow, Underflow, Subnormal,
                ;; Inexact, Rounded, Clamped.  Overflow needs the correct
                ;; arguments.  Note that the order of the exceptions is
                ;; important here.
                (if (bool (pylist-ref (cx-flags newcontext) Overflow))
                    ((cx-error newcontext)