├── .github ├── dependabot.yml └── workflows │ └── ci.yaml ├── .gitignore ├── README.md ├── flake.lock ├── flake.nix ├── mmt.el └── test └── mmt-test.el /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: "github-actions" 4 | directory: "/" 5 | schedule: 6 | interval: "weekly" 7 | -------------------------------------------------------------------------------- /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | push: 4 | branches: 5 | - master 6 | pull_request: 7 | types: 8 | - opened 9 | - synchronize 10 | jobs: 11 | build: 12 | runs-on: ubuntu-latest 13 | steps: 14 | - uses: actions/checkout@v4 15 | - uses: cachix/install-nix-action@v31 16 | - run: nix build 17 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *-autoloads.el 2 | *.elc 3 | *~ 4 | .cask/ 5 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Missing macro tools for Emacs Lisp 2 | 3 | [![License GPL 3](https://img.shields.io/badge/license-GPL_3-green.svg)](http://www.gnu.org/licenses/gpl-3.0.txt) 4 | [![MELPA](https://melpa.org/packages/mmt-badge.svg)](https://melpa.org/#/mmt) 5 | [![CI](https://github.com/mrkkrp/mmt/actions/workflows/ci.yaml/badge.svg)](https://github.com/mrkkrp/mmt/actions/workflows/ci.yaml) 6 | 7 | The following functions and macros are present: 8 | 9 | * `mmt-make-gensym-list` 10 | * `mmt-with-gensyms` 11 | * `mmt-with-unique-names` 12 | * `mmt-once-only` 13 | 14 | ## Installation 15 | 16 | The package is available via MELPA, so you can just type `M-x 17 | package-install RET mmt RET`. 18 | 19 | If you would like to install the package manually, download or clone it and 20 | put on Emacs' `load-path`. Then you can require it in your init file like 21 | this: 22 | 23 | ```emacs-lisp 24 | (require 'mmt) 25 | ``` 26 | 27 | Don't forget to include it in your list of dependencies if you are writing 28 | an Emacs Lisp package: 29 | 30 | ```emacs-lisp 31 | ;; Package-Requires: ((emacs "24.5") (mmt "0.1.1")) 32 | ``` 33 | 34 | ## API 35 | 36 | `cl-gensym` is provided by `cl-lib`, which ships with Emacs. 37 | 38 | ``` 39 | mmt-make-gensym-list length &optional x 40 | ``` 41 | 42 | Return a list of `length` gensyms. 43 | 44 | Each element of the list is generated as if with a call to `mmt-gensym` 45 | using the second argument `x` (defaulting to `"G"`). 46 | 47 | ---- 48 | 49 | ``` 50 | mmt-with-gensyms names &rest body 51 | ``` 52 | 53 | Bind each variable in `names` to a unique symbol and evaluate `body`. 54 | 55 | Each element of `names` must be either a symbol, or of the form: 56 | 57 | ``` 58 | (symbol string-or-symbol) 59 | ``` 60 | 61 | Bare symbols appearing in `names` are equivalent to: 62 | 63 | ``` 64 | (symbol symbol) 65 | ``` 66 | 67 | The `string-or-symbol` is used (converted to a string if necessary) as the 68 | argument to `mmt-gensym` when constructing the unique symbol the named 69 | variable will be bound to. 70 | 71 | ---- 72 | 73 | ``` 74 | mmt-with-unique-names names &rest body 75 | ``` 76 | 77 | This is an alias for `mmt-with-gensyms`. 78 | 79 | ---- 80 | 81 | ``` 82 | mmt-once-only specs &rest body 83 | ``` 84 | 85 | Rebind symbols according to `specs` and evaluate `body`. 86 | 87 | Each element of `specs` must be either a symbol naming the variable to be 88 | rebound or of the form: 89 | 90 | ``` 91 | (symbol initform) 92 | ``` 93 | 94 | where `initform` is guaranteed to be evaluated only once. 95 | 96 | Bare symbols in `specs` are equivalent to 97 | 98 | ``` 99 | (symbol symbol) 100 | ``` 101 | 102 | Example: 103 | 104 | ```emacs-lisp 105 | (defmacro cons1 (x) 106 | (mmt-once-only (x) `(cons ,x ,x))) 107 | 108 | (let ((y 0)) 109 | (cons1 (incf y))) ;; ⇒ (1 . 1) 110 | ``` 111 | 112 | ## License 113 | 114 | Copyright © 2015–present Mark Karpov 115 | 116 | Distributed under GNU GPL, version 3. 117 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "emacs-package-flake": { 4 | "inputs": { 5 | "flake-utils": "flake-utils", 6 | "nixpkgs": "nixpkgs" 7 | }, 8 | "locked": { 9 | "lastModified": 1686064298, 10 | "narHash": "sha256-AmhZ5UPCdEyUuYCKuNuga59YDNJmyyjImYc/J5wo4vE=", 11 | "owner": "mrkkrp", 12 | "repo": "emacs-package-flake", 13 | "rev": "ffeea4f1aa7d32eb09e53772e183f73ebda72cfd", 14 | "type": "github" 15 | }, 16 | "original": { 17 | "owner": "mrkkrp", 18 | "repo": "emacs-package-flake", 19 | "type": "github" 20 | } 21 | }, 22 | "flake-utils": { 23 | "inputs": { 24 | "systems": "systems" 25 | }, 26 | "locked": { 27 | "lastModified": 1685518550, 28 | "narHash": "sha256-o2d0KcvaXzTrPRIo0kOLV0/QXHhDQ5DTi+OxcjO8xqY=", 29 | "owner": "numtide", 30 | "repo": "flake-utils", 31 | "rev": "a1720a10a6cfe8234c0e93907ffe81be440f4cef", 32 | "type": "github" 33 | }, 34 | "original": { 35 | "owner": "numtide", 36 | "repo": "flake-utils", 37 | "type": "github" 38 | } 39 | }, 40 | "nixpkgs": { 41 | "locked": { 42 | "lastModified": 1685931219, 43 | "narHash": "sha256-8EWeOZ6LKQfgAjB/USffUSELPRjw88A+xTcXnOUvO5M=", 44 | "owner": "NixOS", 45 | "repo": "nixpkgs", 46 | "rev": "7409480d5c8584a1a83c422530419efe4afb0d19", 47 | "type": "github" 48 | }, 49 | "original": { 50 | "id": "nixpkgs", 51 | "ref": "nixos-unstable", 52 | "type": "indirect" 53 | } 54 | }, 55 | "root": { 56 | "inputs": { 57 | "emacs-package-flake": "emacs-package-flake" 58 | } 59 | }, 60 | "systems": { 61 | "locked": { 62 | "lastModified": 1681028828, 63 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 64 | "owner": "nix-systems", 65 | "repo": "default", 66 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 67 | "type": "github" 68 | }, 69 | "original": { 70 | "owner": "nix-systems", 71 | "repo": "default", 72 | "type": "github" 73 | } 74 | } 75 | }, 76 | "root": "root", 77 | "version": 7 78 | } 79 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | inputs = { 3 | emacs-package-flake.url = "github:mrkkrp/emacs-package-flake"; 4 | }; 5 | outputs = { self, emacs-package-flake }: 6 | emacs-package-flake.lib.mkOutputs { 7 | name = "mmt"; 8 | srcDir = ./.; 9 | doErt = true; 10 | }; 11 | } 12 | -------------------------------------------------------------------------------- /mmt.el: -------------------------------------------------------------------------------- 1 | ;;; mmt.el --- Missing macro tools for Emacs Lisp -*- lexical-binding: t; -*- 2 | ;; 3 | ;; Copyright © 2015–present Mark Karpov 4 | ;; 5 | ;; Author: Mark Karpov 6 | ;; URL: https://github.com/mrkkrp/mmt 7 | ;; Version: 0.2.0 8 | ;; Package-Requires: ((emacs "24.5")) 9 | ;; Keywords: macro, lisp, extensions 10 | ;; 11 | ;; This file is not part of GNU Emacs. 12 | ;; 13 | ;; This program is free software: you can redistribute it and/or modify it 14 | ;; under the terms of the GNU General Public License as published by the 15 | ;; Free Software Foundation, either version 3 of the License, or (at your 16 | ;; option) any later version. 17 | ;; 18 | ;; This program is distributed in the hope that it will be useful, but 19 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 21 | ;; Public License for more details. 22 | ;; 23 | ;; You should have received a copy of the GNU General Public License along 24 | ;; with this program. If not, see . 25 | 26 | ;;; Commentary: 27 | 28 | ;; The following functions and macros are present: 29 | ;; 30 | ;; * mmt-make-gensym-list 31 | ;; * mmt-with-gensyms 32 | ;; * mmt-with-unique-names 33 | ;; * mmt-once-only 34 | 35 | ;;; Code: 36 | 37 | (require 'cl-lib) 38 | 39 | (defun mmt-make-gensym-list (length &optional x) 40 | "Return a list of LENGTH gensyms. 41 | 42 | Each element of the list is generated as if with a call to 43 | `cl-gensym' using the second argument X (defaulting to \"G\")." 44 | (mapcar #'cl-gensym (make-list length (or x "G")))) 45 | 46 | (defmacro mmt-with-gensyms (names &rest body) 47 | "Bind each variable in NAMES to a unique symbol and evaluate BODY. 48 | 49 | Each element of NAMES must be either a symbol, or of the form: 50 | 51 | (SYMBOL STRING-OR-SYMBOL) 52 | 53 | Bare symbols appearing in NAMES are equivalent to: 54 | 55 | (SYMBOL SYMBOL) 56 | 57 | The STRING-OR-SYMBOL is used (converted to a string if necessary) 58 | as the argument to `cl-gensym' when constructing the unique 59 | symbol the named variable will be bound to." 60 | (declare (indent 1)) 61 | `(let ,(mapcar (lambda (name) 62 | (cl-destructuring-bind (symbol . prefix) 63 | (if (consp name) 64 | (cons (car name) (cadr name)) 65 | (cons name name)) 66 | `(,symbol 67 | (cl-gensym 68 | ,(if (symbolp prefix) 69 | (symbol-name prefix) 70 | prefix))))) 71 | names) 72 | ,@body)) 73 | 74 | (defalias 'mmt-with-unique-names 'mmt-with-gensyms) 75 | 76 | (defmacro mmt-once-only (specs &rest body) 77 | "Rebind symbols according to SPECS and evaluate BODY. 78 | 79 | Each element of SPECS must be either a symbol naming the variable 80 | to be rebound or of the form: 81 | 82 | (SYMBOL INITFORM) 83 | 84 | where INITFORM is guaranteed to be evaluated only once. 85 | 86 | Bare symbols in SPECS are equivalent to 87 | 88 | (SYMBOL SYMBOL) 89 | 90 | Example: 91 | 92 | (defmacro cons1 (x) (mmt-once-only (x) `(cons ,x ,x))) 93 | (let ((y 0)) (cons1 (incf y))) => (1 . 1)" 94 | (declare (indent 1)) 95 | (let* ((gensyms (mmt-make-gensym-list (length specs) "ONCE-ONLY")) 96 | (names-and-forms 97 | (mapcar (lambda (spec) 98 | (if (consp spec) 99 | (cl-destructuring-bind (name form) spec 100 | (cons name form)) 101 | (cons spec spec))) 102 | specs)) 103 | (names (mapcar #'car names-and-forms)) 104 | (forms (mapcar #'cdr names-and-forms))) 105 | ;; DANGER! Brain-damaging code follows: 106 | `(mmt-with-gensyms ,(cl-mapcar #'list gensyms names) 107 | (list 'let 108 | (cl-mapcar #'list (list ,@gensyms) (list ,@forms)) 109 | ,(cl-list* 'let 110 | (cl-mapcar #'list names gensyms) 111 | body))))) 112 | 113 | (provide 'mmt) 114 | 115 | ;;; mmt.el ends here 116 | -------------------------------------------------------------------------------- /test/mmt-test.el: -------------------------------------------------------------------------------- 1 | ;;; mmt-test.el --- Tests for mmt (Missing macro tools for Emacs Lisp) -*- lexical-binding: t; -*- 2 | ;; 3 | ;; Copyright © 2015–present Mark Karpov 4 | ;; 5 | ;; Author: Mark Karpov 6 | ;; URL: https://github.com/mrkkrp/mmt 7 | ;; 8 | ;; This file is not part of GNU Emacs. 9 | ;; 10 | ;; This program is free software: you can redistribute it and/or modify it 11 | ;; under the terms of the GNU General Public License as published by the 12 | ;; Free Software Foundation, either version 3 of the License, or (at your 13 | ;; option) any later version. 14 | ;; 15 | ;; This program is distributed in the hope that it will be useful, but 16 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 18 | ;; Public License for more details. 19 | ;; 20 | ;; You should have received a copy of the GNU General Public License along 21 | ;; with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | 25 | ;;; Code: 26 | 27 | (require 'mmt) 28 | (require 'cl-lib) 29 | 30 | ;; `mmt-make-gensym-list' 31 | 32 | (ert-deftest mmt-make-gensym-list/equality () 33 | (should-not (cl-reduce #'eq (mmt-make-gensym-list 10))) 34 | (should-not (eq (mmt-make-gensym-list 5) 35 | (mmt-make-gensym-list 5)))) 36 | 37 | ;; `mmt-with-gensyms' 38 | 39 | (defmacro mmt-with-gensyms-test (x y &rest body) 40 | "Construct a list using X Y without capturing anything in BODY." 41 | (declare (indent 2)) 42 | (mmt-with-gensyms (a b c) 43 | `(let ((,a ,x) 44 | (,b ,y) 45 | (,c (+ ,x ,y))) 46 | ,@body 47 | (list ,a ,b ,c)))) 48 | 49 | (ert-deftest mmt-with-gensyms/capturing () 50 | (should (equal (mmt-with-gensyms-test 2 (+ 1 2) 51 | (setq a 10 b 12 c 80)) 52 | '(2 3 5)))) 53 | 54 | ;; `mmt-with-unique-names' 55 | 56 | (ert-deftest mmt-with-unique-names/aliasing () 57 | (should (eq (symbol-function 'mmt-with-unique-names) 58 | 'mmt-with-gensyms))) 59 | 60 | ;; `mmt-once-only' 61 | 62 | (defmacro mmt-once-only-test (x y) 63 | "Evaluate X and Y once but use their values many times." 64 | (mmt-once-only (x y) 65 | `(list ,x ,y ,x ,y (+ ,x ,y)))) 66 | 67 | (defvar mmt-once-only-temp 0 68 | "Used in the test below to count number of evaluations.") 69 | 70 | (ert-deftest mmt-once-only/evaluation () 71 | (should (equal (mmt-once-only-test 72 | (prog1 10 (cl-incf mmt-once-only-temp)) 73 | (prog1 20 (cl-incf mmt-once-only-temp))) 74 | '(10 20 10 20 30))) 75 | (should (equal mmt-once-only-temp 2))) 76 | 77 | (provide 'mmt-test) 78 | 79 | ;;; mmt-test.el ends here 80 | --------------------------------------------------------------------------------