#lang scheme

(require (prefix-in general: "general.ss"))
(require "engine-interface.ss")

(define nbase 10000) ; ...wut? <.<
(define numeric-negative #x4000)

(define (bytes-split-into-integers size bytes)
  (let loop ([bytes bytes] [result null])
    (if (<= (bytes-length bytes) size) (map general:decode-integer 
                                            (reverse 
                                             (if (= 0 (bytes-length bytes))
                                                 result
                                                 (cons bytes result))))
        (loop (subbytes bytes size) (cons (subbytes bytes 0 size) result)))))

(define (decode-numeric bytes)
  (let-values 
      ([(digits n-digits weight sign scale) (general:bytes-extract-header '(2 2 2 2) bytes)])
    (let ([number
           (let gather ([digits (bytes-split-into-integers 2 digits)] [result 0])
             (if (null? digits) result
                 (gather (cdr digits) (+ (car digits) (* result nbase)))))])
      (/ (if (= sign numeric-negative) (* -1 number) number) (expt nbase (- n-digits weight 1))))))

(define (logn n i) (/ (log i) (log n)))

(define (number-weight n)
  ; how many digits left of the radix...
  ; yay for logs
  (if (= n 0) 0 (inexact->exact (floor (logn nbase (abs n))))))

(define (number-scale n [n-digits #f])
  ; just figure out a reasonable amount of digits to use... we can multiply by nbase as much as we like!
  ((λ (i)   
     (if n-digits (/ i (expt nbase (- (n-digits i) n-digits)))
         i))
   (cond
     [(integer? n) n]
     [(rational? n) (inexact->exact (floor (* n (expt nbase (+ 1 (number-weight (denominator n)))))))]
     [(real? n) (inexact->exact (floor (* n (expt nbase 10))))]
     [else (error (format "What is ~s?~n" n))])))
  
; 100002000030000 -> 3 digits in base 10000
; 100000000000000 -> 1 digit in base 10000
; 1 digit (100) in base 10000 with weight 3 -> 100000000000000
; 1 digit (100) in base 10000 with weight 1 -> 1000000
; 1 digit (100) in base 10000 with weight 0 -> 100
(define (collapse-count number)
  (if (= number 0) (values 0 #"")
      (local
        [(define (collate n [n-digits 0] [result #""])
           (if (<= n 0) (values n-digits result)
               (call-with-values
                (λ () (quotient/remainder n nbase))
                (λ (quotient remainder)
                  (collate 
                   quotient (+ n-digits 1) 
                   (bytes-append 
                    (integer->integer-bytes (inexact->exact remainder) 2 #f #t)
                    result))))))
         (define (absorb n)
           (let ([r (remainder n nbase)])
             (if (= r 0)
                 (absorb (quotient n nbase))
                 (collate n))))]
        (absorb number))))


; if NaN, sign is NAN,INF,etc and digits is special case. see include/utils/numeric.h
; scheme only has floating point (inexact) NaNs and INFs though.

(define (encode-numeric number)
  (let* ([weight (number-weight number)]
         [sign (if (< number 0) numeric-negative 0)])
    ; we need calculated scale here, to figure where to round off the number!
    (let ([number (number-scale (abs number))])
      (let*-values ([(n-digits digits) (collapse-count number)]
                   [(scale) 
                    (inexact->exact (floor (/ (* (log 10) (max (- n-digits weight) 0)) (log nbase))))])
        (apply 
         bytes-append 
         (flatten
          (list
            (map (λ (n) (when (< n 0) (error (format "Beep ~s ~s ~s ~s ~s" n n-digits weight sign scale))) (integer->integer-bytes n 2 #f #t)) (list n-digits weight sign scale))
            digits)))))))

; could refuse inexact here, but we know they're handled by defaults
; plus they work fine.
(define (divine value)
  (if (number? value) 1700 #f))

(define (set-info! engine)
  (send engine set-codec! 1700 encode-numeric decode-numeric)
  (send engine add-diviner! divine))

(provide/contract
 [set-info! (engine? . -> . void?)])