;; defs below are defined in both the normal and the transformer environments

;; http://en.wikipedia.org/wiki/Fold_%28higher-order_function%29
;; fold is the basic recursive/accumulative list processor pattern.
;; cons -> fn
;; '()  -> init

;; apparently, in SRFI-1, the name 'fold' is used for the iterative
;; version, and 'fold-right' is used for the recursive one.
;; http://srfi.schemers.org/srfi-1/srfi-1.html

;; right fold is recursive
;; (fold cons '() '(1 2 3 4))
(define (fold-right fn init lst)
  (let next ((l lst))
    (if (null? l)
        init
        (fn (car l)
            (next (cdr l))))))




;; left fold is tail recursive, so iterative. according to the
;; wikipedia page above it is actually a flipped left fold such that:
;; (define (_reverse lst) (fold cons '() lst))
;; (_reverse '(1 2 3 4))

(define (fold fn init lst)
  (if (null? lst)
      init
      (fold fn
            (fn (car lst) init)
            (cdr lst))))

;; (fold-right + 0 '(1 2 3))
;; (fold + 0 '(1 2 3))

(define (_filter keep? lst _fold)
  (_fold
   (lambda (head rest)
     (if (keep? head)
         (cons head rest) rest))
   '() lst))

;; first one will preserve the order, second is iterative.
(define (filter     keep? lst) (_filter keep? lst fold-right))
(define (filter-set keep? lst) (_filter keep? lst fold))

; (filter     number? '(1 2 a b 3))
; (filter-set number? '(1 2 a b 3))


; (unfold zero? (lambda (x) (+ 100 x)) (lambda (x) (- x 1)) 10)
(define (unfold . args)
  (match args
         
         ((p f g seed tail-gen)
          (display seed) (newline)
          
          (if (p seed)
              (tail-gen seed)
              (cons (f seed)
                    (unfold p f g (g seed) tail-gen))))

         ((p f g seed)
          (unfold p f g seed (lambda (x) '())))))


;; muting operations (used for backtracking)

(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)))))

(define-syntax swap!
  (syntax-rules ()
    ((_ left right)
     (let ((l left)
           (r right))
       (set! left  r)
       (set! right l)))))