calculator-test1.scm

(define (i/% x y)
  (let ((q (/ x y)) (r (% x y))) (if (< r 0) (list (-- q) (+ r y)) (list q r))))

(define (map2 f l1 l2)
  (build-list (length l1) (lambda (i) (f (list-ref l1 i) (list-ref l2 i)))))

(define (lop op xs ys)
  (foldr (lambda (x ds) (append (i/% (+ x (car ds)) 10) (cdr ds)))
         '(0) (map2 op xs ys)))

(define-struct num (sign i f))
(define max-ndigits 8)

(define (get-padding xs n) (build-list (max 0 (- n (length xs))) (lambda (_) 0)))
(define (trim xs n) (take (append xs (get-padding xs n)) n))
(define (align x y)
  (let* ((ix (num-i x)) (iy (num-i y)) (li (max (length ix) (length iy)))
         (ix (append (get-padding ix li) ix)) (iy (append (get-padding iy li) iy)))
    (values li (trim (append ix (num-f x)) max-ndigits)
            (trim (append iy (num-f y)) max-ndigits))))

(align (make-num " " '(1 2) '(3 4 5 6 7 8))
       (make-num " " '(9) '(3 4 5 6 7 7 8)))

(define (drop0s xs) (if (and (cons? xs) (= (car xs) 0)) (drop0s (cdr xs)) xs))
(define (rdrop0s xs) (reverse (drop0s (reverse xs))))

(define (add x y)
  (if (string=? (num-sign x) (num-sign y))
      (let*-values (((li xs ys) (align x y)) ((zs) (lop + xs ys))
                    ((zs li)
                     (if (= (car zs) 0) (values (cdr zs) li) (values zs (++ li)))))
        (make-num (num-sign x) (take zs li)
                  (rdrop0s (drop (trim zs max-ndigits) (min li max-ndigits)))))
      (sub x (make-num (num-sign x) (num-i y) (num-f y)))))

(define rate-common (make-num " " '(2 7 6) '(4 8 7 5)))
(define rate-leap   (make-num " " '(8 8) '(7 5 5)))
"276.4875 + 88.755"
(add rate-common rate-leap)
(define today (make-num " " '(2 0 1 9) '(1 1 0 8)))
(define thelastday (make-num " " '(9 9 9 9 9) '(9 9 9)))
"2019.1108 + 99999.999"
(add today thelastday)
(define today (make-num " " '(2 0 1 9 1 1 0) '(8)))
(define thelastday (make-num " " '(9 9 9 9 9 9 9 9) '()))
"2019110.8 + 99999999"
(add today thelastday)

(define (l<? xs ys)
  (and (cons? xs)
       (or (< (car xs) (car ys))
           (and (= (car xs) (car ys)) (l<? (cdr xs) (cdr ys))))))

(define (neg sign) (if (string=? sign " ") "-" " "))

(define (sub x y)
  (if (string=? (num-sign x) (num-sign y))
      (let*-values (((li xs ys) (align x y))
                    ((sign zs) (if (l<? xs ys)
                                   (values (neg (num-sign x)) (cdr (lop - ys xs)))
                                   (values      (num-sign x)  (cdr (lop - xs ys)))))
                    ((i) (drop0s (take zs li))))
        (make-num sign (if (null? i) '(0) i) (rdrop0s (drop zs li))))
      (add x (make-num (num-sign x) (num-i y) (num-f y)))))

"1 - 0.2857142"
(sub (make-num " " '(1) '()) (make-num " " '(0) '(2 8 5 7 1 4 2)))
"12.345678 - 9.3456778"
(sub (make-num " " '(1 2) '(3 4 5 6 7 8)) (make-num " " '(9) '(3 4 5 6 7 7 8)))