(defpackage :fwoar.recursion-schemes
   (:use :cl)
   (:export ))
 (in-package :fwoar.recursion-schemes)
 
 (defun cdr* (cons)
   (funcall (cdr cons)))
 
 ;; cata :: (a -> b -> b) -> b -> [a] -> b
 (defun cata (fun init as)
   (if (null as)
       init
       (funcall fun
                (car as)
                (cata fun init
                      (cdr as)))))
 
 ;; para :: (a -> [a] -> b -> b) -> b -> [a] -> b
 (defun para (fun init as)
   (if (null as)
       init
       (funcall fun (car as) (cdr as)
                (para fun init (cdr as)))))
 
 ;; ana :: (v -> (a, () -> b)) -> b -> [a]
 (defun ana (fun init)
   (destructuring-bind (a init*)
       (funcall fun init)
     (cons a (lambda () (ana fun init*)))))
 
 ;; ana :: (v -> Maybe (a, b)) -> b -> [a]
 (defun ana* (fun init)
   (let ((v (funcall fun init)))
     (when v
       (cons (car v)
             (ana* fun (cadr v))))))
 
 ;; hylo  :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
 (defun hylo (reducer reducer-init generator generator-seed)
   (flet ((partial-ana (init)
            (ana* generator init)))
     (cata reducer reducer-init
           (partial-ana generator-seed))))
 
 ;; zygo (a -> b -> b) -> (a -> b -> c -> c) -> b -> c -> [a] -> c
 (defun zygo (fold-1 fold-2 fold-1-init fold-2-init as)
   (second
    (cata (fw.lu:destructuring-lambda (x (p q))
            (list (funcall fold-1 x p)
                  (funcall fold-2 x p q)))
          (list fold-1-init fold-2-init)
          as)))