Nuke trailing spaces; convert tabs to spaces.

1 files changed, 49 insertions, 54 deletions

diff --git a/tail-recursion.lisp b/tail-recursion.lisp
index b963d49..cca24a7 100644
--- a/tail-recursion.lisp
+++ b/tail-recursion.lisp
@@ -28,24 +28,23 @@
 ;;; in which a a label parameter is shadowed, the GOTO will properly
 ;;; initialize the outer variable. It won't blindly assign to the inner
 ;;; variable.
-;;; 
+;;;
 ;;; With this, you can express tail recursion, including mutual tail
 ;;; recursion, with nearly the same syntactic sugar. And it turns into
 ;;; stackless iteration: jumping around within a TAGBODY.
-;;; 
+;;;
 ;;; E.g. in the thread ``better way to enumerate'', viper-2 posted this:
-;;; 
+;;;
 ;;;   (defun enumerate-with-op (start end &optional elist)
 ;;;     (if (> start end)
 ;;;         (reverse elist)
-;;;         (enumerate-with-op (1+ start) end
-;;;                                            (cons start elist))))
-;;; 
+;;;         (enumerate-with-op (1+ start) end (cons start elist))))
+;;;
 ;;; With the ARGTAGS macro, we can write ENUMERATE like this, and not rely
 ;;; on tail recursion optimization:
-;;; 
+;;;
 ;;;   ;; should be called IOTA or some variation thereof
-;;; 
+;;;
 ;;;   (defun enumerate (start end)
 ;;;     (let (result-list)
 ;;;       (argtags nil
@@ -53,41 +52,38 @@
 ;;;         (when (> start end)
 ;;;           (return (nreverse result-list)))
 ;;;         (goto enumerate (1+ start) end (cons start result-list)))))
-;;; 
+;;;
 ;;; Since tail recursion /is/ a freaking goto, damn it, just express it
 ;;; that way! You don't need to write a compiler, and consequently you
 ;;; don't need to duck out of mutual tail recursion because that part of
 ;;; the compiler turns out to be too hard to write.
-;;; 
-;;; Anyone have any interesting mutual tail recursion examples? I'd like
-;;; to try rewriting them using ARGTAGS.
-;;; 
+;;;
 ;;; The implementation of ARGTAGS follows. There is clutter due to error
 ;;; checking, and also due to the handling of the shadowing problem. The
 ;;; strategy is to turn
-;;; 
+;;;
 ;;;  (GOTO L A1 A2 ...)
-;;; 
+;;;
 ;;; into
