#lang scheme/base

(require (planet chongkai/sml/ml-package)
         scheme/match
         (only-in (planet chongkai/sml/ml-primitives)
                  SOME? SOME SOME-content
                  NONE? NONE
                  LESS LESS?
                  GREATER GREATER?
                  EQUAL EQUAL?
                  Size? Size
                  Subscript? Subscript))

(provide Word8Vector-struct)

(define-package Word8Vector-struct
  (maxLen fromList tabulate length sub update concat appi app mapi map
          foldli foldri foldl foldr findi find exists all collate)
  
  (define maxLen +inf.0)
  
  (define (fromList l)
    (bytes->immutable-bytes
     (list->bytes l)))
  
  (define tabulate
    (match-lambda
      ((vector n f)
       (call-with-exception-handler
        (lambda (e)
          (if (exn:break? e)
              e
              (Size (current-continuation-marks))))
        (lambda ()
          (let ((b (make-bytes n)))
            (let lp ((i 0))
              (when (< i n)
                (bytes-set! b i (f i))
                (lp (add1 i))))
            (bytes->immutable-bytes b)))))))
  
  (define sub
    (match-lambda
      ((vector v i)
       (call-with-exception-handler
        (lambda (e)
          (if (exn:break? e)
              e
              (Subscript (current-continuation-marks))))
        (lambda () (bytes-ref v i))))))
  
  (define update
    (match-lambda
      ((vector v i e)
       (call-with-exception-handler
        (lambda (e)
          (if (exn:break? e)
              e
              (Subscript (current-continuation-marks))))
        (lambda ()
          (let ((nv (bytes-copy v)))
            (bytes-set! nv i e)
            (bytes->immutable-bytes nv)))))))
  
  (define (concat l)
    (bytes->immutable-bytes
     (apply bytes-append l)))
  
  (define ((mapi f) s)
    (let* ((len (bytes-length s))
           (new-vec (make-bytes len)))
      (do ((i 0 (add1 i)))
        ((= i len) (bytes->immutable-bytes new-vec))
        (bytes-set! new-vec i
                    (f (vector-immutable i (bytes-ref s i)))))))
  
  (define ((map f) vec)
    (let* ((len (bytes-length vec))
           (new-vec (make-bytes len)))
      (do ((i 0 (add1 i)))
        ((= i len) (bytes->immutable-bytes new-vec))
        (bytes-set! new-vec i
                    (f (bytes-ref vec i))))))
  
  (define ((appi f) s)
    (let ((stop (bytes-length s)))
      (let lp ((i 0))
        (when (< i stop)
          (f (vector-immutable i (bytes-ref s i)))
          (lp (add1 i))))))
  
  (define ((app f) v)
    (let ((stop (bytes-length v)))
      (let lp ((i 0))
        (when (< i stop)
          (f (bytes-ref v i))
          (lp (add1 i))))))
  
  (define (((foldli f) init) s)
    (let ((stop (bytes-length s)))
      (let lp ((i 0)
               (acc init))
        (if (< i stop)
            (lp (add1 i)
                (f (vector-immutable i (bytes-ref s i) acc)))
            acc))))
  
  (define (((foldri f) init) s)
    (let lp ((j (sub1 (bytes-length s)))
             (acc init))
      (if (<= 0 j)
          (lp (sub1 j)
              (f (vector-immutable j (bytes-ref s j) acc)))
          acc)))
  
  (define (((foldl f) init) v)
    (let ((end (bytes-length v)))
      (let lp ((i 0)
               (acc init))
        (if (< i end)
            (lp (add1 i)
                (f (vector-immutable (bytes-ref v i) acc)))
            acc))))
  
  (define (((foldr f) init) v)
    (let lp ((i (sub1 (bytes-length v)))
             (acc init))
      (if (negative? i)
          acc
          (lp (sub1 i)
              (f (vector (bytes-ref v i) acc))))))
  
  (define ((findi f) v)
    (let ((stop (bytes-length v)))
      (let lp ((i 0))
        (if (< i stop)
            (if (f (vector-immutable i (bytes-ref v i)))
                (SOME (vector-immutable i (bytes-ref v i)))
                (lp (add1 i)))
            NONE))))
  
  (define ((find f) v)
    (let ((stop (bytes-length v)))
      (let lp ((i 0))
        (if (< i stop)
            (if (f (bytes-ref v i))
                (SOME (bytes-ref v i))
                (lp (add1 i)))
            NONE))))
  
  (define ((exists f) v)
    (let ((stop (bytes-length v)))
      (let lp ((i 0))
        (and (< i stop)
             (or (f (bytes-ref v i))
                 (lp (add1 i)))))))
  
  (define ((all f) v)
    (let ((stop (bytes-length v)))
      (let lp ((i 0))
        (or (>= i stop)
            (and (f (bytes-ref v i))
                 (lp (add1 i)))))))
  
  (define (collate f)
    (match-lambda
      ((vector a1 a2)
       (let* ((l1 (bytes-length a1))
              (l2 (bytes-length a2))
              (stop (min l1 l2)))
         (let lp ((i 0))
           (if (= i stop)
               (cond ((< l1 l2)
                      LESS)
                     ((= l1 l2)
                      EQUAL)
                     (else
                      GREATER))
               (let ((c (f (vector-immutable (bytes-ref a1 i)
                                             (bytes-ref a2 i)))))
                 (if (EQUAL? c)
                     (lp (add1 i))
                     c))))))))
  
  (define* length bytes-length))