;; list processing module based on SRFI1

(module list mzscheme

  ;; (require (lib "1.ss" "srfi")) there are some name clashes between
  ;; mzscheme and the SRFI1 lib. i got the line below from plt/collects/srfi/1.ss

  (require (lib "list.ss" "srfi" "1")
           (lib "match.ss"))

  (provide (all-defined)
           (all-from (lib "list.ss" "srfi" "1"))) ;; FIXME: necessary?

  ;; not using 'member' but following the lset api with plugin comparison
  (define (contains same? el lst)
    (any (lambda (e) (same? el e)) lst))
  
  ;; (list->lset = '(3 1 1 2 2 2 3 3 2))
  (define (list->lset same? lst)
    (fold-right
     (lambda (head rest)
       (if (contains same? head rest)
           rest
           (cons head rest)))
     '() lst))

  ;; uses same argument order as assoc
  (define (assoc-ref lst symbol)
    (let ((ref (assoc lst symbol)))
      (and ref (cdr ref))))


  ;; FIXME: what's the standard name for this? it's like fold combined
  ;; with unfold.

  ;; propagate output feedback function over list (IIR filter)
  ;; perform (x y ...) -> (x (fn z y) ...)
  ;; then do the same for the cdr.

  (define (propagate fn lst)
    (reverse! ;; linear
     (fold
      (lambda (in acc)
        (cons (fn (car acc) in) acc))
      (list (car lst))
      (cdr lst))))
       

  (define (id x) x)
  (define (dip fn)
    (lambda (lst)
      (cons (car lst)
            (fn (cdr lst)))))
  (define (splash fn)
    (lambda (args)
      (apply fn args)))


  ;; convert a list into a list of list of lists, with a specified
  ;; maximal with.
  ;; (list->table '(1 2 3 4 5) 2)

  (define (list->table lst size)
    (let next ((in  lst)
               (out '())
               (current '(0)))
      (match (cons in current)
             ((() 0)  (reverse out)) ;; done
             ((_  n . l)
              (if (or (null? in)
                      (= n size))
                  ;; row finished
                  (next in
                        (cons (reverse l) out)
                        '(0))
                  ;; accumulate row
                  (next (cdr in)
                        out
                        (cons (+ 1 n)
                              (cons (car in) l))))))))


  (define-syntax pack
    (syntax-rules ()
      ((_ args ...)
       (apply list args ...))))



  
  ;; MUTATION

  ;; stacks
  (define-syntax push!
  (syntax-rules ()
    ((_ stack value)
     (let ((rest stack))
       (set! stack (cons value rest))))))

  (define-syntax pop!
    (syntax-rules ()
      ((_ stack)
       (if (null? stack)
           (raise '(stack-underflow stack))
           (let ((top (car stack)))
             (set! stack (cdr stack))
             top)))))

  ;; like push!, but add to set
  (define-syntax lset-add!
    (syntax-rules ()
      ((_ same? stack val)
       (let ((v val)) ;; eval once
         (when (null?
                (lset-intersection same?
                                   stack
                                   (list v)))
           (push! stack v))))))

  ;; call a function 'producer' with one argument, which is a function
  ;; taking a single argument, bound to a collector function (add to set)

  ;; the 2nd procedure is called with the return value and collection
  
  (define (call-with-collector producer consumer)
    (call-with-values
        (lambda  ()
          (let* ((store '())
                 (collector
                  (lambda (thing)
                    (lset-add! equal? store thing)))
                 (retval (producer collector)))
      
            (values retval store)))
      consumer))

       
               
  

  )