-;;; 
+;;;
 ;;;  (PROGN (PSETF #:G0100 A1 #:G0101 A2 ...) (GO #:G0001))
-;;; 
+;;;
 ;;; Where #:G0001 is a label within a thunk section that is inserted at
 ;;; the end of the body. The entry in the thunk section looks like this:
-;;; 
+;;;
 ;;;  #:G0001 (PSETF V1 #:G0100 V2 #:G0101 ...) (GO L)
-;;; 
+;;;
 ;;; Where V1 V2 ... are the real variables (parameters of label L).   I.e.
 ;;; we store the arguments into some secret local gensym variables, jump
 ;;; to a thunk, thereby leaving the scope where the real variables might
 ;;; be shadowed, then load the real variables from the secret gensyms and
 ;;; bounce to the real target label.
-;;; 
+;;;
 
 (defmacro argtags (block-name &rest labels-and-forms)
   (unless (symbolp block-name)
     (error "ARGTAGS: block name must be a symbol, not ~a!" block-name))
-  (let (labels forms thunks thunk-gensyms)
+  (let (labels all-vars forms thunks thunk-gensyms)
     (dolist (item labels-and-forms)
       (cond
        ((symbolp item)
@@ -100,10 +96,13 @@
                     (every #'symbolp (rest (rest item))))
          (error "ARGTAGS: bad label syntax ~a in block ~a" item block-name))
        (destructuring-bind (op label &rest vars) item
+            (declare (ignore op))
          (let ((gensyms (mapcar (lambda (var)
                                   (gensym (symbol-name var)))
                                 vars))
                (thunk-label (gensym (symbol-name label))))
+                 (dolist (var vars)
+                   (pushnew var all-vars))
            (push `(,label ,vars ,gensyms ,thunk-label) labels)
            (push thunk-label thunks)
            (push
@@ -129,22 +128,21 @@
                          (error "ARGTAGS: label ~a caled with wrong argument count in block ~a"
                                 label ',block-name))
                        `(progn
-                          ,@(if args `((psetf ,@(mapcan (lambda (gensym arg) 
-							  `(,gensym ,arg))
+                          ,@(if args `((psetf ,@(mapcan (lambda (gensym arg)
+                                                          `(,gensym ,arg))
                                                          gensyms args))))
                           (go ,thunk-label))))))
        (block ,block-name
-         (let (,@thunk-gensyms)
+         (let (,@thunk-gensyms ,@all-vars)
            (tagbody
              ,@(nreverse forms)
              (return-from ,block-name)
              ,@(nreverse thunks)))))))
 
-
 ;;;
 ;;; TLET
 ;;; ====
-;;; 
+;;;
 ;;; (Thanks to Klaus Harbo for some fixes. to the original version
 ;;; which was called TAILPROG).
 ;;;
@@ -160,19 +158,16 @@
 ;;;;
 
 (defmacro tlet (pseudo-funcs &rest forms)
-   (let (argtags-forms macrolet-elems var-list)
+   (let (argtags-forms macrolet-elems)
      (dolist (pfunc pseudo-funcs)
        (destructuring-bind (name vars &rest forms) pfunc
          (push `(label ,name ,@vars) argtags-forms)
          (push `(return (progn ,@forms)) argtags-forms)
-         (push `(,name (&rest args) `(goto ,',name ,@args)) macrolet-elems)
-         (dolist (var vars)
-           (push var var-list))))
+         (push `(,name (&rest args) `(goto ,',name ,@args)) macrolet-elems)))
      `(macrolet ,(reverse macrolet-elems)
-        (let ,var-list
-          (argtags nil
-                   (return (progn ,@forms))
-                   ,@(reverse argtags-forms))))))
+        (argtags nil
+                 (return (progn ,@forms))
+                 ,@(reverse argtags-forms)))))
 
 ;;;
 ;;; DEFTAIL
@@ -187,12 +182,12 @@
 ;;; ordinary code as an ordinary function call.  It distinguishes whether it
 ;;; was called in this ordinary way, or whether it was called from another
 ;;; tail block through the tail dispatch loop.
-;;; 
+;;;
 ;;; The tail call mechanism is hidden behind a function called TAIL-CALL,
 ;;; whose interface and semantics are similar to FUNCALL. The difference is
 ;;; that when TAIL-CALL is invoked from a tail block, it causes that tail
 ;;; block to terminate before the call takes place.
-;;; 
+;;;
 ;;; The basic idea is that when a tail block (that is implemented as a
 ;;; function) calls another tail block, it is being permanently exited (goto
 ;;; semantics, the tail call does not return).  Therefore the underlying
@@ -208,7 +203,7 @@
 ;;; calls the function. When functions mutually recurse, they do so by
 ;;; bailing out dynamically to a dispatching loop which calls the next
 ;;; function in the chain.
-;;; 
+;;;
 ;;; It would be inconvenient to have to use TAIL-CALL everywhere in a tail
 ;;; block.  We can hide the tail call mechanism behind lexical functions, so
 ;;; that a tail block can use ordinary function call syntax to call its
@@ -219,19 +214,19 @@
 ;;; arguments have to be specially treated with the use of TAIL-CALL
 ;;; insteadof FUNCALL. (FUNCALL will work too, of course, but it will
 ;;; not terminate the tail block and so the call won't be a tail call).
-;;; 
+;;;
 ;;; A very simple test case illustrates the syntax: DEFTAIL instead of
-;;; DEFUN, and an optional (:OTHER-TAILS ...) at the beginning (may 
+;;; DEFUN, and an optional (:OTHER-TAILS ...) at the beginning (may
 ;;; be mixed among declarations).
-;;; 
+;;;
 ;;; (deftail even (num)
 ;;;   (:other-tails odd)
 ;;;   (if (zerop num) t (odd (1- num))))
-;;; 
+;;;
 ;;; (deftail odd (num)
 ;;;   (:other-tails even)
 ;;;   (if (zerop num) nil (even (1- num))))
-;;; 
+;;;
 ;;; This is still a GOTO-like abstraction, because tail calls are tail
 ;;; calls even if they are not in a tail position. They never return,
 ;;; just like in TLET.
@@ -255,8 +250,8 @@
 (defmacro deftail (name lambda-list &body body)
   (let ((escape (gensym "ESCAPE-"))
         (other-tails `(,name))
-	(anon-block (gensym))
-	(docstring)
+        (anon-block (gensym))
+        (docstring)
         (decls))
     (when (stringp (first body))
       (setf docstring (list (first body)))
@@ -272,13 +267,13 @@
        ,@docstring
        ,@decls
        (block ,anon-block
-	 (flet (,@(loop for other in other-tails
-			collecting `(,other (&rest args)
-				      (return-from ,anon-block
-					 (let ((*tail-escape* ,escape))
-					   (tail-call #',other args)))))
-		 (tail-call (fun args)
-		   (let ((*tail-escape* ,escape))
-		     (tail-call fun args))))
-	   (let ((*tail-escape* nil))
-	     ,@body))))))
+         (flet (,@(loop for other in other-tails
+                        collecting `(,other (&rest args)
+                                      (return-from ,anon-block
+                                         (let ((*tail-escape* ,escape))
+                                           (tail-call #',other args)))))
+                 (tail-call (fun args)
+                   (let ((*tail-escape* ,escape))
+                     (tail-call fun args))))
+           (let ((*tail-escape* nil))
+             ,@body))))))