Solutions to Assignment 2.


;; 1. ZERO-IT

(defmacro zero-it (sym)
     "Set the in-scope value of sym (an unquoted symbol) to 0"
    `(setq ,sym 0))

;; 2. ZERO-THEM

(defmacro zero-them (&rest symbols)
     "Set the in-scope value of each argument, which should all
      be unquoted symbols, to 0"
     (append '(progn)
          (mapcar #'(lambda (sym) `(setq ,sym 0)) symbols))
  )

;; 3. THRICE-EACH

(defmacro thrice-each (&rest forms)
     "Evaluate each form 3 times and return result of last evaluation."
     (append '(progn) 
          (mapcar #'(lambda (form) (list 'progn form form form)) forms))
   )


;; 4. ORDERED-PAIRS

(defun ordered-pairs (set)
  (let ((pairs nil))
    (dolist (elt set)
      (dolist (elt2 set)
        (push (cons elt elt2) pairs)
      ) )
    (reverse pairs) ) )

;; 5. FOR-ALL-UNORDERED-PAIRS

;;; Let's start out with something that might be helpful.

;;; Here's a recursive function that generates all
;;; pairs but without including transposed instances
;;; of pairs already given.  I.e., if (A . B) has
;;; been given, then (B . A) is not given.
(defun unordered-pairs (set)
  (if (null set) nil
    (append
      (mapcar
        #'(lambda (x) (cons (first set) x))
        set)
      (unordered-pairs (rest set)) ) ) )

;;; Iterative version of UNORDERED-PAIRS
(defun unordered-pairs2 (set)
  (let ((pairs nil)
        (remains set))
    (dolist (elt set)
      (dolist (elt2 remains)
        (push (cons elt elt2) pairs)
      )
      (pop remains)
        )
    (reverse pairs) ) )

;;; Here's a version of a macro for iterating over all
;;; unordered pairs.  It uses one of the helping functions.
(defmacro for-all-unordered-pairs (pair base-set &rest forms)
  (let ((xsym (first pair))
        (ysym (second pair))
        (pair-list (ordered-pairs (eval base-set)))
        (pairsym (gensym)) )
    `(let (,xsym ,ysym)
       (dolist (,pairsym ',pair-list)
         (setq ,xsym (car ,pairsym))
         (setq ,ysym (cdr ,pairsym))
         . ,forms
         ) ) ) )

;;; A utility for testing the macro:
(defun test1 ()
  (macroexpand '(for-all-unordered-pairs (x y) '(a b c)
    (format t "X is ~S and Y is ~S.~%" x y) ))
)

;;; Another test:
(defun test2 ()
  (for-all-unordered-pairs (x y) '(a b c)
    (format t "X is ~S and Y is ~S.~%" x y) )
)

;;; Here is a version that does not use a helping function,
;;; and does not ever have to store all the pairs on a list.
(defmacro for-all-unordered-pairs2 (pair base-set &rest forms)
  (let ((xsym (first pair))
        (ysym (second pair))
        (pairsym (gensym))
        (remainssym (gensym)) )
    `(let ((,remainssym ,base-set))
      (dolist (,xsym ,base-set)
        (dolist (,ysym ,remainssym)
          . ,forms
        )
      (pop ,remainssym)
        )
     ) ) )

;;; Here are testing utilities for the second version of
;;; the macro.

(defun test3 ()
  (macroexpand '(for-all-unordered-pairs2 (x y) '(a b c)
    (format t "X is ~S and Y is ~S.~%" x y) ))
)

(defun test4 ()
  (for-all-unordered-pairs2 (x y) '(a b c)
    (format t "X is ~S and Y is ~S.~%" x y) )
)

Solutions 1-3 provided by Rick Cox, and 4-6 by Steve Tanimoto.