[quiz] [SPOILER] Quiz #2

[Ivan Boldyrev]

I can't run test because FiveAM from Gentoo portage (1.2.3) has no
FOR-ALL (or is it from other package?).  But I tested it manually.

----------------------------------------------------------------------
;;; Copyright (C) 2006 Ivan Boldyrev
;;;    This code is freely redistributable.

(cl:defpackage #:quiz2
  (:use #:cl))

(cl:in-package #:quiz2)

(defvar *stack* nil
  "Stack for parsed objects")

(defun tab-ws (pos)
  #-dont-blame-tabspace(warn "Tabular is found at pos ~S" pos)
  (* 8 (floor (+ pos 8) 8)))

(defun count-ws (input-stream)
  (loop :for cnt := 0 :then (case char
                              ((#\Space)
                               (1+ cnt))
                              ((#\Tab)
                               (tab-ws cnt))
                              ((#\Return #\Linefeed)
                               ;; Space-only line!  Just ignore it
                               (return-from count-ws
                                 (count-ws input-stream)))
                              (otherwise
                               (unread-char char input-stream)
                               (return-from count-ws
                                 cnt)))
        :for char := (read-char input-stream)))

(defun combine-lines (first rest)
  (cons first (nreverse rest)))

(defun reduce-forms (offset)
  (let ((tail (cdr (pop *stack*))))
    (if (> offset (car (first *stack*)))
        (push (list offset (nreverse tail))
              *stack*)
        (let ((first (pop (cdr (first *stack*)))))
          (progn (push (combine-lines first tail)
                       (cdr (first *stack*)))
                 *stack*)))))

(defun read-the-line (input-stream)
  (let ((space-offset (count-ws input-stream))
        (data (read-preserving-whitespace input-stream)))
    ;; Perform all reductions
    (loop :while (and (rest *stack*)
                      (< space-offset (car (first *stack*))))
          :do (reduce-forms space-offset))
    (cond
      ((and (symbolp data)
            (string= (symbol-name data) "!#"))
       (throw 'thats-all-folks
         (cons 'progn (loop :while (rest *stack*)
                            :do (reduce-forms 0)
                            :finally
                            (return (nreverse (cdr (first *stack*))))))))
      ((and *stack*
            (= space-offset (car (first *stack*))))
       (push data (cdr (first *stack*)))
       *stack*)
      (t
       (push (cons space-offset (list data))
             *stack*)))))

(defun read-off-side (stream subchar parameter)
  (declare (ignore subchar parameter))
  (let ((*stack* nil))
    ;; Catch is duty hack here.  Do not repeat at home!
    (catch 'thats-all-folks
      (loop
       (read-the-line stream)))))
----------------------------------------------------------------------

-- 
Ivan Boldyrev

                      Ok people, move along, there's nothing to see here.