#lang scheme/base

(require (planet chongkai/sml/ml-package)
         (for-syntax scheme/base)
         scheme/match
         (rename-in (only-in (planet chongkai/sml/ml-primitives)
                             chr ord
                             SOME? SOME SOME-content
                             NONE? NONE
                             LESS? LESS
                             Div? Div
                             Overflow? Overflow
                             EQUAL? EQUAL
                             GREATER? GREATER
                             > < >= <=)
                    (> ml->)
                    (< ml-<)
                    (>= ml->=)
                    (<= ml-<=))
         (planet chongkai/sml/lib/StringCvt-struct))

;word8 is integer between 0 and 255

(provide Word8help-struct)

(define-package Word8help-struct (wordSize toLargeWord toLargeWordX fromLargeWord toLargeInt toLargeIntX fromLargeInt
                                           toInt toIntX fromInt orb xorb andb notb << >> ~>> + - * div mod compare
                                           > < >= <= min max fmt toString)
  
  (define wordSize 8)
  
  (define (toLargeWord w)
    w)
  (define toLargeWordX toLargeWord)
  
  (define (fromLargeWord w)
    (modulo w 256))
  
  (define (toLargeInt w)
    w)
  (define (toLargeIntX w)
    (if (>= w 128)
        (- w 256)
        w))
  
  (define (fromLargeInt i)
    (modulo i 256))
  
  (define toInt toLargeInt)
  (define toIntX toLargeIntX)
  (define fromInt fromLargeInt)
  
  (define orb
    (match-lambda
      ((vector i j)
       (bitwise-ior i j))))
  (define xorb
    (match-lambda
      ((vector i j)
       (bitwise-xor i j))))
  (define andb
    (match-lambda
      ((vector i j)
       (bitwise-and i j))))
  (define (notb i)
    (modulo (bitwise-not i) 256))
  
  (define <<
    (match-lambda
      ((vector i n)
       (modulo (arithmetic-shift i n) 256))))
  (define >>
    (match-lambda
      ((vector i n)
       (arithmetic-shift i (- n)))))
  (define ~>>
    (match-lambda
      ((vector i n)
       (if (< i 128)
           (arithmetic-shift i (- n))
           (+ 256
              (arithmetic-shift (- i 256)
                                (- n)))))))
  
  (define ml-+
    (match-lambda
      ((vector i j)
       (modulo (+ i j) 256))))
  (define ml--
    (match-lambda
      ((vector i j)
       (modulo (- i j) 256))))
  (define ml-*
    (match-lambda
      ((vector i j)
       (modulo (* i j) 256))))
  (define div
    (match-lambda
      ((vector i j)
       (if (zero? j)
           (raise (Div (current-continuation-marks)))
           (quotient i j)))))
  (define mod
    (match-lambda
      ((vector i j)
       (if (zero? j)
           (raise (Div (current-continuation-marks)))
           (remainder i j)))))
  
  (define compare
    (match-lambda
      ((vector c d)
       (cond ((< c d)
              LESS)
             ((= c d)
              EQUAL)
             (else
              GREATER)))))
  
  (define-syntax (ml-c stx)
    (syntax-case stx ()
      ((_ ml-f scheme-f?)
       #'(define ml-f
           (match-lambda
             ((vector i j)
              (scheme-f? i j)))))))
  
  (ml-c ml-min min)
  (ml-c ml-max max)
  
  (define ml-radix->scheme-radix
    (let ()
      (open-package StringCvt-struct)
      (match-lambda
        ((? BIN?) 2)
        ((? OCT?) 8)
        ((? DEC?) 10)
        ((? HEX?) 16))))
  
  (define ((fmt radix) i)
    (number->string i (ml-radix->scheme-radix radix)))
  
  (define (toString i)
    (number->string i 16))
  
  (define*-values (+ - * min max > < >= <=)
    (values ml-+ ml-- ml-* ml-min ml-max ml-> ml-< ml->= ml-<=)))