61236a4d |
;;; fwoar-functional-utils.el --- more functional utilities for emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Edward Langley
;; Author: Edward Langley <fwoar@elangley.org>
;; Version: 0.0.1
;; Keywords: fp,combinators
;; URL: https://fwoar.co
;; 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.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Some functional programming utilities
;;; Code:
(eval-when (compile load eval)
(defvar *fwoar/namespaced-funs* ()))
(cl-defmacro fwoar/def-ns-fun (name (&rest args) &body body)
(declare (indent defun))
(let ((namespaced-sym (intern (format "fwoar/%s" name))))
`(progn
(cl-pushnew '(,name ,args ,namespaced-sym)
*fwoar/namespaced-funs*
:test 'equal)
(cl-defun ,namespaced-sym ,args
,@body))))
(fwoar/def-ns-fun just-after (pred)
(lexical-let ((state nil))
(lambda (it)
(cond
(state it)
((funcall pred it) (setf state t) nil)))))
;;;###autoload
(cl-defmacro with-unaliased (&body body)
`(flet ,(loop for (name raw-args namespaced) in *fwoar/namespaced-funs*
for rest-arg = (cl-find-if (fwoar/just-after
(lambda (it)
(member it '(&rest &body))))
raw-args)
for args = (cl-remove-if (lambda (it)
(or (eql it rest-arg)
(and (symbolp it)
(= ?&
(elt
(symbol-name it)
0)))))
raw-args)
collect `(,name ,raw-args
(,@(if rest-arg
`(apply ',namespaced)
(list namespaced))
,@(mapcar (lambda (it)
(if (listp it)
(car it)
it))
args)
,@(when rest-arg
(list rest-arg)))))
,@body))
(cl-defmacro fwoar/def-combinator (name (seq &rest args) &body body)
(declare (indent defun))
`(fwoar/def-ns-fun ,name ,args
(lambda (,seq)
,@body)))
(fwoar/def-ns-fun iota (count &optional (start 0))
(cl-loop for x from start
repeat count
collect x))
(fwoar/def-ns-fun applying (f &rest pos-args)
(lambda (list)
(apply f (append pos-args list))))
(fwoar/def-ns-fun on (fun key-fun)
(lambda (it)
(funcall fun (funcall key-fun it))))
(fwoar/def-combinator over (list f &rest args)
(mapcar (lambda (it)
(apply f it args))
list))
(fwoar/def-combinator filter (list f &rest args)
(cl-remove-if-not (lambda (it)
(apply f it args))
list))
(fwoar/def-combinator zip-with (lists f)
(apply 'cl-mapcar f lists))
(fwoar/def-ns-fun element (num)
(lambda (it)
(elt it num)))
|
1923eed3 |
(cl-defgeneric fwoar/eq (a b)
(:method (a b)
(eql a b))
(:method ((a string) (b string))
(equal a b)))
(fwoar/def-ns-fun == (v)
(lambda (it)
(fwoar/eq v it)))
(fwoar/def-ns-fun applicable-when (cond fn)
(lambda (data)
(when (funcall cond data)
(funcall fn data))))
(fwoar/def-ns-fun matches-regex (regex &optional start)
(lexical-let ((regex regex))
(lambda (data)
(if start
(string-match-p regex data start)
(string-match-p regex data)))))
(cl-defmacro fwoar/and (&rest fns)
(let ((dat (gensym "dat")))
`(lambda (,dat)
(and ,@(mapcar (lambda (fn)
`(funcall ,fn ,dat))
fns)))))
;; TODO: think about whether the plist behavior here makes sense
;; should we require plists to have symbol keys?
|