| commit | author | age | ||
| 5cb5f7 | 1 | ;;; anaphora.el --- anaphoric macros providing implicit temp variables -*- lexical-binding: t -*- |
| C | 2 | ;; |
| 3 | ;; This code is in the public domain. | |
| 4 | ;; | |
| 5 | ;; Author: Roland Walker <walker@pobox.com> | |
| 6 | ;; Homepage: http://github.com/rolandwalker/anaphora | |
| 7 | ;; URL: http://raw.githubusercontent.com/rolandwalker/anaphora/master/anaphora.el | |
| 8 | ;; Package-Version: 20180618.2200 | |
| 9 | ;; Version: 1.0.4 | |
| 10 | ;; Last-Updated: 18 Jun 2018 | |
| 11 | ;; EmacsWiki: Anaphora | |
| 12 | ;; Keywords: extensions | |
| 13 | ;; | |
| 14 | ;;; Commentary: | |
| 15 | ;; | |
| 16 | ;; Quickstart | |
| 17 | ;; | |
| 18 | ;; (require 'anaphora) | |
| 19 | ;; | |
| 20 | ;; (awhen (big-long-calculation) | |
| 21 | ;; (foo it) ; `it' is provided as | |
| 22 | ;; (bar it)) ; a temporary variable | |
| 23 | ;; | |
| 24 | ;; ;; anonymous function to compute factorial using `self' | |
| 25 | ;; (alambda (x) (if (= x 0) 1 (* x (self (1- x))))) | |
| 26 | ;; | |
| 27 | ;; ;; to fontify `it' and `self' | |
| 28 | ;; (with-eval-after-load "lisp-mode" | |
| 29 | ;; (anaphora-install-font-lock-keywords)) | |
| 30 | ;; | |
| 31 | ;; Explanation | |
| 32 | ;; | |
| 33 | ;; Anaphoric expressions implicitly create one or more temporary | |
| 34 | ;; variables which can be referred to during the expression. This | |
| 35 | ;; technique can improve clarity in certain cases. It also enables | |
| 36 | ;; recursion for anonymous functions. | |
| 37 | ;; | |
| 38 | ;; To use anaphora, place the anaphora.el library somewhere | |
| 39 | ;; Emacs can find it, and add the following to your ~/.emacs file: | |
| 40 | ;; | |
| 41 | ;; (require 'anaphora) | |
| 42 | ;; | |
| 43 | ;; The following macros are made available | |
| 44 | ;; | |
| 45 | ;; `aand' | |
| 46 | ;; `ablock' | |
| 47 | ;; `acase' | |
| 48 | ;; `acond' | |
| 49 | ;; `aecase' | |
| 50 | ;; `aetypecase' | |
| 51 | ;; `aif' | |
| 52 | ;; `alambda' | |
| 53 | ;; `alet' | |
| 54 | ;; `aprog1' | |
| 55 | ;; `aprog2' | |
| 56 | ;; `atypecase' | |
| 57 | ;; `awhen' | |
| 58 | ;; `awhile' | |
| 59 | ;; `a+' | |
| 60 | ;; `a-' | |
| 61 | ;; `a*' | |
| 62 | ;; `a/' | |
| 63 | ;; | |
| 64 | ;; See Also | |
| 65 | ;; | |
| 66 | ;; M-x customize-group RET anaphora RET | |
| 67 | ;; http://en.wikipedia.org/wiki/On_Lisp | |
| 68 | ;; http://en.wikipedia.org/wiki/Anaphoric_macro | |
| 69 | ;; | |
| 70 | ;; Notes | |
| 71 | ;; | |
| 72 | ;; Partially based on examples from the book "On Lisp", by Paul | |
| 73 | ;; Graham. | |
| 74 | ;; | |
| 75 | ;; Compatibility and Requirements | |
| 76 | ;; | |
| 77 | ;; GNU Emacs version 26.1 : yes | |
| 78 | ;; GNU Emacs version 25.x : yes | |
| 79 | ;; GNU Emacs version 24.x : yes | |
| 80 | ;; GNU Emacs version 23.x : yes | |
| 81 | ;; GNU Emacs version 22.x : yes | |
| 82 | ;; GNU Emacs version 21.x and lower : unknown | |
| 83 | ;; | |
| 84 | ;; Bugs | |
| 85 | ;; | |
| 86 | ;; TODO | |
| 87 | ;; | |
| 88 | ;; better face for it and self | |
| 89 | ;; | |
| 90 | ;;; License | |
| 91 | ;; | |
| 92 | ;; All code contributed by the author to this library is placed in the | |
| 93 | ;; public domain. It is the author's belief that the portions adapted | |
| 94 | ;; from examples in "On Lisp" are in the public domain. | |
| 95 | ;; | |
| 96 | ;; Regardless of the copyright status of individual functions, all | |
| 97 | ;; code herein is free software, and is provided without any express | |
| 98 | ;; or implied warranties. | |
| 99 | ;; | |
| 100 | ;;; Code: | |
| 101 | ;; | |
| 102 | ||
| 103 | ;;; requirements | |
| 104 | ||
| 105 | ;; for declare, labels, do, block, case, ecase, typecase, etypecase | |
| 106 | (require 'cl-lib) | |
| 107 | ||
| 108 | ;;; customizable variables | |
| 109 | ||
| 110 | ;;;###autoload | |
| 111 | (defgroup anaphora nil | |
| 112 | "Anaphoric macros providing implicit temp variables" | |
| 113 | :version "1.0.4" | |
| 114 | :link '(emacs-commentary-link :tag "Commentary" "anaphora") | |
| 115 | :link '(url-link :tag "GitHub" "http://github.com/rolandwalker/anaphora") | |
| 116 | :link '(url-link :tag "EmacsWiki" "http://emacswiki.org/emacs/Anaphora") | |
| 117 | :prefix "anaphora-" | |
| 118 | :group 'extensions) | |
| 119 | ||
| 120 | ;;;###autoload | |
| 121 | (defcustom anaphora-use-long-names-only nil | |
| 122 | "Use only long names such as `anaphoric-if' instead of traditional `aif'." | |
| 123 | :type 'boolean | |
| 124 | :group 'anaphora) | |
| 125 | ||
| 126 | ;;; font-lock | |
| 127 | ||
| 128 | (defun anaphora-install-font-lock-keywords nil | |
| 129 | "Fontify keywords `it' and `self'." | |
| 130 | (font-lock-add-keywords 'emacs-lisp-mode `((,(concat "\\<" (regexp-opt '("it" "self") 'paren) "\\>") | |
| 131 | 1 font-lock-variable-name-face)) 'append)) | |
| 132 | ||
| 133 | ;;; aliases | |
| 134 | ||
| 135 | ;;;###autoload | |
| 136 | (progn | |
| 137 | (defun anaphora--install-traditional-aliases (&optional arg) | |
| 138 | "Install traditional short aliases for anaphoric macros. | |
| 139 | ||
| 140 | With negative numeric ARG, remove traditional aliases." | |
| 141 | (let ((syms '( | |
| 142 | (if . t) | |
| 143 | (prog1 . t) | |
| 144 | (prog2 . t) | |
| 145 | (when . when) | |
| 146 | (while . t) | |
| 147 | (and . t) | |
| 148 | (cond . cond) | |
| 149 | (lambda . lambda) | |
| 150 | (block . block) | |
| 151 | (case . case) | |
| 152 | (ecase . ecase) | |
| 153 | (typecase . typecase) | |
| 154 | (etypecase . etypecase) | |
| 155 | (let . let) | |
| 156 | (+ . t) | |
| 157 | (- . t) | |
| 158 | (* . t) | |
| 159 | (/ . t) | |
| 160 | ))) | |
| 161 | (cond | |
| 162 | ((and (numberp arg) | |
| 163 | (< arg 0)) | |
| 164 | (dolist (cell syms) | |
| 165 | (when (ignore-errors | |
| 166 | (eq (symbol-function (intern-soft (format "a%s" (car cell)))) | |
| 167 | (intern-soft (format "anaphoric-%s" (car cell))))) | |
| 168 | (fmakunbound (intern (format "a%s" (car cell))))))) | |
| 169 | (t | |
| 170 | (dolist (cell syms) | |
| 171 | (let* ((builtin (car cell)) | |
| 172 | (traditional (intern (format "a%s" builtin))) | |
| 173 | (long (intern (format "anaphoric-%s" builtin)))) | |
| 174 | (defalias traditional long) | |
| 175 | (put traditional 'lisp-indent-function | |
| 176 | (get builtin 'lisp-indent-function)) | |
| 177 | (put traditional 'edebug-form-spec (cdr cell))))))))) | |
| 178 | ||
| 179 | ;;;###autoload | |
| 180 | (unless anaphora-use-long-names-only | |
| 181 | (anaphora--install-traditional-aliases)) | |
| 182 | ||
| 183 | ;;; macros | |
| 184 | ||
| 185 | ;;;###autoload | |
| 186 | (defmacro anaphoric-if (cond then &rest else) | |
| 187 | "Like `if', but the result of evaluating COND is bound to `it'. | |
| 188 | ||
| 189 | The variable `it' is available within THEN and ELSE. | |
| 190 | ||
| 191 | COND, THEN, and ELSE are otherwise as documented for `if'." | |
| 192 | (declare (debug t) | |
| 193 | (indent 2)) | |
| 194 | `(let ((it ,cond)) | |
| 195 | (if it ,then ,@else))) | |
| 196 | ||
| 197 | ;;;###autoload | |
| 198 | (defmacro anaphoric-prog1 (first &rest body) | |
| 199 | "Like `prog1', but the result of evaluating FIRST is bound to `it'. | |
| 200 | ||
| 201 | The variable `it' is available within BODY. | |
| 202 | ||
| 203 | FIRST and BODY are otherwise as documented for `prog1'." | |
| 204 | (declare (debug t) | |
| 205 | (indent 1)) | |
| 206 | `(let ((it ,first)) | |
| 207 | (progn ,@body) | |
| 208 | it)) | |
| 209 | ||
| 210 | ;;;###autoload | |
| 211 | (defmacro anaphoric-prog2 (form1 form2 &rest body) | |
| 212 | "Like `prog2', but the result of evaluating FORM2 is bound to `it'. | |
| 213 | ||
| 214 | The variable `it' is available within BODY. | |
| 215 | ||
| 216 | FORM1, FORM2, and BODY are otherwise as documented for `prog2'." | |
| 217 | (declare (debug t) | |
| 218 | (indent 2)) | |
| 219 | `(progn | |
| 220 | ,form1 | |
| 221 | (let ((it ,form2)) | |
| 222 | (progn ,@body) | |
| 223 | it))) | |
| 224 | ||
| 225 | ;;;###autoload | |
| 226 | (defmacro anaphoric-when (cond &rest body) | |
| 227 | "Like `when', but the result of evaluating COND is bound to `it'. | |
| 228 | ||
| 229 | The variable `it' is available within BODY. | |
| 230 | ||
| 231 | COND and BODY are otherwise as documented for `when'." | |
| 232 | (declare (debug when) | |
| 233 | (indent 1)) | |
| 234 | `(anaphoric-if ,cond | |
| 235 | (progn ,@body))) | |
| 236 | ||
| 237 | ;;;###autoload | |
| 238 | (defmacro anaphoric-while (test &rest body) | |
| 239 | "Like `while', but the result of evaluating TEST is bound to `it'. | |
| 240 | ||
| 241 | The variable `it' is available within BODY. | |
| 242 | ||
| 243 | TEST and BODY are otherwise as documented for `while'." | |
| 244 | (declare (debug t) | |
| 245 | (indent 1)) | |
| 246 | `(do ((it ,test ,test)) | |
| 247 | ((not it)) | |
| 248 | ,@body)) | |
| 249 | ||
| 250 | ;;;###autoload | |
| 251 | (defmacro anaphoric-and (&rest conditions) | |
| 252 | "Like `and', but the result of the previous condition is bound to `it'. | |
| 253 | ||
| 254 | The variable `it' is available within all CONDITIONS after the | |
| 255 | initial one. | |
| 256 | ||
| 257 | CONDITIONS are otherwise as documented for `and'. | |
| 258 | ||
| 259 | Note that some implementations of this macro bind only the first | |
| 260 | condition to `it', rather than each successive condition." | |
| 261 | (declare (debug t)) | |
| 262 | (cond | |
| 263 | ((null conditions) | |
| 264 | t) | |
| 265 | ((null (cdr conditions)) | |
| 266 | (car conditions)) | |
| 267 | (t | |
| 268 | `(anaphoric-if ,(car conditions) (anaphoric-and ,@(cdr conditions)))))) | |
| 269 | ||
| 270 | ;;;###autoload | |
| 271 | (defmacro anaphoric-cond (&rest clauses) | |
| 272 | "Like `cond', but the result of each condition is bound to `it'. | |
| 273 | ||
| 274 | The variable `it' is available within the remainder of each of CLAUSES. | |
| 275 | ||
| 276 | CLAUSES are otherwise as documented for `cond'." | |
| 277 | (declare (debug cond)) | |
| 278 | (if (null clauses) | |
| 279 | nil | |
| 280 | (let ((cl1 (car clauses)) | |
| 281 | (sym (gensym))) | |
| 282 | `(let ((,sym ,(car cl1))) | |
| 283 | (if ,sym | |
| 284 | (if (null ',(cdr cl1)) | |
| 285 | ,sym | |
| 286 | (let ((it ,sym)) ,@(cdr cl1))) | |
| 287 | (anaphoric-cond ,@(cdr clauses))))))) | |
| 288 | ||
| 289 | ;;;###autoload | |
| 290 | (defmacro anaphoric-lambda (args &rest body) | |
| 291 | "Like `lambda', but the function may refer to itself as `self'. | |
| 292 | ||
| 293 | ARGS and BODY are otherwise as documented for `lambda'." | |
| 294 | (declare (debug lambda) | |
| 295 | (indent defun)) | |
| 296 | `(cl-labels ((self ,args ,@body)) | |
| 297 | #'self)) | |
| 298 | ||
| 299 | ;;;###autoload | |
| 300 | (defmacro anaphoric-block (name &rest body) | |
| 301 | "Like `block', but the result of the previous expression is bound to `it'. | |
| 302 | ||
| 303 | The variable `it' is available within all expressions of BODY | |
| 304 | except the initial one. | |
| 305 | ||
| 306 | NAME and BODY are otherwise as documented for `block'." | |
| 307 | (declare (debug block) | |
| 308 | (indent 1)) | |
| 309 | `(cl-block ,name | |
| 310 | ,(funcall (anaphoric-lambda (body) | |
| 311 | (cl-case (length body) | |
| 312 | (0 nil) | |
| 313 | (1 (car body)) | |
| 314 | (t `(let ((it ,(car body))) | |
| 315 | ,(self (cdr body)))))) | |
| 316 | body))) | |
| 317 | ||
| 318 | ;;;###autoload | |
| 319 | (defmacro anaphoric-case (expr &rest clauses) | |
| 320 | "Like `case', but the result of evaluating EXPR is bound to `it'. | |
| 321 | ||
| 322 | The variable `it' is available within CLAUSES. | |
| 323 | ||
| 324 | EXPR and CLAUSES are otherwise as documented for `case'." | |
| 325 | (declare (debug case) | |
| 326 | (indent 1)) | |
| 327 | `(let ((it ,expr)) | |
| 328 | (cl-case it ,@clauses))) | |
| 329 | ||
| 330 | ;;;###autoload | |
| 331 | (defmacro anaphoric-ecase (expr &rest clauses) | |
| 332 | "Like `ecase', but the result of evaluating EXPR is bound to `it'. | |
| 333 | ||
| 334 | The variable `it' is available within CLAUSES. | |
| 335 | ||
| 336 | EXPR and CLAUSES are otherwise as documented for `ecase'." | |
| 337 | (declare (debug ecase) | |
| 338 | (indent 1)) | |
| 339 | `(let ((it ,expr)) | |
| 340 | (cl-ecase it ,@clauses))) | |
| 341 | ||
| 342 | ;;;###autoload | |
| 343 | (defmacro anaphoric-typecase (expr &rest clauses) | |
| 344 | "Like `typecase', but the result of evaluating EXPR is bound to `it'. | |
| 345 | ||
| 346 | The variable `it' is available within CLAUSES. | |
| 347 | ||
| 348 | EXPR and CLAUSES are otherwise as documented for `typecase'." | |
| 349 | (declare (debug typecase) | |
| 350 | (indent 1)) | |
| 351 | `(let ((it ,expr)) | |
| 352 | (cl-typecase it ,@clauses))) | |
| 353 | ||
| 354 | ;;;###autoload | |
| 355 | (defmacro anaphoric-etypecase (expr &rest clauses) | |
| 356 | "Like `etypecase', but result of evaluating EXPR is bound to `it'. | |
| 357 | ||
| 358 | The variable `it' is available within CLAUSES. | |
| 359 | ||
| 360 | EXPR and CLAUSES are otherwise as documented for `etypecase'." | |
| 361 | (declare (debug etypecase) | |
| 362 | (indent 1)) | |
| 363 | `(let ((it ,expr)) | |
| 364 | (cl-etypecase it ,@clauses))) | |
| 365 | ||
| 366 | ;;;###autoload | |
| 367 | (defmacro anaphoric-let (form &rest body) | |
| 368 | "Like `let', but the result of evaluating FORM is bound to `it'. | |
| 369 | ||
| 370 | FORM and BODY are otherwise as documented for `let'." | |
| 371 | (declare (debug let) | |
| 372 | (indent 1)) | |
| 373 | `(let ((it ,form)) | |
| 374 | (progn ,@body))) | |
| 375 | ||
| 376 | ;;;###autoload | |
| 377 | (defmacro anaphoric-+ (&rest numbers-or-markers) | |
| 378 | "Like `+', but the result of evaluating the previous expression is bound to `it'. | |
| 379 | ||
| 380 | The variable `it' is available within all expressions after the | |
| 381 | initial one. | |
| 382 | ||
| 383 | NUMBERS-OR-MARKERS are otherwise as documented for `+'." | |
| 384 | (declare (debug t)) | |
| 385 | (cond | |
| 386 | ((null numbers-or-markers) | |
| 387 | 0) | |
| 388 | (t | |
| 389 | `(let ((it ,(car numbers-or-markers))) | |
| 390 | (+ it (anaphoric-+ ,@(cdr numbers-or-markers))))))) | |
| 391 | ||
| 392 | ;;;###autoload | |
| 393 | (defmacro anaphoric-- (&optional number-or-marker &rest numbers-or-markers) | |
| 394 | "Like `-', but the result of evaluating the previous expression is bound to `it'. | |
| 395 | ||
| 396 | The variable `it' is available within all expressions after the | |
| 397 | initial one. | |
| 398 | ||
| 399 | NUMBER-OR-MARKER and NUMBERS-OR-MARKERS are otherwise as | |
| 400 | documented for `-'." | |
| 401 | (declare (debug t)) | |
| 402 | (cond | |
| 403 | ((null number-or-marker) | |
| 404 | 0) | |
| 405 | ((null numbers-or-markers) | |
| 406 | `(- ,number-or-marker)) | |
| 407 | (t | |
| 408 | `(let ((it ,(car numbers-or-markers))) | |
| 409 | (- ,number-or-marker (+ it (anaphoric-+ ,@(cdr numbers-or-markers)))))))) | |
| 410 | ||
| 411 | ;;;###autoload | |
| 412 | (defmacro anaphoric-* (&rest numbers-or-markers) | |
| 413 | "Like `*', but the result of evaluating the previous expression is bound to `it'. | |
| 414 | ||
| 415 | The variable `it' is available within all expressions after the | |
| 416 | initial one. | |
| 417 | ||
| 418 | NUMBERS-OR-MARKERS are otherwise as documented for `*'." | |
| 419 | (declare (debug t)) | |
| 420 | (cond | |
| 421 | ((null numbers-or-markers) | |
| 422 | 1) | |
| 423 | (t | |
| 424 | `(let ((it ,(car numbers-or-markers))) | |
| 425 | (* it (anaphoric-* ,@(cdr numbers-or-markers))))))) | |
| 426 | ||
| 427 | ;;;###autoload | |
| 428 | (defmacro anaphoric-/ (dividend divisor &rest divisors) | |
| 429 | "Like `/', but the result of evaluating the previous divisor is bound to `it'. | |
| 430 | ||
| 431 | The variable `it' is available within all expressions after the | |
| 432 | first divisor. | |
| 433 | ||
| 434 | DIVIDEND, DIVISOR, and DIVISORS are otherwise as documented for `/'." | |
| 435 | (declare (debug t)) | |
| 436 | (cond | |
| 437 | ((null divisors) | |
| 438 | `(/ ,dividend ,divisor)) | |
| 439 | (t | |
| 440 | `(let ((it ,divisor)) | |
| 441 | (/ ,dividend (* it (anaphoric-* ,@divisors))))))) | |
| 442 | ||
| 443 | (provide 'anaphora) | |
| 444 | ||
| 445 | ;; | |
| 446 | ;; Emacs | |
| 447 | ;; | |
| 448 | ;; Local Variables: | |
| 449 | ;; indent-tabs-mode: nil | |
| 450 | ;; mangle-whitespace: t | |
| 451 | ;; require-final-newline: t | |
| 452 | ;; coding: utf-8 | |
| 453 | ;; byte-compile-warnings: (not cl-functions redefine) | |
| 454 | ;; End: | |
| 455 | ;; | |
| 456 | ;; LocalWords: Anaphora EXPR awhen COND ARGS alambda ecase typecase | |
| 457 | ;; LocalWords: etypecase aprog aand acond ablock acase aecase alet | |
| 458 | ;; LocalWords: atypecase aetypecase | |
| 459 | ;; | |
| 460 | ||
| 461 | ;;; anaphora.el ends here | |
