;;;; sequences-utils.sort.scm  -*- Scheme -*-
;;;; Kon Lovett, Oct '22

;;Issues
;;

(module (sequences utils sort)

(;export
  merge merge!
  sorted?
  sort sort!
  unique unique/unsorted)

(import scheme
  (chicken base)
  (chicken type)
  (chicken fixnum)
  (chicken random)
  (only (srfi 1) list-copy reverse! append! take!)
  (prefix (chicken sort) chicken:)
  (prefix sequences seq:)
  (prefix (sequences utils misc) seq:)
  (srfi 69))

;;;

(include-relative "sequences-utils-types")

(: merge! (seq seq binary-predicate -> seq))
(: merge (seq seq binary-predicate -> seq))

(: sorted? (seq binary-predicate -> boolean))

(: sort! (seq binary-predicate -> seq))
(: sort (seq binary-predicate -> seq))

(: unique (seq #!optional binary-equality -> seq))
(: unique/unsorted (seq -> seq))

;;

(define (*->list x) (if (list? x) (list-copy x) (seq:->list x)))

;expose (chicken sort)

(define (merge! a b less?)
  (let ((rs (chicken:merge! (seq:->list a) (seq:->list b) less?)))
    (if (list? a) rs (seq:coerce a rs)) ) )

(define (merge a b less?)
  (let ((rs (chicken:merge (seq:->list a) (seq:->list b) less?)))
    (if (list? a) rs (seq:coerce a rs)) ) )

(define (sorted? seq less?)
  (let ((ss (if (vector? seq) seq (seq:->list seq))))
    (chicken:sorted? ss less?) ) )

(define (sort! seq less?)
  ;FIXME fill-in original from sorted-list
  (let* ((ss (if (vector? seq) seq (seq:->list seq)))
         (rs (chicken:sort! ss less?)) )
    (if (or (list? seq) (vector? seq)) rs (seq:coerce seq rs)) ) )

(define (sort seq less?)
  (seq:coerce seq (chicken:sort! (*->list seq) less?)) )

(define (unique seq #!optional (eqal? equal?))
  (define (ordered-unique)
    (let loop ((iter (seq:iterator seq)) (os '()) (prv unique))
      (if (seq:at-end? iter)
          ;then finished, anything done?
          (if (eq? unique prv) seq os)
          ;else try current
          (let ((cur (seq:elt seq (seq:index iter))))
            (if (and (not (eq? unique prv)) (eqal? prv cur))
                (loop (seq:advance! iter) os cur)
                (loop (seq:advance! iter) (cons cur os) cur)) ) ) ) )
  (assert (seq:sequence? seq))
  #; ;assumed, cannot enforce
  (assert (sorted? seq lessp))
  (assert (procedure? eqal?))
  (let ((os (ordered-unique)))
    (if (eq? os seq) seq
        (seq:coerce seq (reverse! os)) ) ) )

(define (unique/unsorted seq)
  (assert (seq:sequence? seq))
  (let-values (((eqal? hsh) (if (string? seq) (values char=? eqv?-hash)
                                (values equal? hash))))
    (let ((ht (make-hash-table eqal? hsh)))
      (define (sequential-unique)
        (let loop ((iter (seq:iterator seq)) (idx 0))
          (if (seq:at-end? iter)
              ;then finished, anything done?
              (if (= idx (hash-table-size ht)) seq
                  (hash-table-keys ht))
              ;else try current
              (let ((cur (seq:elt seq (seq:index iter))))
                (hash-table-update! ht cur (lambda (v) (add1 v)) (lambda () 0))
                (loop (seq:advance! iter) (add1 idx)) ) ) ) )
      (seq:coerce seq (reverse! (sequential-unique))) ) ) )

) ;module (sequences utils sort)