anaphora.lisp: Rewrite `asetf' to use `with-places/gensyms'.
[lisp] / infix.lisp
index 9c77afe..ff5a3c9 100644 (file)
 ;;; it under the terms of the GNU General Public License as published by
 ;;; the Free Software Foundation; either version 2 of the License, or
 ;;; (at your option) any later version.
-;;; 
+;;;
 ;;; This program is distributed in the hope that it will be useful,
 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;;; GNU General Public License for more details.
-;;; 
+;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 ;;;--------------------------------------------------------------------------
 ;;; The tokenizer.
 
-(defconstant eof (cons :eof nil)
-  "A magical object which `get-token' returns at end-of-file.")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (let ((value (cons :eof nil)))
+    (unless (and (boundp 'eof)
+                (equal (symbol-value 'eof) value))
+      (defconstant eof (cons :eof nil)
+       "A magical object which `get-token' returns at end-of-file."))))
 
 (defun default-get-token ()
   "Read a token from *stream* and store it in *token*."
    the value stack."
   `(progn
      (setf (get ',op ',kind)
-           (lambda () ,@body))
+          (lambda () ,@body))
     ',op))
 
 (defmacro definfix (op prec &body body)
   (let ((stuff nil))
     (loop
       (unless (symbolp *token*)
-        (error "expected symbol; found ~S" *token*))
+       (error "expected symbol; found ~S" *token*))
       (push *token* stuff)
       (get-token)
       (unless (delim '|,| nil)
   (pushval `(loop ,@(strip-progn (parse-infix 0)))))
 
 (defopfunc bind operand
-  (labels ((loop ()
+  (labels ((loopy ()
            (let ((ids (parse-ident-list))
                  (valform (progn (delim '=) (parse-infix 0)))
                  (body (if (delim '|,| nil)
-                           (loop)
+                           (loopy)
                            (progn
                              (delim 'in)
                              (strip-progn (parse-infix 0))))))
                        `(let ((,(car ids) ,valform)) ,@body)
                        `(multiple-value-bind ,ids ,valform ,@body))))))
     (get-token)
-    (pushval (car (loop)))))
+    (pushval (car (loopy)))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Parsing function bodies and lambda lists.
   (cond ((delim '|(| nil)
         (prog1 (parse-infix) (delim '|)|)))
        (t (prog1 *token* (get-token)))))
-        
+
 (defopfunc lambda operand
   (get-token)
   (pushval `(lambda ,(parse-lambda-list) ,@(strip-progn (parse-infix 0)))))
      (defun foo (x) (- x 6)))
     ("bind x = 3 in x - 2" . (let ((x 3)) (- x 2)))
     ("bind x, y = values(1, 2),
-           z = 3,
-           docs, decls, body = parse-body(body) in complicated" .
+          z = 3,
+          docs, decls, body = parse-body(body) in complicated" .
      (multiple-value-bind (x y) (values 1 2)
        (let ((z 3))
         (multiple-value-bind (docs decls body) (parse-body body)