X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=macros.lisp;h=c448b92e2c5ed4817bdf644d42edd5b0762a210f;hp=cc39ad41b871947c57f85f3edfde6aa983463c4b;hb=3ca593ad0ad02da7ebfd270523795674d6458ad3;hpb=251043d4c96c996a35cd48c4452b03fbef2ea21a

diff --git a/macros.lisp b/macros.lisp
index cc39ad4..c448b92 100644
--- a/macros.lisp
+++ b/macros.lisp
@@ -86,13 +86,28 @@
                (let ((it ,val)) ,@(cdr cl1))
                (acond2 ,@(cdr clauses)))))))
 
-(defmacro mac (expr)
-"Expand a macro"
-  `(pprint (macroexpand-1 ',expr)))
+(defmacro mac (form &key (stream *standard-output*) (full nil) (width 80)
+               (downcase t)
+               &environment env)
+  (multiple-value-bind (expanded expanded-p)
+      (funcall (if full #'macroexpand #'macroexpand-1) form env)
+    (write expanded
+           :stream stream
+           :pretty t
+           :right-margin width
+           :case (if downcase :downcase :upcase)
+           :length nil
+           :level nil
+           :circle nil
+           :gensym nil)
+    (fresh-line stream)
+    expanded-p))
 
 (defmacro print-form-and-results (form)
-  `(format t "~&~A --> ~S~%" (write-to-string ',form) ,form))
-
+  (let ((r (gensym "RES-")))
+    `(let ((r ,form))
+       (format t "~&~A --> ~S~%" ',form r)
+       r)))
 
 ;;; Loop macros
 
@@ -107,16 +122,16 @@
      ,@body))
 
 (defmacro for ((var start stop) &body body)
-  (let ((gstop (gensym)))
+  (let ((gstop (gensym "STOP-")))
     `(do ((,var ,start (1+ ,var))
           (,gstop ,stop))
          ((> ,var ,gstop))
        ,@body)))
 
 (defmacro with-each-stream-line ((var stream) &body body)
-  (let ((eof (gensym))
-        (eof-value (gensym))
-        (strm (gensym)))
+  (let ((eof (gensym "EOF-"))
+        (eof-value (gensym "EOF-VALUE-"))
+        (strm (gensym "STREAM-")))
     `(let ((,strm ,stream)
            (,eof ',eof-value))
       (do ((,var (read-line ,strm nil ,eof) (read-line ,strm nil ,eof)))
@@ -140,7 +155,7 @@
   `(/ (+ ,@args) ,(length args)))
 
 (defmacro with-gensyms (syms &body body)
-  `(let ,(mapcar #'(lambda (s) `(,s (gensym)))
+  `(let ,(mapcar #'(lambda (s) `(,s (gensym ,(format nil "~A-" s))))
           syms)
      ,@body))