#lang scheme/base

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

(provide Array-struct)

(define-package Array-struct (maxLen array fromList tabulate length sub update 
                                     vector copy copyVec appi app 
                                     foldli foldri foldl foldr 
                                     modifyi modify findi find
                                     exists all collate)
  
  (define maxLen +inf.0)
  
  (define array
    (match-lambda
      ((vector n i)
       (call-with-exception-handler
        (lambda (e)
          (if (exn:break? e)
              e
              (Size (current-continuation-marks))))
        (lambda () (make-vector n i))))))
  
  (define fromList list->vector)
  
  (define tabulate
    (match-lambda
      ((vector n f)
       (call-with-exception-handler
        (lambda (e)
          (if (exn:break? e)
              e
              (Size (current-continuation-marks))))
        (lambda () (build-vector n f))))))
  
  (define sub
    (match-lambda
      ((vector v i)
       (call-with-exception-handler
        (lambda (e)
          (if (exn:break? e)
              e
              (Subscript (current-continuation-marks))))
        (lambda ()
          (vector-ref v i))))))
  
  (define update
    (match-lambda
      ((vector arr i x)
       (call-with-exception-handler
        (lambda (e)
          (if (exn:break? e)
              e
              (Subscript (current-continuation-marks))))
        (lambda ()
          (vector-set! arr i x))))))
  
  (define copy
    (match-lambda
      ((list-no-order (list 'src src)
                      (list 'dst dst)
                      (list 'di di))
       (call-with-exception-handler
        (lambda (e)
          (if (exn:break? e)
              e
              (Subscript (current-continuation-marks))))
        (lambda ()
          (vector-copy! dst di src))))))
  
  (define copyVec copy)
  
  (define ((appi f) s)
    (let ((stop (vector-length s)))
      (let lp ((i 0))
        (when (< i stop)
          (f (vector i (vector-ref s i)))
          (lp (add1 i))))))
  
  (define ((app f) v)
    (for-each f (vector->list v)))
  
  (define (((foldli f) init) s)
    (let ((stop (vector-length s)))
      (let lp ((i 0)
               (acc init))
        (if (< i stop)
            (lp (add1 i)
                (f (vector i (vector-ref s i) acc)))
            acc))))
  
  (define (((foldri f) init) s)
    (let lp ((j (sub1 (vector-length s)))
             (acc init))
      (if (<= 0 j)
          (lp (sub1 j)
              (f (vector j (vector-ref s j) acc)))
          acc)))
  
  (define (((foldl f) init) v)
    (let ((end (vector-length v)))
      (let lp ((i 0)
               (acc init))
        (if (< i end)
            (lp (add1 i)
                (f (vector (vector-ref v i) acc)))
            acc))))
  
  (define (((foldr f) init) v)
    (let lp ((i (sub1 (vector-length v)))
             (acc init))
      (if (negative? i)
          acc
          (lp (sub1 i)
              (f (vector (vector-ref v i) acc))))))
  
  (define ((modifyi f) s)
    (let ((stop (vector-length s)))
      (let lp ((j 0))
        (when (< j stop)
          (vector-set! s j (f (vector j (vector-ref s j))))
          (lp (add1 j))))))
  
  (define ((modify f) vec)
    (let ((len (vector-length vec)))
      (do ((i 0 (add1 i)))
        ((= i len))
        (vector-set! vec i
                     (f (vector-ref vec i))))))
  
  (define ((findi f) arr)
    (let ((len (vector-length arr)))
      (let lp ((i 0))
        (cond ((= len i)
               NONE)
              ((f (vector i (vector-ref arr i)))
               (SOME (vector i (vector-ref arr i))))
              (else
               (lp (add1 i)))))))
  (define ((find f) arr)
    (let ((len (vector-length arr)))
      (let lp ((i 0))
        (cond ((= len i)
               NONE)
              ((f (vector-ref arr i))
               (SOME (vector-ref arr i)))
              (else
               (lp (add1 i)))))))
  
  (define ((exists f) arr)
    (s:vector-any f arr))
  
  (define ((all f) arr)
    (s:vector-every f arr))
  
  (define (collate f)
    (match-lambda
      ((vector a1 a2)
       (let* ((l1 (vector-length a1))
              (l2 (vector-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 (vector-ref a1 i)
                                             (vector-ref a2 i)))))
                 (if (EQUAL? c)
                     (lp (add1 i))
                     c))))))))
  
  (define* length vector-length)
  (define* vector s:vector-copy)
  (define* concat s:vector-concatenate))