(defvar *prog-input*)

;;; After running file, if you enter a blank line, code will work on each
;;; line of input, until "end" is typed.
;;; Otherwise, the input is taken as a filename and code will be executed
;;; over each line in the file until EOF.
(let ((ui (read-line)))
  (if (equal ui "")
    (setq *prog-input* *standard-input*)
    (setq *prog-input* (open ui))))

(let
  ((inpt (read-line *prog-input* NIL)) (i 1) (stacks '(())) (si 0))

  (loop until (char= (char inpt 1) #\1) do
        (loop until (>= i (length inpt)) do
              (if (<= (length stacks) si)
                (setq stacks (append stacks (list NIL NIL) ))) ; ZERO idea why I can't just append '(())

              (if (not (char= (char inpt i) #\Space))
                (setf (nth si stacks) (append (nth si stacks) (list (char inpt i)))))

              (setq si (+ si 1) i (+ i 4)))

        (setq i 1 si 0)
        (setq inpt (read-line *prog-input* NIL)))

  (read-line *prog-input* NIL)

  (setq inpt (read-line *prog-input* NIL))
  (loop until (or (string= inpt "end") (not inpt)) do
        (setq si (- (parse-integer inpt :junk-allowed T :start (position #\Space inpt :start (position #\f inpt))) 1))
        (setq  i (- (parse-integer inpt :junk-allowed T :start (position #\Space inpt :start (position #\t inpt))) 1))

        (dotimes (x (parse-integer inpt :junk-allowed T :start (position #\Space inpt)))
          (push (pop (nth si stacks)) (nth i stacks)))

        (setq inpt (read-line *prog-input* NIL)))

  (loop for x in stacks do
        (prin1 (car x))))

(if (not (eq *prog-input* *standard-input*))
  (close *prog-input*))