r11859: Canonicalize whitespace
[lml2.git] / read-macro.lisp
index 8e97b9d4cbb72a05cdb27d600781126a3c2ce4ff..0e173ebdbbb66547d757907ba59f7b3e55ce26a5 100644 (file)
   #'(lambda (stream char)
       (declare (ignore char))
       (let ((forms '())
-           (curr-string (new-string))
-           (paren-level 0)
-           (got-comma nil))
-       (declare (type fixnum paren-level))
-       (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
-           ((eql ch #\]))
-         (if got-comma
-             (if (eql ch #\()
-                 ;; Starting top-level ,(
-                 (progn
-                   #+cmu
-                   (setf curr-string (coerce curr-string `(simple-array character (*))))
-       
-                   (push `(lml2-princ ,curr-string) forms)
-                   (setq curr-string (new-string))
-                   (setq got-comma nil)
-                   (vector-push #\( curr-string)
-                   (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
-                       ((and (eql ch #\)) (zerop paren-level)))
-                     (when (eql ch #\])
-                       (format *trace-output* "Syntax error reading #\]")
-                       (return nil))
-                     (case ch
-                       (#\(
-                        (incf paren-level))
-                       (#\)
-                        (decf paren-level)))
-                     (vector-push-extend ch curr-string))
-                   (vector-push-extend #\) curr-string)
-                   (let ((eval-string (read-from-string curr-string))
-                         (res (gensym)))
-                     (push
-                      `(let ((,res ,eval-string))
-                         (when ,res
-                           (lml2-princ ,res)))
-                      forms))
-                   (setq curr-string (new-string)))
-               ;; read comma, then non #\( char
-               (progn
-                 (unless (eql ch #\,)
-                   (setq got-comma nil))
-                 (vector-push-extend #\, curr-string) ;; push previous command
-                 (vector-push-extend ch curr-string)))
-           ;; previous character is not a comma
-           (if (eql ch #\,)
-               (setq got-comma t)
-             (progn
-               (setq got-comma nil)
-               (vector-push-extend ch curr-string)))))
+            (curr-string (new-string))
+            (paren-level 0)
+            (got-comma nil))
+        (declare (type fixnum paren-level))
+        (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
+            ((eql ch #\]))
+          (if got-comma
+              (if (eql ch #\()
+                  ;; Starting top-level ,(
+                  (progn
+                    #+cmu
+                    (setf curr-string (coerce curr-string `(simple-array character (*))))
 
-       #+cmu
-       (setf curr-string (coerce curr-string `(simple-array character (*))))
-       
-       (push `(lml2-princ ,curr-string) forms)
-       `(progn ,@(nreverse forms)))))
+                    (push `(lml2-princ ,curr-string) forms)
+                    (setq curr-string (new-string))
+                    (setq got-comma nil)
+                    (vector-push #\( curr-string)
+                    (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
+                        ((and (eql ch #\)) (zerop paren-level)))
+                      (when (eql ch #\])
+                        (format *trace-output* "Syntax error reading #\]")
+                        (return nil))
+                      (case ch
+                        (#\(
+                         (incf paren-level))
+                        (#\)
+                         (decf paren-level)))
+                      (vector-push-extend ch curr-string))
+                    (vector-push-extend #\) curr-string)
+                    (let ((eval-string (read-from-string curr-string))
+                          (res (gensym)))
+                      (push
+                       `(let ((,res ,eval-string))
+                          (when ,res
+                            (lml2-princ ,res)))
+                       forms))
+                    (setq curr-string (new-string)))
+                ;; read comma, then non #\( char
+                (progn
+                  (unless (eql ch #\,)
+                    (setq got-comma nil))
+                  (vector-push-extend #\, curr-string) ;; push previous command
+                  (vector-push-extend ch curr-string)))
+            ;; previous character is not a comma
+            (if (eql ch #\,)
+                (setq got-comma t)
+              (progn
+                (setq got-comma nil)
+                (vector-push-extend ch curr-string)))))
+
+        #+cmu
+        (setf curr-string (coerce curr-string `(simple-array character (*))))
+
+        (push `(lml2-princ ,curr-string) forms)
+        `(progn ,@(nreverse forms)))))