(defconstant cube-limits
(let ((table (make-hash-table)))
(setf (gethash 'red table) 12)
(setf (gethash 'green table) 13)
(setf (gethash 'blue table) 14)
table))
(defun check-limit (draw)
(block s
(loop for colour being each hash-key in draw using (hash-value count)
do (let ((limit (gethash colour cube-limits)))
(if (> count (or limit 0))
(return-from s nil))))
T))
(defstruct tokenizer
(source nil :type string)
(position 0 :type integer))
(defmacro check-ranges (qe &rest bounds)
(let ((qry (gensym)) (last-bound nil) (in-range nil) (node-stack nil))
(dolist (bound bounds)
(if (and node-stack in-range (eq bound last-bound)
(not (eq nil last-bound)))
(progn
(setf in-range nil)
(setf (car node-stack) `(if (= ,qry ,bound) t nil)))
(let ((new-node
(if in-range
`(if (<= ,qry ,bound)
t
nil)
`(if (< ,qry ,bound)
nil
t))))
(setf last-bound bound)
(push new-node node-stack)
(setf in-range (not in-range)))))
(let ((node nil))
(loop for new-node = (pop node-stack)
while new-node
do (setf node
(if node
(append
(subseq new-node 0 3)
(list node)
(subseq new-node 4))
new-node)))
`(let ((,qry ,qe))
,node))))
(defun is-space (the-char)
(check-ranges (char-code the-char) 9 13 32 32 160 160 5760 5760 8192 8202
8239 8239 8287 8287 12288 12288))
(defun skip-whitespace (toks)
(loop while (and
(< (tokenizer-position toks) (length (tokenizer-source toks)))
(is-space
(aref (tokenizer-source toks) (tokenizer-position toks))))
do (incf (tokenizer-position toks))))
(defun next-token (toks)
(skip-whitespace toks)
(when (< (tokenizer-position toks) (length (tokenizer-source toks)))
(let*
((ix (tokenizer-position toks))
(alf (alphanumericp (aref (tokenizer-source toks) ix))))
(loop
while (and (< ix (length (tokenizer-source toks)))
(let ((cc (aref (tokenizer-source toks) ix)))
(and
(not (is-space cc))
(eq alf (alphanumericp cc)))))
do (incf ix))
(prog1
(subseq (tokenizer-source toks) (tokenizer-position toks) ix)
(setf (tokenizer-position toks) ix)))))
(defun parse-line (line)
(let ((toks (make-tokenizer :source line))
(game-number nil)
(current-grab (make-hash-table))
(grabs nil))
(unless (equalp "Game" (next-token toks))
(warn "Input line doesn't begin with \"Start\""))
(setf game-number (parse-integer (next-token toks)))
(unless (equalp ":" (next-token toks))
(warn "Missing colon"))
(loop for count = (let ((tok (next-token toks)))
(if tok
(parse-integer tok)))
for colour = (intern (string-upcase (next-token toks)))
while (and count colour)
do (setf (gethash colour current-grab) count)
(unless (equalp "," (next-token toks))
(push current-grab grabs)
(setf current-grab (make-hash-table))))
(cons game-number (reverse grabs))))
(defun all (predicate values)
(dolist (value values)
(unless (funcall predicate value)
(return-from all nil)))
t)
(defun process-file (instream)
(format t "~a~%" (loop for line = (read-line instream nil)
while line
sum (if (equalp line "")
0
(let ((game (parse-line line)))
(if (all #'check-limit (cdr game))
(car game)
0))))))
(defun main ()
(loop for arg in (cdr *posix-argv*)
do (with-open-file (s arg :direction :input)
(process-file s))))