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))