transducers in Elisp

transducers.el

;;; stream.el --- Implementation of transducers  -*- lexical-binding: t -*-

;; Copyright (C) 2015 Nicolas Petton

;; Author: Nicolas Petton <[email protected]>
;; Keywords: transducer, sequences
;; Version: 1.0
;; Package: transducers

;; Maintainer: [email protected]

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.


;;; Commentary:

;; Usage examples:
;; (transduce-seq (compose (mapping #'1+) (mapping #'1+)) [1 2 3 4 5])
;; (transduce-seq (filtering #'oddp) (stream-range 0 1000))
;;
;; (transduce (filtering #'oddp) #'reversed-cons '(1 2 3 4 5 6) nil)
;; (transduce (compose (filtering #'oddp) (mapping #'1+)) #'reversed-cons '(1 2 3) '(10 9 8))

;;; Code:

(require 'seq)

;;; Helpers
;;
;; Usage example:
;;
;; (compose (filtering #'oddp)
;;          (mapping #'1+))

(defun compose (&rest functions)
  "Return a function that applies FUNCTIONS in reversed order.
FUNCTIONS must be a list of functions."
  (setq functions (nreverse functions))
  (lambda (&rest args)
    (if (cdr functions)
        (funcall (car functions)
                 (apply (apply #'compose (cdr functions)) args))
      (apply (car functions) args))))

;; Helper for transducing lists
;; TODO: use a right-reduce instead of a left-reduce to make this simpler
(defun reversed-cons (cdr car)
  "Return a cons cell.
CDR is the cdr and CAR is the car of the cell."
  (cons car cdr))

;;; Transducers take a reducing function and return another one

(defun transduce (transducer fn seq init)
  (let ((reducer (funcall transducer fn)))
    (seq-reduce reducer seq init)))

(defun transduce-seq (transducer seq)
  (nreverse (transduce transducer #'reversed-cons seq nil)))

(defun mapping (fn)
  (lambda (reducer)
    (lambda (acc elt)
      (funcall reducer acc (funcall fn elt)))))

(defun filtering (pred)
  (lambda (reducer)
    (lambda (acc elt)
      (if (funcall pred elt)
          (funcall reducer acc elt)
        acc))))

(provide 'transducers)
;;; transducers.el ends here