infix: Overhaul the readtable installer.
authorMark Wooding <mdw@distorted.org.uk>
Sat, 13 May 2006 00:19:59 +0000 (01:19 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Sat, 13 May 2006 00:19:59 +0000 (01:19 +0100)
Let it cope properly with different start and end characters (including
marking the end character as a terminating macro), and be willing to
install as a dispatching macro character if requested.  Also changed
the defaults to {...}, since these are explicitly reserved, and look
appropriate.

infix.lisp

index 5cdd0b9..ea78422 100644 (file)
       (unless (eq *token* delim)
        (error "expected ~S; found ~S" delim *token*)))))
 
-(defun install-infix-reader (&optional (char #\$))
-  "Installs a macro character `$ INFIX...  $' for translating infix notation
+(defun install-infix-reader
+    (&optional (start #\{) (end #\}) &key dispatch (readtable *readtable*))
+  "Installs a macro character `{ INFIX... }' for translating infix notation
    to Lisp forms.  You also want to (use-package :infix-keywords) if you do
    this."
-  (let ((delim (intern (string #\$) 'infix-keywords)))
-    (set-macro-character char (lambda (stream ch)
-                               (declare (ignore ch))
-                               (read-infix stream :delim delim)))))
+  (let ((delim (intern (string end) 'infix-keywords)))
+    (flet ((doit (stream &rest noise)
+            (declare (ignore noise))
+            (read-infix stream :delim delim)))
+      (if dispatch
+         (set-dispatch-macro-character dispatch start #'doit readtable)
+         (set-macro-character start #'doit nil readtable))
+      (unless (or (eql start end)
+                 (multiple-value-bind
+                     (func nontermp)
+                     (get-macro-character end readtable)
+                   (and func (not nontermp))))
+       (set-macro-character end (lambda (noise)
+                                  (declare (ignore noise))
+                                  (error "Unexpected `~C'." end))
+                            nil readtable)))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Testing things.