tk's bits

Adding the %digit0 procedure completes the separation of the digit format from the number’s “public” data structure. I chose the decimal digit for convenience. An emphasis on efficiency would choose another “digit” format. The following code doesn’t even know what the digit format is. It simply passes the digit onward, leaving %digit-sum and %digit-complement with the task of dealing with the actual digit format.

One major constraint in the following code is that equivalent digits must be equal in the eq? sense.

(letrec
    ((digit0 (%digit0))
    (digit1 (car(cdr (%digit-sum
                       (%digit-complement (%digit0))
                       (%digit-complement (%digit0))
                       (%digit0)))))
    (max-digit (%digit-complement (%digit0)))

    (add
      (lambda (x y)
        (cond
          ((number? x)
            (cond
              ((number? y) (add-num x y))
              ( #t '***undefined***)))
          (#t '***undefined***))))

    (subtract
      (lambda (x y)
        (cond
          ((number? x)
            (cond
              ((number? y) (sub-num x y))
              (#t '***undefined***)))
          (#t '***undefined***))))

    (negate
      (lambda (x)
        (cond
           ((number? x)
             (%list->number (negate-list (%number->list x))))
           (#t '***undefined***))))

    (add-num
      (lambda (x y)
        (%list->number (add-num1 (%number->list x) (%number->list y)))))

    (sub-num
      (lambda (x y)
        (%list->number (add-num1 (%number->list x) (negate-list (%number->list y))))))

    (negate-list
      (lambda (x)
        (cond
          ((eq? (car x) #\0) x)
          ((eq? (car x) #\+) (cons #\- (cdr x)))
          ((eq? (car x) #\-) (cons #\+ (cdr x)))
          (#t '***undefined***))))

    (add-num1
      (lambda (x y)
        (cond
          ((eq? (car x) #\0) y)
          ((eq? (car y) #\0) x)
          ((eq? (car x) (car y)) (cons (car x) (add-magnitude (cdr x) (cdr y))))
          ((eq? (car x) #\+) (adjust-mag1 (sub-magnitude (cdr x) (cdr y))))
          ((eq? (car x) #\-) (adjust-mag1 (sub-magnitude (cdr y) (cdr x))))
          (#t '***undefined***))))

    (add-magnitude
      (lambda (x y)
        (add-mag1 x y)))

    (sub-magnitude
      (lambda (x y)
        (sub-mag1 x y)))

    (add-mag1
      (lambda (x y)
        (cond
          ((null? x)
            (cond
              ((null? y) '())
              (#t (add-mag2 (%digit-sum digit0 (car y)  digit0) (cdr x) (cdr y)))))
          ((null? y) (add-mag2 (%digit-sum (car x) digit0  digit0) (cdr x) (cdr y)))
          (#t (add-mag2 (%digit-sum (car x) (car y) digit0) (cdr x) (cdr y))))))

    (add-mag2
      (lambda (d-sum x y)
        (cond
          ((null? x)
            (cond
              ((null? y)
                (cond
                  ((eq? (car(cdr d-sum)) digit0) (list (car d-sum)))
                  (#t d-sum)))
              (#t (add-next d-sum (list digit0) y))))
          ((null? y) (add-next d-sum x (list digit0)))
          (#t (add-next d-sum x y)))))

    (add-next
      (lambda (d-sum x y)
        (cons
          (car d-sum)
          (add-mag2
            (%digit-sum (car x) (car y) (car(cdr d-sum)))
            (cdr x)
            (cdr y)))))

    (adjust-mag1
      (lambda (x)
        (cond
          ((neg-mag? x) (cons #\- (trim-mag1 (recomplement x))))
          (#t (check-zero (cons #\+ (trim-mag1 x)))))))

    (check-zero
      (lambda (x)
        (cond
          ((null? (cdr x)) '(#\0))
          (#t x))))

    (trim-mag1
      (lambda (x)
        (reverse (behead-zero (cdr (reverse x))))))

    (behead-zero
      (lambda (x)
        (cond
          ((eq? (car x) digit0) (behead-zero (cdr x)))
          (#t x))))

    (neg-mag?
      (lambda (x)
        (cond
          ((null? (cdr x)) (eq? (car x) max-digit))
          (#t (neg-mag? (cdr x))))))

    (recomplement
      (lambda (x)
        (sub-mag1 '() x)))

    (sub-mag1
      (lambda (x y)
        (cond
          ((null? x)
            (cond
              ((null? y) (list digit0))
              (#t (sub-mag2
                    (%digit-sum digit0  (%digit-complement (car y)) digit1)
                    (list digit0)
                    (cdr y)))))
          ((null? y) (sub-mag2
                       (%digit-sum (car x) (%digit-complement digit0) digit1)
                       (cdr x)
                       (list digit0)))
          (#t (sub-mag2
                (%digit-sum (car x) (%digit-complement (car y)) digit1)
                (cdr x)
                (cdr y))))))

    (sub-mag2
      (lambda (d-sum x y)
        (cond
          ((null? x)
            (cond
              ((null? y) (list
                           (car d-sum)
                           (car (%digit-sum digit0 max-digit (car(cdr d-sum))))))
              (#t (sub-next d-sum (list digit0) y))))
          ((null? y) (sub-next d-sum x (list digit0)))
          (#t (sub-next d-sum x y)))))

    (sub-next
      (lambda (d-sum x y)
        (cons
          (car d-sum)
          (sub-mag2
            (%digit-sum (car x) (%digit-complement (car y)) (car(cdr d-sum)))
            (cdr x)
            (cdr y))))))
  ; ...
)

As a further step in separating storage details from algorithms, I’ve created two procedures, %number->list and %list->number, to convert between the actual “hard” format, and a “soft” format we can use for experimenting.

The “soft” format is a list. The first item is the sign in character form, and the rest of the list are the digits in little-endian order.

With the new procedures, I revisited the add and subtract code, and altered it to put conversion to and from the internal format at the same application (i.e., call or invoke) level.

I also added two procedures, %digit-sum and %digit-complement, to highlight the fact that the radix used for “hard” encoding does not affect the general algorithm at all. Although I am using decimal now, the radix could be (decimal) 4 294 967 296, which is what would be expected from a 32-bit implementation.

The add-digit procedure %digit-sum began as a two argument function. With digits as operands and a list as output, adding three numbers (to include the carry) was a bit ugly. The solution was to redefine %digit-sum as a three argument function.

The %digit-sum procedure replaces a Scheme conditional tree. The internal routine eliminates a lot of argument list cons-ing. The only cons-ing needed is for producing the return value. Arithmetic is used to create the sum, speeding it up even more. As a result, I am expecting the new arithmetic to be competitive with the floating-point arithmetic of some old versions of Basic running on their original (slow) microprocessors. The up side: big-num capability. The down-side: fractions are not yet implemented.

The %digit-complement is the (radix – 1) complement. In my decimal radix system, that would be the nine’s complement. If I had used a binary radix, it would have been the one’s complement.

That leaves three items that were not implemented in assembly language: digit0, digit1, and max-digit (replacement for digit9). The updated algorithm is derived from using digit0 and digit1 as the carry digits, and digit0 and max-digit as the “sign extension” digits. Only digit0 needs to be implemented, with the others derived from digit0.