;; -*- Mode: Irken -*-

(include "lib/basis.scm")

(datatype big
  (:zero)
  (:pos (list int))
  (:neg (list int))
  )

;; once everything's working...
;(define big/base #x100000000)
;(define big/repr-width 8)

;; for testing, let's do hexadecimal
(define big/base #x10)
(define big/repr-width 1)

(define (digits-repr digs)
  (let loop ((digs digs) (acc '()))
    (match digs with
      () -> acc
      (hd . tl) -> (loop tl (list:cons (format (zpad big/repr-width (hex hd))) acc))
      )))

(define big-repr
  (big:zero) -> "B0"
  (big:pos digits) -> (format "B+" (join id "." (digits-repr digits)))
  (big:neg digits) -> (format "B-" (join id "." (digits-repr digits)))
  )

;; let's say we're in base 16:
;;
;;     11
;;  ...1F...
;;+ ...1F...
;;  -----
;;  ...3F...
;;
;; this is the largest possible result, which is #x1f.

(define (digits-add a b acc carry?)
  (match a b with
    () ()   -> (reverse (if carry? (list:cons 1 acc) acc))
    () digs -> (digits-add (LIST 0) digs acc carry?)
    digs () -> (digits-add (LIST 0) digs acc carry?)
    (d0 . tl0) (d1 . tl1)
    -> (let ((sum (+ d0 d1 (if carry? 1 0))))
	 (if (> sum big/base)
	     (digits-add tl0 tl1 (list:cons (- sum big/base) acc) #t)
	     (digits-add tl0 tl1 (list:cons sum acc) #f)))
    _ _ -> (error "matching is borken?")
    ))

;; this will fail if either list is non-canonical
;;  (i.e. contains zero padding).
(define (digits-<? da db)
  (let ((na (length da))
	(nb (length db)))
    (cond ((< na nb) #t) ;; aa < bbbb
	  ((> na nb) #f) ;; aaaa > bb
	  (else
	   (let loop ((da (reverse da))
		      (db (reverse db)))
	     ;; compare most-significant digit by digit...
	     (cond ((null? da) #f)
		   ((< (car da) (car db)) #t)
		   ((> (car da) (car db)) #f)
		   (else
		    (loop (cdr da) (cdr db)))))))))

;;(define (digits-sub a b acc borrow?)


(define big-<?
  (big:zero)  (big:zero)  -> #f
  (big:zero)  (big:pos _) -> #t
  (big:zero)  (big:neg _) -> #f
  (big:pos _) (big:zero)  -> #f
  (big:neg _) (big:zero)  -> #t
  (big:pos _) (big:neg _) -> #f
  (big:neg _) (big:pos _) -> #t
  (big:pos a) (big:pos b) -> (digits-<? a b)
  (big:neg a) (big:neg b) -> (digits-<? b a)
  )

;;      1F
;; a  ..201...
;; b  ..103...
;; ________
;;        

;; if da < db, then we need to borrow from the
;;   rest of a... the 'borrow' action might propagate,
;;   and it might *fail*, i.e., the number goes negative.
;;   how do we continue the computation?  Is the value in
;;   the acc useful?

;;      3333
;;     25111
;; ---------
;;       222

;; maybe it makes sense to probe the two numbers first,
;;  doing a < comparison between them is relatively cheap,
;;  and in that case we can avoid this whole mess.


(define big-add
  (big:pos da) (big:pos db) -> (big:pos (digits-add da db '() #f))
  x y -> (raise (:NotImplementedError x y)))

(define (int->big n)
  (let ((pos? (>= n 0))
	(absn (if pos? n (- 0 n))))
    (let loop ((n absn) (acc '()))
      (if (< n big/base)
	  (let ((digits (list:cons n acc)))
	    (if pos?
		(big:pos (reverse digits))
		(big:neg (reverse digits))))
	  (loop (/ n big/base) (list:cons (remainder n big/base) acc))))))

(printf (big-repr (big:zero)) "\n")
;;(printf (big-repr (big:pos '(12 #x12345678))) "\n")
(printf (big-repr (int->big #x314159)) "\n")
(printf (big-repr (big-add (int->big #x314159) (int->big 1))) "\n")
(printf (big-repr (big-add (int->big #x314159) (int->big #x314159))) "\n")
(printf (bool (big-<? (int->big 0) (int->big 0))) "\n")
(printf (bool (big-<? (int->big 0) (int->big 1))) "\n")
(printf (bool (big-<? (int->big 1) (int->big 0))) "\n")
(printf (bool (big-<? (int->big 1) (int->big 1))) "\n")
(printf (bool (big-<? (int->big #x1000) (int->big #x300))) "\n")
(printf (bool (big-<? (int->big #x300) (int->big #x1000))) "\n")
;(printf (big-repr (big:pos (digits-add '(1 2) '(3 4) '() #f))))
;;(printf (big-repr (int->big #x314159) 
;;(printf (big-repr (big-add (big:zero) 1)) "\n")
;; (printf (big-repr (full 4 (big:nil))) "\n")
;; (printf (big-repr (big-add (full 4 (big:nil)) 1)) "\n")