`list-of' macro snippet [regarding Comprehensions]

[Rivka Miller]

Discusuion continued from the link

http://groups.google.com/group/gnu.emacs.sources/browse_thread/thread/fb06c73b4e076ad1

For those of you who might be interested in this topic. I am including
the html source of the two links as well as verbatim text discussion
to continue the topic.

\begin{verbatim}
http://web.archive.org/web/20021108231431/http://www.cs.nwu.edu/academics/courses/c25/exercises/lisp-exs.html
Lisp Exercises

Some of these exercises are in addition to or in place of those in
Graham or Wilensky.

SOME (Chapter 8, Ex. 7)

Define (has-number-p s-exp) to return true if the s-expression is or
contains a number.

> (has-number-p 1)
T
> (has-number-p 'a)
NIL
> (has-number-p '(1 (b (2 c) ((3)))))
T



Implement this using a simple conditional, recursion, and SOME.
Letting SOME do some of the work is more efficient than a pure CAR-CDR
recursive solution.

Wilensky, Ex. 13.2 revised

Define the macro our-if to have the form

(OUR-IF test
  :THEN exp1 exp2 ...
  :ELSE exp3 exp4 ...)



This does about the same thing as:

(COND (test exp exp ...)
      (T else-exp else-exp ...))



Almost everything is optional in our-if except the test. Here are some
legal forms and their results:

> (our-if (> 3 1) :then 'ok)
OK
> (our-if (< 5 3) :else 'ok)
OK
> (our-if (> 3 1) :else 'oops)
NIL
> (our-if (> 3 1) :then)
NIL
> (our-if (> 3 1) :else 'oops :then 'ok)
OK


Closures (Chapter 12)

Define (make-balance initial-balance) to return a function that takes
0 or 1 arguments. If that function is called with 0 arguments, it
returns the current balance. If called with 1 argument, which should
be a number, it adds that number to the current balance, and returns
the new balance.

> (setq bal (make-balance 100))
<a closure object>
> (funcall bal 10)
110
> (funcall bal -50)
60
> (funcall bal)
60


Modifying list pointers (Chapter 15)

Define (delete-car list) to modify and return list with the first
element of list deleted.

> (setq l '(a b c))
(A B C)
> (delete-car l)
(B C)
> L
(B C)



Note: it's impossible to destructively delete the only item in a list
and turn it into NIL, but delete-car should at least return NIL in
that case.

MAPCAN (Chapter 15)

Define (collect-numbers s-exp) to return a list of all the numbers in
the s-expression s-exp. s-exp may be an atom, a list, or a list of s-
expressions.

> (collect-numbers 1)
(1)
> (collect-numbers 'a)
NIL
> (collect-numbers '(1 (b (2 c) ((3)))))
(1 2 3)



Implement this using a simple conditional, recursion, and MAPCAN.
Letting MAPCAN do some of the work is more efficient than a pure CAR-
CDR recursive solution. Don't worry about duplicate numbers in the
result.

Wilensky, Ex. 15.7 revised

Adding elements to the end of a list is usually inefficient in Lisp:

    (append list (list item)) is the worst possible approach, because
list gets copied every time a new item is added. If you use this form
to build a list N long, you'll have done N squared cons's. Imagine
doing that for a simple 100-element list!
    (nconc list (list item)) doesn't cons, but still gets very slow as
the list gets long, because Lisp has to cdr all the way to the end of
the list in order to find the last cons cell to modify.

A classic solution is to create a data structure called a tconc
structure (for "tail concatenate"), which holds two pointers to the
same list:

    a head pointer to the whole list, and
    a tail pointer to the last cons cell of that list.

With this data structure, you can add new elements to the end of the
list with just a few quick operations, no matter how long the list is,
and you can still get the whole list whenever you need it.

Therefore, your job is to:

    Define (make-tconc [ list ]) to return a tconc structure pointing
to list. If no list is given, a tconc structure for an empty list
should be returned.
    Define (tconc tconc-structure [item item ...]) to add the items,
if any, to the end of the list pointed to by tconc-structure, update
tconc-strcture appropriately, and return the new value of the internal
list.
    Define (tconc-list tconc-structure list ) to add the items in list
to the end of the internal list.

Note that you can get the internal list at any time with (tconc tconc-
structure).

> (setq tc (make-tconc))
<tconc structure>
> (tconc tc 1)
(1)
> (tconc tc 2 3)
(1 2 3)
> (tconc tc)
(1 2 3)



Each successive call to tconc should be efficient, no matter how long
the internal list has grown. One test of your tconc structure is that
it always obeys the following rule:

    (eq (last head-pointer) tail-pointer)

Queues (Chapter 15)

A queue is a standard data structure in computer science, that's very
useful whenever you want to take data in the order in which it occurs.

For example, keystrokes and mouse clicks in an interface need to be
handled in the order in which they occur. If they happen too fast for
the program to keep up, the program should save the unprocessed clicks
in a queue until it can get to them.

Once you've done the tconc exercise, defining queue functions is easy:

    Define (make-queue [list]) to create a queue data structure,
initialized to the elements of list.
    Define (enqueue item queue) to add the item to the end of the
queue.
    Define (dequeue queue) to remove the first item from the queue and
return it. If the queue is empty, nil is returned.

list-of (an advanced macro)

[ Inspired by Guy Lapalme's article in Lisp Pointers, Apr-Jun 91 ]

list-of is macro that simplifies collecting lists of values of
expressions. Though this description is long, and the macro is
powerful, it's actually quite simple and can be implemented in less
than half a page of code.

The general syntax is

    (LIST-OF exp generator-or-filter generator-or-filter ...)

It's easiest to explain by starting with simple examples.

    > (list-of (1+ x) (x :in '(1 2 3)))
    (2 3 4)


exp is (1+ x) and (x :in '(1 2 3)) is a generator. A generator is
anything that has the form (variable :in list). This generator
generates three values for x, namely 1, 2, and 3. list-of returns a
list of the value of (1+ x) for those three values of x.

    > (list-of (1+ x) (x :in '(1 2 3)) (oddp x))
    (2 4)


The exp is simply the variable x, the generator is as before, and
(oddp x) is a filter. A filter is any expression that doesn't look
like a generator. The filter says "keep only those values of x that
are odd." Hence, list-of only collects values for x equal to 1 and 3.

That's it. Any number of generators and filters can be given. They are
applied from left to right. If there are two generators, the second
repeats itself for every value created by the first, e.g.,

    > (setq l '(a b))
    (A B)
    > (list-of (list x y) (x :in l) (y :in ))
    ((A A) (A B) (B A) (B B))


Likewise, the filters apply in order.

    > (setq l '(1 2 3 4))
    (1 2 3 4)
    > (list-of (list x y) (x :in l) (oddp x) (y :in l) (evenp y))
    ((1 2) (1 4) (3 2) (3 4))


This collects (list x y) for every x in l that is odd and every y in l
that is even. Notice that

    > (list-of (list x y) (x :in l) (y :in l) (oddp x) (evenp y))
    ((1 2) (1 4) (3 2) (3 4))


returns the same answer, but does more work. Trace oddp to see the
difference.

One special case that follows naturally:

    (list-of exp) simply returns a list of exp.

Our final examples are primarily for hard-core computer science types.
You can skip them if you wish. Neither are particularly efficient, but
they show the power of list-of.

To define a function that gets all the permutations of a list:

    (defun perms (l)
      (if (endp l)
          (list '())
          (list-of (cons a p)
             (a :in l)
             (p :in (perms (remove a l :count 1))))))


The list-of collects "(cons a p) for every a in l and every p in the
permutations of l with a removed."

To define a form of quicksort function:

    (defun qsort (l)
      (if (endp l)
          '()
          (let ((a (car l)) (x (cdr l)))
            (append (qsort (list-of (y :in x) (< y a)))
                    (list a)
                    (qsort (list-of (y :in x) (>= y a)))))))


This splits l into those elements that are less than the car of l, and
those that are greater, sorts each sublist recursively, and joins the
results
\end{verbatim}

\begin{verbatim}
http://web.archive.org/web/20010911002454/http://www.cs.nwu.edu/academics/courses/c25/exercises/macro-exs.html
Macro Exercises

defrule - a simple rule definer

Define the macro defrule. The calling format is

(defrule name
  test test test ...
  => action action action)



where test's and action's are expressions. This defines a rule called
name.

Define the function run-rule to take a rule name and "run" it. Running
a rule is the same as evaluating

(when (and test test test ...)
  action action action ...)



Example:

(defrule watch-for-vacuum
  (= *air-supply* 0)
  => (format t "Hold your breath!"))

> (setq *air-supply* 0)
> (run-rule 'hate-vacuum)
Hold your breath!
NIL



There should be no eval's anywhere in your code. Hint: see the
discussion of thunks on page 46 of AI Programming.
with-output-to-list

Common Lisp has a nice special form for building strings, called with-
ouput-to-string. The with-output-to-list macro adds similar
functionality to list building. It's calling format is

(with-output-to-list (fn-name [variable])
 expression expression ...)



This evaluates the expressions with fn-name bound temporarily to a
function that takes zero or more arguments, efficiently adds them to
the end of the list in variable, and returns the current value of the
list. The value of the last expression is returned. Hint: read about
the built-in special form flet.

As with with-output-to-string, if variable is omitted, fn-name adds
its arguments to a new empty list, and with-output-to-list returns the
final value of that list, rather than the value of the last
expression. Here are two examples:

> (with-output-to-list (collect)
    (dolist (x '(1 2 3 4))
      (when (oddp x) (collect x))))
(1 3)

> (setq *l* '(a b))

> (with-output-to-list (collect *l*)
    (dolist (x '(1 2 3 4))
      (when (oddp x) (collect x))))
nil

> *l*
(a b 1 3)



To be efficient, with-output-to-list should expand into code that uses
the tconc approach to list building (Wilensky, Common LispCraft, Chap
15, Exercise 7, and the file list.exs in the c25/exercises area). You
should expect to generate fairly different expansions for the
"variable given" and "variable omitted" cases.
list-of - a simple iterator

list-of has the following general calling format:

(list-of expression form form ...)



where form is either a generator or a filter. A generator is a list of
the form (variable :in expression). A filter is any expression that is
not a generator. Generators generate values, and filters accept
certain values (by returning true). There can be any number of
generators and filters in any order.

list-of makes a list of all the values of expression created by the
generators and accepted by the filters.

list-of is best explained with a series of examples:

(list-of x)
    returns a list of the value of x. There are no generators or
filters.
(list-of x (x :in l) (oddp x))
    returns "a list of those x's, where x is in l and x is odd."
(list-of (* x x) (x :in l))
    returns "a list of the square's of x, where x is in l."
(list-of (* x y) (x :in l) (y :in l))
    returns "a list of the products of x and y, where x and y are in
l." For example, if l = (2 3), this would multiply 2 x 2, 2 x 3, 3 x
2, and 3 x 3, and return (4 6 6 9).
(list-of (* x y) (x :in l) (oddp x) (y :in l))
    returns "a list of the products of x and y, where x and y are in l
and x is odd." For example, if l = (2 3), this would multiply 3 x 2,
and 3 x 3, and return (6 9).

This may seem complicated, but in fact list-of can be defined in half
a dozen lines, or so. The first expression is put inside a call to
list, each filter expands into (when filter ...), each generator
expands into (mapcan #'(lambda (var) ...) list), and everything nests
recursively. The expansions of the above examples are, respectively:

(list x)

(mapcan #'(lambda (x)
           (when (oddp x)
            (list x)))
        l)

(mapcan #'(lambda (x)
           (list (* x x)))
        l)

(mapcan #'(lambda (x)
           (mapcan #'(lambda (y)
                      (list (* x y)))
                   l))
        l)

(mapcan #'(lambda (x)
           (when (oddp x)
            (mapcan #'(lambda (y)
                       (list (* x y)))
                    l)))
        l)



Hint: the best way to handle recursive macros is to define a recursive
"expander" function, i.e.,

(defmacro list-of (exp &rest forms)
  (expand-list-of exp forms))



expand-list-of is just a normal function that returns the expansion of
a list-of call. The nice thing about it is that it can call itself
recursively, something that can be messy to do with macros.
\end{verbatim}

I dont know if they are necessary for the context of the operation of
the comprehensions macro that I cant get to work in elisp.

The original is below but the indentation does not match the original,
nor the paren matching in the last two defuns. I tried helping myself
by various google and groups searches but if there was any
satisfactory reply, it missed my results.

(defmacro comp ((e &rest qs) 12)
  (if (null qs) '(cons ,e ,12)          ; rule A
    (let ((q1 (car qs))
          (q (cdr qs)))
      (if (not(eq (cadr q1) '<-))       ; a generator?
          '(if ,ql (comp (,e ,@q),12) ,12) ; rule B
        (let ((v (car ql))              ; rule C
              (l1 (third q))
              (h (gentemp "H-"))
              (us (gentemp "US-"))
              (usl (gentemp "US1-")))
          '(labels ((,h (,us)           ; corresponds to a letrec
                        (if (null ,us) ,12
                          (let ((,v (car ,us))
                                (,usl (cdr ,us)))
                            (comp (,e ,@q) (,h ,us1))))))
             (,h ,l1)))))))


(defun open-bracket (stream ch)
  (do ((l nil)
       (c (read stream t nil t)(read stream t nil t)))
      ((eq c '|]|) '(comp ,(reverse l) ()))
  (push c l))
)

(defun closing-bracket (stream ch) '|]|)

(eval-when (compile load eval)
  (set-macro-character #\[ #'open-bracket)
  (set-macro-character #\] #'closing-bracket))


R