Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

Lisp Macrology

Name: Anonymous 2009-09-12 19:42

Post crazy Lisp macros you've written in this thread.

I'll start off with a quick one I wrote 15minutes ago, PROGK:

Name: Anonymous 2009-09-12 21:19

>>12
Just implemented your idea, finally got rid of the hacky specials used in the general case:

(defmacro progk (k &body forms)
  "Evaluates forms in order, and returns the values of k-th form.
   Index starts at 0. If k is out of the bounds, NIL will be returned."
  (let ((kv (gensym)))
    (typecase k
      ;; Known value - optimized, handle at macroexpansion time
      (integer
       (multiple-value-bind (first second third)
           (split-at forms k 1)
         `(let ((,kv nil))
            (progn ,@first
                   ,(when second
                          `(setf ,kv
                                 ;; Remove this conditional if you want an
                                 ;; error to be signaled if K is out of bounds
                                 (multiple-value-list ,@second)))
                   ,@third
                   (values-list ,kv)))))
      ;; Unknown value - handle at runtime
      (t
       (let ((gs (loop repeat (length forms) collect (gensym))))
         (once-only (k)
           `(let ,gs
              (progn
                  ,@(mapcar #'(lambda (form g) `(setf ,g (multiple-value-list ,form))) forms gs)
                  (case ,k
                    ,@(loop for i from 0 to (length forms)
                           for g in gs collect `(,i ,g)))))))))))

Name: Anonymous 2009-09-12 21:23

Damn, I should test my code before I post, minor fix:

(defmacro progk (k &body forms)
  "Evaluates forms in order, and returns the values of k-th form.
   Index starts at 0. If k is out of the bounds, NIL will be returned."
  (let ((kv (gensym)))
    (typecase k
      ;; Known value - optimized, handle at macroexpansion time
      (integer
       (multiple-value-bind (first second third)
           (split-at forms k 1)
         `(let ((,kv nil))
            (progn ,@first
                   ,(when second
                          `(setf ,kv
                                 ;; Remove this conditional if you want an
                                 ;; error to be signaled if K is out of bounds
                                 (multiple-value-list ,@second)))
                   ,@third
                   (values-list ,kv)))))
      ;; Unknown value - handle at runtime
      (t
       (let* ((nforms (length forms))
              (gs (loop repeat nforms collect (gensym))))
         (once-only (k)
           `(let ,gs
              (progn
                  ,@(mapcar #'(lambda (form g) `(setf ,g (multiple-value-list ,form))) forms gs)
                  (case ,k
                    ,@(loop for i from 0 to nforms
                         for g in gs collect `(,i (values-list,g))))))))))))

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List