135 lines
4.8 KiB
EmacsLisp
135 lines
4.8 KiB
EmacsLisp
;;; multi.el --- Clojure-style multi-methods for emacs lisp -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (c) 2013 Christina Whyte <kurisu.whyte@gmail.com>
|
|
|
|
;; Version: 2.0.1
|
|
;; Package-Version: 20131013.844
|
|
;; Package-Requires: ((emacs "24"))
|
|
;; Keywords: multimethod generic predicate dispatch
|
|
;; Author: Christina Whyte <kurisu.whyte@gmail.com>
|
|
;; URL: http://github.com/kurisuwhyte/emacs-multi
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;; Permission is hereby granted, free of charge, to any person obtaining
|
|
;; a copy of this software and associated documentation files (the
|
|
;; "Software"), to deal in the Software without restriction, including
|
|
;; without limitation the rights to use, copy, modify, merge, publish,
|
|
;; distribute, sublicense, and/or sell copies of the Software, and to
|
|
;; permit persons to whom the Software is furnished to do so, subject to
|
|
;; the following conditions:
|
|
;;
|
|
;; The above copyright notice and this permission notice shall be
|
|
;; included in all copies or substantial portions of the Software.
|
|
;;
|
|
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
|
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
|
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
|
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
|
|
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
|
|
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
|
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
;; SOFTWARE.
|
|
|
|
|
|
;;; Commentary
|
|
|
|
;; See README.md (or http://github.com/kurisuwhyte/emacs-multi#readme)
|
|
|
|
;;; Code:
|
|
|
|
;;;; State ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(defvar multi/-method-branches (make-hash-table)
|
|
"A dictionary of dictionaries of branches.
|
|
|
|
Type: { Symbol → { A → (A... → B) }}
|
|
|
|
This holds the mappings of names to a mappings of premises to lambdas,
|
|
which allows a relatively efficient dispatching O(2) when applying the
|
|
multi-method.")
|
|
|
|
|
|
(defvar multi/-method-fallbacks (make-hash-table)
|
|
"A dictionary of fallbacks for each multi-method.
|
|
|
|
Type: { Symbold → (A... → B) }
|
|
|
|
This holds mappings of names to fallback method branches, which are
|
|
invoked in case none of the premises for the defined branches match.")
|
|
|
|
|
|
;;;; API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(defmacro defmulti (name arguments &optional docstring &rest forms)
|
|
"Defines a new multi-method and a dispatch function."
|
|
(declare (doc-string 3)
|
|
(debug (&define name (&rest arg) [&optional stringp] def-body))
|
|
(indent defun))
|
|
`(progn
|
|
(defun ,name (&rest args)
|
|
,(if (stringp docstring) docstring (prog1 nil (push docstring forms)))
|
|
(apply (multi/-dispatch-with ',name (lambda ,arguments ,@forms))
|
|
args))
|
|
(multi/-make-multi-method ',name)))
|
|
|
|
|
|
(defmacro defmulti-method (name premise arguments &rest forms)
|
|
"Adds a branch to a previously-defined multi-method."
|
|
(declare (debug (&define name sexp (&rest arg) def-body))
|
|
(indent defun))
|
|
`(multi/-make-multi-method-branch ',name ,premise
|
|
(lambda ,arguments ,@forms)))
|
|
|
|
|
|
(defmacro defmulti-method-fallback (name arguments &rest forms)
|
|
"Adds a fallback branch to a previously-defined multi-method.
|
|
|
|
The fallback branch will be applied if none of the premises defined
|
|
for the branches in a multi-method match the dispatch value."
|
|
`(multi/-make-multi-method-fallback ',name (lambda ,arguments ,@forms)))
|
|
|
|
|
|
(defun multi-remove-method (name premise)
|
|
"Removes the branch with the given premise from the multi-method."
|
|
(remhash premise (gethash name multi/-method-branches)))
|
|
|
|
|
|
(defun multi-remove-method-fallback (name)
|
|
"Removes the defined fallback branch for the multi-method."
|
|
(remhash name multi/-method-fallbacks))
|
|
|
|
|
|
;;;; Helper functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(defun multi/-make-multi-method (name)
|
|
(puthash name (make-hash-table :test 'equal)
|
|
multi/-method-branches))
|
|
|
|
|
|
(defun multi/-make-multi-method-branch (name premise lambda)
|
|
(puthash premise lambda
|
|
(gethash name multi/-method-branches)))
|
|
|
|
|
|
(defun multi/-make-multi-method-fallback (name lambda)
|
|
(puthash name lambda multi/-method-fallbacks))
|
|
|
|
|
|
(defun multi/-dispatch-with (name f)
|
|
(lambda (&rest args)
|
|
(let* ((premise (apply f args))
|
|
(method (gethash premise (gethash name multi/-method-branches))))
|
|
(if method (apply method args)
|
|
(apply (gethash name multi/-method-fallbacks) args)))))
|
|
|
|
|
|
;;;; Emacs stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(eval-after-load "lisp-mode"
|
|
'(progn
|
|
(font-lock-add-keywords 'emacs-lisp-mode
|
|
'(("(\\(defmulti\\|defmulti-method\\|defmulti-method-fallback\\)\\(?:\\s-\\)+\\(\\_<.*?\\_>\\)"
|
|
(1 font-lock-keyword-face)
|
|
(2 font-lock-function-name-face))))))
|
|
|
|
|
|
(provide 'multi)
|
|
;;; multi.el ends here
|