[quiz] A (hopefully) working solution

[Pablo Barenbaum]

A solution that seems to work =)

- it ignores blank lines
- it ignores comments starting with ;
- it expects the !# to be alone in a single line
- it gets screwed up with multiline strings and #| ... |# comments,
  and possibly with most extensions to the reader
- I keep overusing format and loop =b

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar *blanks* '(#\Space #\Tab #\Newline #\Return))
(defvar *tabs* '(#\Tab))
(defvar *comment-markers* `(#\;))
(defvar *tab-width* 8)

(defun width (char)
  (if (member char *tabs*)
    *tab-width*
    1))

(defun distance (str)
 (do ((col 0 (+ col (width (aref str col)))))
   ((not (member (aref str col) *blanks* :test #'char=))
    col)))

(defun trim-blanks (str)
  (string-trim *blanks* str))

(defun blank-line-p (str)
 (let ((trimmed (trim-blanks str)))
   (or (string= "" trimmed)
       (member (aref trimmed 0) *comment-markers* :test #'char=))))

(defun last-line-p (line)
 (or (eq line 'eof) (string= (trim-blanks line) "!#")))

(defun read-off-side-to-string (stream)
 (let ((prev-lines (list (list "PROGN")))
       (prev-dists (list -1))
       (prev-dist -1))
   (flet ((pop-expr ()
            (let* ((tail (pop prev-lines))
                   (head (pop (first prev-lines))))
              (push
                (format nil "(~A~%~{~A~%~})" head (nreverse tail))
                (first prev-lines))))
          (next-line ()
	   (loop for line = (read-line stream nil 'eof)
                   while (and (not (eq line 'eof)) (blank-line-p line))
                   finally (return line))))
     (with-output-to-string (s)
       (loop
         for line = (next-line)
         while (not (last-line-p line))
         do (let ((dist (distance line)))
              (when (> dist prev-dist)
                (push dist prev-dists)
                (push (list) prev-lines))
              (loop while (and (not (null (cdr prev-dists)))
                               (< dist (car prev-dists)))
                    do (pop prev-dists)
                    do (pop-expr))
              (push line (first prev-lines))
              (setf prev-dist dist)))

       (loop while (not (null (cdr prev-dists)))
             do (pop prev-dists)
             do (pop-expr))
       (format s "~{~A~%~}" (nreverse (pop prev-lines)))))))

(defun read-off-side (stream c n)
  (let ((r (nth-value 0 (read-from-string (read-off-side-to-string stream)))))
    (if (atom r)
      (list r)
      r)))