EuAndreh
commented
10 years ago With docstrings:
(defun g!-symbol-p (s)
"Checks if a symbol S begins with \"G!\" and has, at least, on more character in its name."
(and (symbolp s)
(> (length (symbol-name s)) 2)
(string= (symbol-name s)
"G!"
:start1 0
:end1 2)))
(defmacro defmacro/g! (name args &rest body)
"Receives a normal DEFMACRO body and searches for symbols named like g!XXX. When found, each symbol is bound to a gensym and replaced in the body, giving the body automatic gensyms.
Usage:
(defmacro/g! nif (expr pos zero neg)
`(let ((,g!result ,expr))
(cond ((plusp ,g!result) ,pos)
((zerop ,g!result) ,zero)
(t ,neg))))
That expands to:
(DEFMACRO NIF (EXPR POS ZERO NEG)
(LET ((G!RESULT (GENSYM \"RESULT\")))
`(LET ((,G!RESULT ,EXPR))
(COND ((PLUSP ,G!RESULT) ,POS)
((ZEROP ,G!RESULT) ,ZERO)
(T ,NEG)))))
The g!result symbol appearing multiple times in the original code becomes a gensym (gensym \"RESULT\") and then receives the LET binding of EXPR."
(let ((syms (remove-duplicates
(remove-if-not #'g!-symbol-p
(qtl:flatten body)))))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (s)
`(,s (gensym ,(subseq
(symbol-name s)
2))))
syms)
,@body))))
(defun o!-symbol-p (s)
"Checks if a symbol S begins with \"O!\" and has, at least, on more character in its name."
(and (symbolp s)
(> (length (symbol-name s)) 2)
(string= (symbol-name s)
"O!"
:start1 0
:end1 2)))
(defun o!-symbol-to-g!-symbol (s)
"Converts a given O! symbol into a G! symbol."
(symb "G!"
(subseq (symbol-name s) 2)))
(defmacro defmacro! (name args &rest body)
"Implements avoidance of multiple evaluation on top of DEFMACRO/G!, giving it once-only capabilities. DEFMACRO/G! gives automatic gensyms, DEFMACRO! gives automatic once-only.
Symbols prefixed with O! are bound to created G! symbols.
Usage:
(defmacro! square (o!x)
`(* ,g!x ,g!x))
That expands to:
(DEFMACRO/G! SQUARE (O!X)
`(LET ,(MAPCAR #'LIST (LIST G!X) (LIST O!X)))
(* ,G!X ,G!X)))
The let creates bindings for the O! symbols so that they are evaluated once-only. When used with no O! symbols in the parameter list, it works exactly like a DEFMACRO/G!."
(let* ((os (remove-if-not #'o!-symbol-p args))
(gs (mapcar #'o!-symbol-to-g!-symbol os)))
`(defmacro/g! ,name ,args
`(let ,(mapcar #'list (list ,@gs) (list ,@os))
,(progn ,@body)))))
;; Write the code here.
Provides: defmacro!, a defmacro variant with once-only and automatic gensym built-in Requires: flatten, symb. Author: Doug Hoyte. (extracted from his book, Let Over Lambda) License: BSD-like