Mercurial > lbo > hg > lispplay
view macroplay.lisp @ 3:83743e601985 default tip
Add new lisp files
author | Lewin Bormann <lbo@spheniscida.de> |
---|---|
date | Sun, 13 Oct 2019 14:00:24 +0200 |
parents | |
children |
line wrap: on
line source
(defun nth-fib (n) (do ((c 0 (+ c 1)) (last 0 current) (current 1 (+ last current))) ((= n c) current))) ;; Allow defining dynamic unique symbols in other macros (defmacro with-gensyms (symbols &body body) `(let ,(loop for sym in symbols collect `(,sym (gensym))) ,@body)) (defmacro do-something-times (times &body body) (with-gensyms (loop-var-name) `(loop for ,loop-var-name from 1 to ,times do ,@body))) (defmacro once-only ((&rest names) &body body) (let ((gensyms (loop for n in names collect (gensym)))) `(let (,@(loop for g in gensyms collect `(,g (gensym)))) `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n))) ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g))) ,@body))))) (defmacro do-something-times-primitive (times &body body) (oo (times) `(loop for loop-var from 1 to ,times do ,@body))) (defmacro oo ((&rest names) &body body) ;; For each name, generate a symbol that is used ;; in the invoking macro to store the unique symbol; ;; for the emitted code (let ((gensyms (loop for n in names collect (gensym)))) ;; in other defmacro (level-1) ;; generate symbols to store evaluated names in. Assign them ;; to unique (l-0) symbols generated above. `(let (,@(loop for g in gensyms collect `(,g (gensym)))) ;; in final code (level-2) ;; evaluate names. Assign them to the locally-generated (l-1) symbols. `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n))) ;; in other defmacro (level-1 again): ;; Bind evaluated names back to names ,(let (,@(loop for g in gensyms for n in names collect `(,n ,g))) ,@body))))) ;; stuff (defmacro my-list (&rest vals) (if (not vals) nil ``(,,(car vals) . ,(my-list ,@(cdr vals))))) ;; Anaphoric macros?? (defmacro my-if (test if-so if-else) `(let ((it ,test)) (if it ,if-so ,if-else))) (defmacro my-lambda (arg-list &body body) `(labels ((self ,arg-list ,@body)) #'self))