;;;;

;;Issues
;;

(module seq-utils

(;export
  merge merge!
  sort sort! sorted?
  histogram
  unfold-alist)

(import scheme
  (chicken base)
  (chicken type)
  (only (srfi 1) list-copy)
  (prefix (chicken sort) chicken:)
  (prefix sequences seq:))

;;;

(include "seq-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))

(: histogram (seq #!optional binary-predicate --> histogram-list))
(: unfold-alist (seq procedure * #!optional binary-predicate --> alist))

;;

(define *empty-list* (list))

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

(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?)
  (define (*seq->list x) (if (list? x) (list-copy x) (seq:coerce *empty-list* x)))
  (seq:coerce seq (chicken:sort! (*seq->list seq) less?)) )

;;

(define (histogram seq #!optional (eqal? equal=?))
  (unfold-alist seq (lambda (_ occurs) (add1 occurs)) 0 eqal?) )

(define (unfold-alist seq next seed #!optional (eqal? equal=?))
  (define (kons bins value)
    (let ((cur (alist-ref value bins eqal? seed)))
      (alist-update! value (next value cur) bins eqal?)) )
  (seq:foldl kons '() seq) )

) ;module seq-utils