# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1544910749 18000
# Node ID 75998992ab3ccd16618283cf48db985205380f6c
# Parent  e3e015ad324ca574153f88fd0aab624a753ecc37
The Great Packaging

diff -r e3e015ad324c -r 75998992ab3c .hgignore
--- a/.hgignore	Mon Dec 10 00:51:46 2018 -0500
+++ b/.hgignore	Sat Dec 15 16:52:29 2018 -0500
@@ -10,3 +10,4 @@
 data
 scratch.lisp
 digraph.png
+lisp.prof
diff -r e3e015ad324c -r 75998992ab3c advent.asd
--- a/advent.asd	Mon Dec 10 00:51:46 2018 -0500
+++ b/advent.asd	Sat Dec 15 16:52:29 2018 -0500
@@ -1,3 +1,14 @@
+(defclass auto-module (module) ())
+
+(defmethod component-children ((self auto-module))
+  (mapcar (lambda (p) (make-instance 'cl-source-file :type "lisp"
+                        :pathname p
+                        :name (pathname-name p)
+                        :parent (component-parent self)))
+          (directory-files (component-pathname self)
+                           (make-pathname :directory nil :name *wild* :type "lisp"))))
+
+
 (asdf:defsystem :advent
   :description "Advent of Code solutions"
 
@@ -7,6 +18,8 @@
 
   :depends-on (
 
+               :1am
+               :alexandria
                :cl-digraph
                :cl-digraph.dot
                :cl-interpol
@@ -26,8 +39,7 @@
                (:file "package")
                (:module "src" :serial t
                 :components ((:file "utils")
-                             (:module "2017" :serial t
-                              :components ((:file "number-spiral")
-                                           (:file "main")))
-                             (:module "2018" :serial t
-                              :components ((:file "main")))))))
+                             #+later (:module "2017" :serial t
+                                      :components ((:file "number-spiral")
+                                                   (:file "main")))
+                             (:auto-module "2018")))))
diff -r e3e015ad324c -r 75998992ab3c package.lisp
--- a/package.lisp	Mon Dec 10 00:51:46 2018 -0500
+++ b/package.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -1,3 +1,46 @@
 (defpackage :advent
-  (:use :cl :losh :iterate :advent.quickutils))
+  (:use :cl :losh :iterate :advent.quickutils)
+  (:export
+    :define-problem
+
+    :read-all
+    :read-lines
+    :read-lines-of-numbers-and-garbage
+
+    :ensure-string
+    :ensure-stream
+
+    :char-invertcase
+    :emptyp
+    :extremum+
+    :extremums
+    :hamming-distance
+    :hash-table=
+    :integral-range
+    :manhattan-distance
+    :manhattan-neighbors
+    :nth-digit
+    :unique
 
+    :ring
+    :ring-prev
+    :ring-next
+    :ring-data
+    :map-ring
+    :do-ring
+    :ring-list
+    :ring-length
+    :ring-move
+    :ring-insert-after
+    :ring-insert-before
+    :ring-cutf
+    :ring-prevf
+    :ring-nextf
+    :ring-cutf
+    :ring-movef
+    :ring-insertf-after
+    :ring-insertf-before
+
+    ))
+
+(defparameter *advent-use* '(:use :cl :losh :iterate :advent :advent.quickutils))
diff -r e3e015ad324c -r 75998992ab3c src/2015/2015.lisp
--- a/src/2015/2015.lisp	Mon Dec 10 00:51:46 2018 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,898 +0,0 @@
-; https://bitbucket.org/sjl/beef
-(ql:quickload "beef")
-(ql:quickload "alexandria")
-(ql:quickload "split-sequence")
-(ql:quickload "cl-arrows")
-(ql:quickload "fset")
-(ql:quickload "cl-ppcre")
-(ql:quickload "ironclad")
-(ql:quickload "smug")
-(ql:quickload "bit-smasher")
-(ql:quickload "optima")
-
-(defpackage #:advent
-  (:use #:cl)
-  (:use #:cl-arrows)
-  (:use #:split-sequence)
-  (:use #:smug))
-
-(in-package #:advent)
-
-(declaim (optimize (debug 3)))
-
-;;;; Day 1
-(defun instruction-to-num (ch)
-  (cond
-    ((eql ch #\() 1)
-    ((eql ch #\)) -1)
-    (t 0)))
-
-(defun advent-1-1 ()
-  (loop :for c :across (beef:slurp "data/1")
-        :sum (instruction-to-num c)))
-
-(defun advent-1-2 ()
-  (loop :for c :across (beef:slurp "data/1")
-        :sum (instruction-to-num c) :into floor
-        :sum 1
-        :until (= floor -1)))
-
-
-;;;; Day 2
-(defun advent-2-data ()
-  (->> (beef:slurp "data/2")
-       beef:trim-whitespace-right
-       beef:split-lines
-       (mapcar (lambda (s)
-                 (->> s
-                      (split-sequence #\x)
-                      (mapcar #'parse-integer))))))
-
-(defun advent-2-1 ()
-  (loop :for dims :in (advent-2-data)
-        :for (w h l) = dims
-        :for sides = (list (* w h)
-                           (* w l)
-                           (* h l))
-        :for paper = (* 2 (apply #'+ sides))
-        :for slack = (apply #'min sides)
-        :sum (+ paper slack)))
-
-(defun advent-2-2 ()
-  (loop :for dims :in (advent-2-data)
-        :for (w h l) = dims
-        :for sides = (list (* 2 (+ w h))
-                           (* 2 (+ w l))
-                           (* 2 (+ h l)))
-        :for ribbon = (apply #'min sides)
-        :for bow = (apply #'* dims)
-        :sum (+ ribbon bow)))
-
-
-;;;; Day 3
-(defun advent-3-data ()
-  (beef:trim-whitespace (beef:slurp "data/3")))
-
-(defun instruction-to-offsets (instruction)
-  (case instruction
-    (#\> '(1 0))
-    (#\< '(-1 0))
-    (#\^ '(0 1))
-    (#\v '(0 -1))))
-
-(defun step-santa (loc dir)
-  (destructuring-bind (x y) loc
-    (destructuring-bind (dx dy) (instruction-to-offsets dir)
-      (list (+ x dx) (+ y dy)))))
-
-(defun houses (data)
-  (loop
-    :with loc = '(0 0)
-    :with visited = (fset:set '(0 0))
-    :for dir :across data
-    :do (setq loc (step-santa loc dir))
-    :do (fset:includef visited loc)
-    :finally (return visited)))
-
-(defun advent-3-1 (data)
-  (fset:size (houses data)))
-
-(defun advent-3-2 (data)
-  (fset:size
-    (fset:union
-      ;                                 come directly at me
-      (houses (ppcre:regex-replace-all "(.)." data "\\1"))
-      (houses (ppcre:regex-replace-all ".(.)" data "\\1")))))
-
-
-;;;; Day 4
-(defun advent-4-data ()
-  "ckczppom")
-
-(defun md5 (str)
-  (ironclad:byte-array-to-hex-string
-    (ironclad:digest-sequence :md5
-                              (ironclad:ascii-string-to-byte-array str))))
-
-(defun mine (data zeroes)
-  (let ((target (apply #'concatenate 'string
-                       (loop :repeat zeroes :collect "0"))))
-    (loop :for i :upfrom 1
-          :for hash = (->> i
-                           prin1-to-string
-                           (concatenate 'string data)
-                           md5)
-          :until (equal target (subseq hash 0 zeroes))
-          :finally (return i))))
-
-(defun advent-4-1 (data)
-  (mine data 5))
-
-(defun advent-4-2 (data)
-  (mine data 6))
-
-
-;;;; Day 5
-(defun advent-5-data ()
-  (-> "data/5"
-      beef:slurp
-      beef:trim-whitespace-right
-      beef:split-lines))
-
-(defun join-strings (strings delim)
-  "Join strings into a single string with the given delimiter string interleaved.
-
-   Delim must not contain a ~.
-
-   "
-  (format nil (concatenate 'string "~{~A~^" delim "~}") strings))
-
-
-(defparameter *bad-pairs* '("ab" "cd" "pq" "xy"))
-
-(defun count-vowels (s)
-  (length (ppcre:regex-replace-all "[^aeiou]" s "")))
-
-(defun has-run (s)
-  (when (ppcre:scan "(.)\\1" s) t))
-
-(defun has-bad (s)
-  (when (ppcre:scan (join-strings *bad-pairs* "|") s) t))
-
-(defun is-nice (s)
-  (and (>= (count-vowels s) 3)
-       (has-run s)
-       (not (has-bad s))))
-
-(defun advent-5-1 (data)
-  (count-if #'is-nice data))
-
-(defun has-run-2 (s)
-  (when (ppcre:scan "(..).*\\1" s) t))
-
-(defun has-repeat (s)
-  (when (ppcre:scan "(.).\\1" s) t))
-
-(defun is-nice-2 (s)
-  (and (has-run-2 s)
-       (has-repeat s)))
-
-(defun advent-5-2 (data)
-  (count-if #'is-nice-2 data))
-
-
-;;;; Day 6
-(defun advent-6-data ()
-  (beef:slurp-lines "data/6" :ignore-trailing-newline t))
-
-(defmacro loop-array (arr name &rest body)
-  (let ((i (gensym "index")))
-    `(loop :for ,i :below (array-total-size ,arr)
-           :for ,name = (row-major-aref ,arr ,i)
-           ,@body)))
-
-(defun parse-indexes (s)
-  (->> s
-       (split-sequence #\,)
-       (mapcar #'parse-integer)))
-
-(defun flip (b)
-  (if (zerop b) 1 0))
-
-(defun parse-line (line)
-  (let ((parts (split-sequence #\space line)))
-    (list (parse-indexes (beef:index parts -3))
-          (parse-indexes (beef:index parts -1))
-          (cond
-            ((equal (car parts) "toggle") :toggle)
-            ((equal (cadr parts) "on") :on)
-            ((equal (cadr parts) "off") :off)
-            (t (error "Unknown operation!"))))))
-
-(defmacro loop-square (r c from-row from-col to-row to-col &rest body)
-  `(loop :for ,r :from ,from-row :to ,to-row
-         :do (loop :for ,c :from ,from-col :to ,to-col
-                   ,@body)))
-
-(defun advent-6-1 (data)
-  (let ((lights (make-array '(1000 1000) :element-type 'bit)))
-    (loop
-      :for line :in data
-      :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
-      :do (loop-square
-            r c from-row from-col to-row to-col
-            :do (setf (bit lights r c)
-                      (case operation
-                        (:toggle (flip (bit lights r c)))
-                        (:on 1)
-                        (:off 0)
-                        (t 0)))))
-    (loop-array lights b
-                :sum b)))
-
-(defun advent-6-2 (data)
-  (let ((lights (make-array '(1000 1000) :element-type 'integer)))
-    (loop
-      :for line :in data
-      :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
-      :do (loop-square
-            r c from-row from-col to-row to-col
-            :do (case operation
-                  (:toggle (incf (aref lights r c) 2))
-                  (:on (incf (aref lights r c)))
-                  (:off (when (not (zerop (aref lights r c)))
-                          (decf (aref lights r c)))))))
-    (loop-array lights b
-                :sum b)))
-
-
-;;;; Day 7
-(defun advent-7-data ()
-  (beef:slurp-lines "data/7" :ignore-trailing-newline t))
-
-(defun advent-7-2-data ()
-  (beef:slurp-lines "data/7-2" :ignore-trailing-newline t))
-
-(defun int->bits (i)
-  (bitsmash:bits<- (format nil "~4,'0X" i)))
-
-(defun bit-lshift (bit-array distance)
-  (replace (make-array (length bit-array) :element-type 'bit)
-           bit-array
-           :start1 0
-           :start2 (bitsmash:int<- distance)))
-
-(defun bit-rshift (bit-array distance)
-  (let ((width (length bit-array))
-        (distance (bitsmash:int<- distance)))
-    (replace (make-array width :element-type 'bit)
-             bit-array
-             :start1 distance
-             :end2 (- width distance))))
-
-(defun .zero-or-more (parser)
-  (.plus (.let* ((x parser)
-                 (xs (.zero-or-more parser)))
-           (.identity (cons x xs)))
-         (.identity ())))
-
-(defun .one-or-more (parser)
-  (.let* ((x parser)
-          (y (.zero-or-more parser)))
-    (.identity (cons x y))))
-
-(defun parse-7 (line)
-  (labels ((.whitespace ()
-             (.first (.one-or-more (.is 'member '(#\space #\tab)))))
-           (.arrow ()
-             (.first (.string= "->")))
-           (.number ()
-             (.let* ((digits (.first (.one-or-more (.is 'digit-char-p)))))
-                    (.identity (parse-integer (concatenate 'string digits)))))
-           (.wire ()
-             (.let* ((chars (.first (.one-or-more (.is 'lower-case-p)))))
-                    (.identity (concatenate 'string chars))))
-           (.source ()
-             (.or (.wire) (.number)))
-           (.string-choice (strs)
-             (if (not strs)
-               (.fail)
-               (.or (.string= (car strs))
-                    (.string-choice (cdr strs)))))
-           (.dest ()
-             (.progn (.whitespace) (.arrow) (.whitespace)
-                     (.wire)))
-           (.constant-source ()
-             (.let* ((val (.source)))
-                    (.identity (list #'identity (list val)))))
-           (.binary-op ()
-             (let ((ops '(("AND" . bit-and)
-                          ("OR" . bit-ior)
-                          ("LSHIFT" . bit-lshift)
-                          ("RSHIFT" . bit-rshift))))
-               (.let* ((name (.string-choice (mapcar #'car ops))))
-                      (.identity (cdr (assoc name ops :test #'equal))))))
-           (.binary-source ()
-             (.let* ((left (.source))
-                     (_ (.whitespace))
-                     (op (.binary-op))
-                     (_ (.whitespace))
-                     (right (.source)))
-                    (.identity (list op (list left right)))))
-           (.unary-op ()
-             (.let* ((_ (.string= "NOT")))
-                    (.identity #'bit-not)))
-           (.unary-source ()
-             (.let* ((op (.unary-op))
-                     (_ (.whitespace))
-                     (source (.source)))
-                    (.identity (list op (list source)))))
-           (.instruction ()
-             (.let* ((source (.or (.binary-source)
-                                  (.unary-source)
-                                  (.constant-source)))
-                     (dest (.dest)))
-                    (.identity (concatenate 'list source (list dest))))))
-    (parse (.instruction) line)))
-
-(defun advent-7-1 (data)
-  (let ((circuit (make-hash-table :test #'equal))
-        (commands (mapcar #'parse-7 data)))
-    (labels ((retrieve (source)
-               (cond
-                 ((stringp source) (gethash source circuit))
-                 ((integerp source) (int->bits source))
-                 (t (error "what?"))))
-             (ready (args)
-               (every #'identity args))
-             (perform (fn args dest)
-               (setf (gethash dest circuit)
-                     (apply fn args)))
-             (try-command (command)
-               "If the command is ready to go, run it and return nil.  Otherwise,
-                return the command itself."
-               (destructuring-bind (fn args dest) command
-                 (let ((vals (mapcar #'retrieve args)))
-                   (if (ready vals)
-                     (progn
-                       (perform fn vals dest)
-                       nil)
-                     command)))))
-      (loop :while commands
-            :do (setf commands
-                  (loop :for command :in commands
-                        :when (try-command command)
-                        :collect :it)))
-      (bitsmash:bits->int (gethash "a" circuit)))))
-
-
-;;;; Day 8
-(defun advent-8-data ()
-  (beef:slurp-lines "data/8" :ignore-trailing-newline t))
-
-
-(defconstant +backslash+ #\\ )
-(defconstant +quote+ #\" )
-
-(defun parse-8 (line)
-  (labels ((.hex-digit ()
-             (.or
-               (.is #'digit-char-p)
-               (.is #'member '(#\a #\b #\c #\d #\e #\f))))
-           (.hex-escape ()
-             (.let* ((_ (.char= #\x))
-                     (a (.hex-digit))
-                     (b (.hex-digit)))
-                    (.identity
-                      (->> (format nil "~A~A" a b)
-                           bitsmash:hex->int
-                           code-char))))
-           (.escaped-char ()
-             (.progn
-               (.char= +backslash+)
-               (.or (.char= +backslash+)
-                    (.char= +quote+)
-                    (.hex-escape))))
-           (.normal-char ()
-             (.is-not 'member (list +backslash+ +quote+)))
-           (.string-char ()
-             (.or (.normal-char)
-                  (.escaped-char)))
-           (.full-string ()
-             (.prog2
-               (.char= +quote+)
-               (.first (.zero-or-more (.string-char)))
-               (.char= +quote+))))
-    (parse (.full-string) line)))
-
-(defun .wrap (fn parser)
-  (.let* ((v parser))
-         (.identity (funcall fn v))))
-
-(defun parse-8-2 (line)
-  (labels ((.special-char ()
-             (.let* ((ch (.or (.char= +backslash+)
-                              (.char= +quote+))))
-                    (.identity (list +backslash+ ch))))
-           (.normal-char ()
-             (.wrap #'list
-                    (.is-not 'member (list +backslash+ +quote+))))
-           (.string-char ()
-             (.or (.normal-char)
-                  (.special-char)))
-           (.full-string ()
-             (.let* ((chars (.zero-or-more (.string-char))))
-                    (.identity (apply #'concatenate 'list chars)))))
-    (append (list +quote+)
-            (parse (.full-string) line)
-            (list +quote+))))
-
-(defun advent-8-1 (data)
-  (loop :for line :in data
-        :for chars = (parse-8 line)
-        :sum (- (length line)
-                (length chars))))
-
-(defun advent-8-2 (data)
-  (loop :for line :in data
-        :for chars = (parse-8-2 line)
-        :sum (- (length chars)
-                (length line))))
-
-
-;;;; Day 9
-(defun advent-9-data ()
-  (beef:slurp-lines "data/9" :ignore-trailing-newline t))
-
-; Thanks Norvig
-; http://norvig.com/paip/gps.lisp
-(defun permutations (bag)
-  "Return a list of all the permutations of the input."
-  ;; If the input is nil, there is only one permutation:
-  ;; nil itself
-  (if (null bag)
-      '(())
-      ;; Otherwise, take an element, e, out of the bag.
-      ;; Generate all permutations of the remaining elements,
-      ;; And add e to the front of each of these.
-      ;; Do this for all possible e to generate all permutations.
-      (mapcan #'(lambda (e)
-                  (mapcar #'(lambda (p) (cons e p))
-                          (permutations
-                            (remove e bag :count 1 :test #'eq))))
-              bag)))
-
-(defun advent-9 (data)
-  (let ((distances (make-hash-table :test #'equal)))
-    (loop :for line :in data
-          :for (a to b _ dist) = (split-sequence #\space line)
-          :for distance = (parse-integer dist)
-          :do (progn
-                (setf (gethash (cons a b) distances) distance)
-                (setf (gethash (cons b a) distances) distance)))
-    (labels ((score-route (route)
-               (optima:match route
-                 ((list _) 0)
-                 ((list* a b _) (+ (gethash (cons a b) distances)
-                                   (score-route (cdr route))))))
-             (dedupe (l)
-               (remove-duplicates l :test #'equal)))
-      (loop :for route :in (->> distances
-                             beef:hash-keys
-                             (mapcar #'car)
-                             dedupe
-                             permutations)
-            :for score = (score-route route)
-            :minimizing score :into min-dist
-            :maximizing score :into max-dist
-            :finally (return (cons min-dist max-dist))))))
-
-
-(defmethod print-object ((object hash-table) stream)
-  (format stream "#HASH{~%~{~{    (~s : ~s)~}~%~}}"
-          (loop for key being the hash-keys of object
-                using (hash-value value)
-                collect (list key value))))
-
-
-;;;; Day 10
-(defun advent-10-data ()
-  "1321131112")
-
-(defun look-and-say (seq)
-  (let ((runs (list))
-        (len 1)
-        (current -1))
-    (flet ((mark-run ()
-             (setf runs (cons current (cons len runs)))))
-    (loop :for n :in seq
-          :do (if (= current n)
-                (incf len)
-                (progn
-                  (when (not (= -1 current))
-                    (mark-run))
-                  (setf len 1)
-                  (setf current n)))
-          :finally (mark-run))
-    (reverse runs))))
-
-(defun iterate (n f data)
-  (declare (optimize speed (debug 0)))
-  (dotimes (_ n)
-    (setf data (funcall f data)))
-  data)
-
-(defun las-to-list (s)
-  (loop :for digit :across s
-        :collect (-> digit string parse-integer)))
-
-(defun advent-10-1 (data)
-  (length (iterate 40 #'look-and-say (las-to-list data))))
-
-(defun advent-10-2 (data)
-  (length (iterate 50 #'look-and-say (las-to-list data))))
-
-
-;;;; Day 11
-(defun advent-11-data ()
-  "vzbxkghb")
-
-
-(defparameter base 26)
-(defparameter ascii-alpha-start (char-code #\a))
-(defun num-to-char (n)
-  (code-char (+ n ascii-alpha-start)))
-
-(defun char-to-num (ch)
-  (- (char-code ch) ascii-alpha-start))
-
-
-(defmacro loop-window (seq width binding-form &rest body)
-  (let ((i (gensym "IGNORE"))
-        (s (gensym "SEQ"))
-        (n (gensym "WIDTH"))
-        (tail (gensym "TAIL")))
-    `(let ((,s ,seq)
-           (,n ,width))
-       (loop :for ,i :upto (- (length ,s) ,n)
-             :for ,tail :on ,s
-             :for ,binding-form = (subseq ,tail 0 ,n)
-             ,@body))))
-
-
-(defun is-straight-3 (l)
-  (destructuring-bind (a b c) l
-    (and (= 1 (- b a))
-         (= 1 (- c b)))))
-
-(defun has-straight-3 (nums)
-  (loop-window nums 3 triplet
-               :thereis (is-straight-3 triplet)))
-
-
-(defparameter bad-chars
-  (mapcar #'char-to-num '(#\i #\l #\o)))
-
-(defun no-bad (nums)
-  (loop :for bad :in bad-chars
-        :never (find bad nums)))
-
-
-(defun two-pairs (nums)
-  (-> nums
-      (loop-window 2 (a b)
-                   :when (= a b)
-                   :collect a)
-      remove-duplicates
-      length
-      (>= 2)))
-
-
-(defun valid (nums)
-  (and (has-straight-3 nums)
-       (no-bad nums)
-       (two-pairs nums)
-       nums))
-
-
-(defun incr-nums (nums)
-  (labels ((inc-mod (x)
-             (mod (1+ x) base))
-           (inc (nums)
-             (if (not nums)
-               '(1)
-               (let ((head (inc-mod (car nums))))
-                 (if (zerop head)
-                   (cons head (inc (cdr nums)))
-                   (cons head (cdr nums)))))))
-    (reverse (inc (reverse nums)))))
-
-
-(defun advent-11-1 (data)
-  (flet ((chars-to-string (chs)
-           (apply #'concatenate 'string (mapcar #'string chs)))
-         (nums-to-chars (nums)
-           (mapcar #'num-to-char nums))
-         (string-to-nums (str)
-           (loop :for ch :across str
-                 :collect (char-to-num ch))))
-    (-> (loop :for pw = (incr-nums (string-to-nums data))
-              :then (incr-nums pw)
-              :thereis (valid pw))
-        nums-to-chars
-        chars-to-string)))
-
-
-;;;; Day 12
-(defun advent-12-data ()
-  (beef:trim-whitespace (beef:slurp "data/12")))
-
-
-(defun parse-json (s)
-  (labels ((.number ()
-             (.let* ((negation (.optional (.char= #\-)))
-                     (digits (.first (.one-or-more (.is 'digit-char-p)))))
-               (.identity (let ((i (parse-integer (concatenate 'string digits)))
-                                (c (if negation -1 1)))
-                            (* i c)))))
-           (.string-char ()
-             (.wrap #'list (.is-not 'member (list +quote+))))
-           (.string-guts ()
-             (.let* ((chars (.zero-or-more (.string-char))))
-               (.identity (apply #'concatenate 'string chars))))
-           (.string ()
-             (.prog2
-               (.char= +quote+)
-               (.string-guts)
-               (.char= +quote+)))
-           (.map-pair ()
-             (.let* ((key (.string))
-                     (_ (.char= #\:))
-                     (value (.expression)))
-               (.identity (cons key value))))
-           (.map-guts ()
-             (.or
-               (.let* ((p (.map-pair))
-                       (_ (.char= #\,))
-                       (remaining (.map-guts)))
-                 (.identity (cons p remaining)))
-               (.wrap #'list (.map-pair))
-               (.identity '())))
-           (.map ()
-             (.prog2
-               (.char= #\{)
-               (.wrap (lambda (v) (cons :map v))
-                      (.map-guts))
-               (.char= #\})))
-           (.array-guts ()
-             (.or
-               (.let* ((item (.expression))
-                       (_ (.char= #\,))
-                       (remaining (.array-guts)))
-                 (.identity (cons item remaining)))
-               (.wrap #'list (.expression))
-               (.identity '())))
-           (.array ()
-             (.prog2
-               (.char= #\[)
-               (.wrap (lambda (v) (cons :array v))
-                      (.array-guts))
-               (.char= #\])))
-           (.expression ()
-             (.or (.array)
-                  (.map)
-                  (.string)
-                  (.number))))
-    (parse (.expression) s)))
-
-(defun walk-sum (v)
-  (cond
-    ((not v) 0)
-    ((typep v 'integer) v)
-    ((typep v 'string) 0)
-    ((eql (car v) :array) (loop :for value in (cdr v)
-                                :sum (walk-sum value)))
-    ((eql (car v) :map) (loop :for (key . value) :in (cdr v)
-                              :sum (walk-sum value)))
-    (:else (error (format nil "wat? ~a" v)))))
-
-(defun walk-sum-2 (v)
-  (cond
-    ((not v) 0)
-    ((typep v 'integer) v)
-    ((typep v 'string) 0)
-    ((eql (car v) :array) (loop :for value in (cdr v)
-                                :sum (walk-sum-2 value)))
-    ((eql (car v) :map)
-     (if (member "red" (mapcar #'cdr (cdr v))
-                 :test #'equal)
-       0
-       (loop :for (key . value) :in (cdr v)
-             :sum (walk-sum-2 value))))
-    (:else (error (format nil "wat? ~a" v)))))
-
-
-(defun advent-12-1 (data)
-  (walk-sum (parse-json data)))
-
-(defun advent-12-2 (data)
-  (walk-sum-2 (parse-json data)))
-
-
-;;;; Day 13
-(defun advent-13-data ()
-  (beef:slurp-lines "data/13" :ignore-trailing-newline t))
-
-
-(defvar *wat* nil)
-
-(defmacro map-when (test fn val &rest args)
-  (let ((v (gensym "VALUE")))
-    `(let ((,v ,val))
-       (if ,test
-         (apply ,fn ,v ,args)
-         ,v))))
-
-(defun split-lines-13 (lines)
-  (loop :for line :in lines
-        :collect (ppcre:register-groups-bind
-                   (a dir amount b)
-                   ("(\\w+) would (gain|lose) (\\d+) .*? next to (\\w+)."
-                    line)
-                   (list a b (map-when (equal "lose" dir)
-                                       #'-
-                                       (parse-integer amount))))))
-
-(defun rate-seating (vals arrangement)
-  (labels ((find-val (a b)
-             (or (gethash (cons a b) vals) 0))
-           (rate-one-direction (arr)
-             (+ (loop-window arr 2 (a b) :sum (find-val a b))
-                (find-val (car (last arr)) (car arr)))))
-    (+ (rate-one-direction arrangement)
-       (rate-one-direction (reverse arrangement)))))
-
-(defun advent-13-1 (data)
-  (let* ((tups (split-lines-13 data))
-         (attendees (remove-duplicates (mapcar #'car tups) :test #'equal))
-         (vals (make-hash-table :test #'equal)))
-    (loop :for (a b val) :in tups
-          :do (setf (gethash (cons a b) vals) val))
-    (loop :for arrangement :in (permutations attendees)
-          :maximize (rate-seating vals arrangement))))
-
-(defun advent-13-2 (data)
-  (let* ((tups (split-lines-13 data))
-         (attendees (cons "Self" (remove-duplicates (mapcar #'car tups) :test #'equal)))
-         (vals (make-hash-table :test #'equal)))
-    (loop :for (a b val) :in tups
-          :do (setf (gethash (cons a b) vals) val))
-    (loop :for arrangement :in (permutations attendees)
-          :maximize (rate-seating vals arrangement))))
-
-
-;;;; Day 14
-(defun advent-14-data ()
-  (beef:slurp-lines "data/14" :ignore-trailing-newline t))
-
-
-(defun tick (deer)
-  (destructuring-bind
-    (name speed sprint-period rest-period traveled currently remaining)
-    deer
-    (let ((remaining (1- remaining)))
-      (if (equal currently :resting)
-        (list name speed sprint-period rest-period
-              traveled
-              (if (zerop remaining) :sprinting :resting)
-              (if (zerop remaining) sprint-period remaining))
-        (list name speed sprint-period rest-period
-              (+ traveled speed)
-              (if (zerop remaining) :resting :sprinting)
-              (if (zerop remaining) rest-period remaining))))))
-
-(defun parse-deers (lines)
-  (loop :for line :in lines
-        :collect (ppcre:register-groups-bind
-                   (name speed sprint-period rest-period)
-                   ("(\\w+) can fly (\\d+) km/s for (\\d+) .* (\\d+) seconds."
-                    line)
-                   (list name
-                         (parse-integer speed)
-                         (parse-integer sprint-period)
-                         (parse-integer rest-period)
-                         0
-                         :sprinting
-                         (parse-integer sprint-period)))))
-
-(defun find-leaders (deers)
-  (let ((dist (reduce #'max deers :key (beef:partial #'nth 4))))
-    (remove-if-not (lambda (deer)
-                     (= dist (nth 4 deer)))
-                   deers)))
-
-
-(defun advent-14-1 (data n)
-  (apply #'max
-         (loop :for i :upto n
-               :for deers := (parse-deers data) :then (mapcar #'tick deers)
-               :finally (return (mapcar (beef:partial #'nth 4) deers)))))
-
-(defun advent-14-2 (data n)
-  (let ((scores (make-hash-table :test #'equal))
-        (deers (parse-deers data)))
-    (loop :for (name) :in deers
-          :do (setf (gethash name scores) 0))
-    (loop :for i :upto n
-          :do (setf deers (mapcar #'tick deers))
-          :do (loop :for (name) :in (find-leaders deers)
-                    :do (incf (gethash name scores))))
-    (apply #'max (beef:hash-values scores))))
-
-
-
-;;;; Day 15
-(defun advent-15-data ()
-  (beef:slurp-lines "data/15" :ignore-trailing-newline t))
-
-(defun split-ingredients (line)
-  (ppcre:register-groups-bind
-    (name (#'parse-integer capacity durability flavor texture calories))
-    ("(\\w+): capacity (-?\\d+), durability (-?\\d+), flavor (-?\\d+), texture (-?\\d+), calories (-?\\d+)"
-     line)
-    (list name capacity durability flavor texture calories)))
-
-(defun calc-contribution (ingr amount)
-  (cons (car ingr)
-        (mapcar (beef:partial #'* amount)
-                (cdr ingr))))
-
-(defun calc-contributions (ingrs alist)
-  (mapcar #'calc-contribution ingrs alist))
-
-(defun sum-totals (ingrs)
-  (->> ingrs
-       (mapcar #'cdr)
-       (apply #'mapcar #'+)
-       (mapcar (lambda (x) (if (< x 0) 0 x)))))
-
-(defun advent-15-1 (data)
-  (let ((ingredients (mapcar #'split-ingredients data))
-        (limit 100)
-        (amounts (list)))
-    ; fuckin lol
-    (loop :for a :upto limit :do
-          (loop :for b :upto (- limit a) :do
-                (loop :for c :upto (- limit a b) :do
-                      (setf amounts
-                            (cons (list a b c (- limit a b c))
-                                  amounts)))))
-    (loop :for alist :in amounts
-          :maximize (->> alist
-                         (calc-contributions ingredients)
-                         sum-totals
-                         butlast
-                         (apply #'*)))))
-
-(defun advent-15-2 (data)
-  (let ((ingredients (mapcar #'split-ingredients data))
-        (limit 100)
-        (amounts (list)))
-    ; fuckin lol
-    (loop :for a :upto limit :do
-          (loop :for b :upto (- limit a) :do
-                (loop :for c :upto (- limit a b) :do
-                      (setf amounts
-                            (cons (list a b c (- limit a b c))
-                                  amounts)))))
-    (loop :for alist :in amounts
-          :for val = (->> alist
-                          (calc-contributions ingredients)
-                          sum-totals)
-          :when (= (car (last val)) 500)
-          :maximize (apply #'* (butlast val)))))
-
-
-;;;; Scratch
-#+comment
-(advent-15-2 (advent-15-data))
diff -r e3e015ad324c -r 75998992ab3c src/2017/main.lisp
--- a/src/2017/main.lisp	Mon Dec 10 00:51:46 2018 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,155 +0,0 @@
-(in-package :advent)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-(define-problem (2017 1 1) (data read-file-of-digits)
-  (iterate
-    (for (x . y) :pairs-of-list data)
-    (when (= x y)
-      (sum x))))
-
-(define-problem (2017 1 2) (data read-file-of-digits)
-  (iterate
-    (with data = (coerce data 'vector))
-    (with length = (length data))
-    (for x :in-vector data)
-    (for iy :modulo length :from (truncate length 2))
-    (for y = (aref data iy))
-    (when (= x y)
-      (sum x))))
-
-
-(define-problem (2017 2 1) (data read-file-of-lines-of-numbers)
-  (flet ((checksum (line)
-           (- (extremum line #'>)
-              (extremum line #'<))))
-    (summation data :key #'checksum)))
-
-(define-problem (2017 2 2) (data read-file-of-lines-of-numbers)
-  (labels ((validp (a b)
-             (dividesp (max a b) (min a b)))
-           (head-valid-p (list)
-             (destructuring-bind (n . remaining) list
-               (some (curry #'validp n) remaining)))
-           (checksum (line)
-             (somelist #'head-valid-p line)))
-    (summation data :key #'checksum)))
-
-
-(define-problem (2017 3 1) (data read-form-from-file)
-  (labels ((manhattan-distance (a b)
-             (+ (abs (- (realpart a)
-                        (realpart b)))
-                (abs (- (imagpart a)
-                        (imagpart b)))))
-           (distance-to-origin (p)
-             (manhattan-distance #c(0 0) p)))
-    (distance-to-origin (advent.spiral:number-coordinates data))))
-
-(define-problem (2017 3 2) (data read-form-from-file)
-  (flet ((neighbors (coord)
-           (gathering
-             (do-irange ((dx -1 1)
-                         (dy -1 1))
-               (unless (= 0 dx dy)
-                 (gather (+ coord (complex dx dy))))))))
-    (iterate
-      (with memory = (make-hash-table))
-      (initially (setf (gethash #c(0 0) memory) 1))
-      (for n :from 2)
-      (for coord = (advent.spiral:number-coordinates n))
-      (for value = (summation (neighbors coord) :key (rcurry #'gethash memory 0)))
-      (finding value :such-that (> value data))
-      (setf (gethash coord memory) value))))
-
-
-(define-problem (2017 4 1) (data read-file-of-lines-of-words)
-  (labels ((contains-duplicates-p (list &key (test #'eql))
-             (iterate (for (head . tail) :on list)
-                      (thereis (member head tail :test test))))
-           (validp (phrase)
-             (not (contains-duplicates-p phrase :test #'string=))))
-    (count-if #'validp data)))
-
-(define-problem (2017 4 2) (data read-file-of-lines-of-words)
-  (labels ((anagramp (string1 string2)
-             (hash-table= (frequencies string1) (frequencies string2)))
-           (contains-anagram-p (phrase)
-             (iterate (for (word . tail) :on phrase)
-                      (thereis (member-if (curry #'anagramp word) tail)))))
-    (count-if-not #'contains-anagram-p data)))
-
-
-(define-problem (2017 5 1) (data read-all-from-file)
-  (iterate
-    (with maze = (coerce data 'simple-vector))
-    (with bound = (1- (length maze)))
-    (with address = 0)
-    (for steps :from 0)
-    (finding steps :such-that (not (<= 0 address bound)))
-    (for offset = (aref maze address))
-    (incf (aref maze address))
-    (incf address offset)))
-
-(define-problem (2017 5 2) (data read-all-from-file)
-  (iterate
-    (with maze = (coerce data 'simple-vector))
-    (with bound = (1- (length maze)))
-    (with address = 0)
-    (for steps :from 0)
-    (finding steps :such-that (not (<= 0 address bound)))
-    (for offset = (aref maze address))
-    (incf (aref maze address)
-          (if (>= offset 3) -1 1))
-    (incf address offset)))
-
-
-(define-problem (2017 6) (data read-all-from-file)
-  (let ((banks (coerce data 'vector))
-        (seen (make-hash-table :test 'equalp)))
-    (labels ((bank-to-redistribute ()
-               (iterate (for blocks :in-vector banks :with-index bank)
-                        (finding bank :maximizing blocks)))
-             (redistribute ()
-               (iterate
-                 (with bank = (bank-to-redistribute))
-                 (with blocks-to-redistribute = (aref banks bank))
-                 (initially (setf (aref banks bank) 0))
-                 (repeat blocks-to-redistribute)
-                 (for b :modulo (length banks) :from (1+ bank))
-                 (incf (aref banks b))))
-             (mark-seen (banks cycles)
-               (setf (gethash (copy-seq banks) seen) cycles)))
-      (iterate
-        (mark-seen banks cycle)
-        (summing 1 :into cycle)
-        (redistribute)
-        (for last-seen = (gethash banks seen))
-        (until last-seen)
-        (finally (return (values cycle (- cycle last-seen))))))))
-
-
-(define-problem (2017 7) (data read-lines-from-file)
-  (labels
-      ((parse-line (line)
-         (ppcre:register-groups-bind
-             (name (#'parse-integer weight) ((curry #'str:split ", ") holding))
-             (#?/(\w+) \((\d+)\)(?: -> (.+))?/ line)
-           (values name weight holding)))
-       (insert-edge (digraph pred succ)
-         (digraph:insert-vertex digraph pred)
-         (digraph:insert-vertex digraph succ)
-         (digraph:insert-edge digraph pred succ))
-       (build-tower (lines)
-         (iterate
-           (with tower = (digraph:make-digraph :test #'equal))
-           (for line :in lines)
-           (for (values name weight holding) = (parse-line line))
-           (collect-hash (name weight) :into weights :test #'equal)
-           (digraph:insert-vertex tower name)
-           (map nil (curry #'insert-edge tower name) holding)
-           (finally (return (values tower weights))))))
-    (multiple-value-bind (tower individual-weights) (build-tower data)
-      (declare (ignore individual-weights))
-      ;; (digraph.dot:draw tower)
-      (first (digraph:roots tower)))))
diff -r e3e015ad324c -r 75998992ab3c src/2017/number-spiral.lisp
--- a/src/2017/number-spiral.lisp	Mon Dec 10 00:51:46 2018 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,90 +0,0 @@
-(defpackage :advent.spiral
-  (:use :cl :losh :iterate :advent.quickutils)
-  (:export :number-coordinates))
-
-(in-package :advent.spiral)
-
-(defun layer-side-length (layer)
-  "Return the length of one side of `layer`."
-  (1+ (* 2 layer)))
-
-(defun layer-size (layer)
-  "Return the total size of a number spiral with a final layer of `layer`."
-  (square (layer-side-length layer)))
-
-(defun layer-for-number (number)
-  "Return the index of the layer containing `number`."
-  (ceiling (/ (1- (sqrt number)) 2)))
-
-(defun layer-start (layer)
-  "Return the smallest number in `layer`."
-  (if (zerop layer)
-    1
-    (1+ (layer-size (1- layer)))))
-
-(defun layer-leg-length (layer)
-  "Return the length of one \"leg\" of `layer`."
-  (1- (layer-side-length layer)))
-
-
-(defun leg (layer number)
-  "Return the leg index and offset of `number` in `layer`."
-  (if (= 1 number)
-    (values 0 0)
-    (let ((idx (- number (layer-start layer)))
-          (legsize (layer-leg-length layer)))
-      (values (floor idx legsize)
-              (1+ (mod idx legsize))))))
-
-(defun corner-coordinates (layer leg)
-  "Return the coordinates of the corner starting `leg` in `layer`.
-
-  Leg | Corner
-   0  | Bottom Right
-   1  | Top Right
-   2  | Top Left
-   3  | Bottom Left
-
-  "
-
-  ;; 2   1
-  ;;
-  ;; 3   0
-  (ccase leg
-    (0 (complex layer (- layer)))
-    (1 (complex layer layer))
-    (2 (complex (- layer) layer))
-    (3 (complex (- layer) (- layer)))))
-
-(defun leg-direction (leg)
-  "Return the direction vector for the given `leg`.
-  "
-  ;;    <--
-  ;;   11110
-  ;; | 2   0 ^
-  ;; | 2   0 |
-  ;; v 2   0 |
-  ;;   23333
-  ;;    -->
-  (ccase leg
-    (0 (complex 0 1))
-    (1 (complex -1 0))
-    (2 (complex 0 -1))
-    (3 (complex 1 0))))
-
-
-(defun number-coordinates (number)
-  (nest
-    ;; Find the layer the number falls in.
-    (let ((layer (layer-for-number number))))
-
-    ;; Find which leg of that layer it's in, and how far along the leg it is.
-    (multiple-value-bind (leg offset) (leg layer number))
-
-    ;; Find the coordinates of the leg's corner, and its direction vector.
-    (let ((corner (corner-coordinates layer leg))
-          (direction (leg-direction leg))))
-
-    ;; Start at the corner and add the offset in the leg's direction to find the
-    ;; number's coordinates.
-    (+ corner (* direction offset))))
diff -r e3e015ad324c -r 75998992ab3c src/2018/01.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/01.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,17 @@
+(defpackage :advent/2018/01 #.cl-user::*advent-use*)
+(in-package :advent/2018/01)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(define-problem (2018 1) (data read-all)
+  (values
+    (summation data)
+    (progn
+      (setf (cdr (last data)) data) ; make data a circular list for easy looping
+      (iterate
+        (with seen = (make-hash-set :initial-contents '(0)))
+        (for number :in data)
+        (summing number :into frequency)
+        (if (hset-contains-p seen frequency)
+          (return frequency)
+          (hset-insert! seen frequency))))))
diff -r e3e015ad324c -r 75998992ab3c src/2018/02.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/02.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,23 @@
+(defpackage :advent/2018/02 #.cl-user::*advent-use*)
+(in-package :advent/2018/02)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(define-problem (2018 2) (data read-lines)
+  (values
+    (let* ((freqs (mapcar #'frequencies data))
+           (counts (mapcar #'hash-table-values freqs)))
+      (* (count 2 counts :test #'member)
+         (count 3 counts :test #'member)))
+    ;; just brute force it
+    (multiple-value-bind (a b)
+        (iterate
+          (for (a . remaining) :on data)
+          (for b = (find 1 remaining :key (curry #'hamming-distance a)))
+          (when b
+            (return (values a b))))
+      (let ((i (mismatch a b)))
+        (str:concat (subseq a 0 i)
+                    (subseq a (1+ i)))))))
+
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/03.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/03.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,44 @@
+(defpackage :advent/2018/03 #.cl-user::*advent-use*)
+(in-package :advent/2018/03)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(defstruct claim id left right top bottom)
+(define-with-macro claim id left right top bottom)
+
+(defun parse-claim (line)
+  (ppcre:register-groups-bind
+      ((#'parse-integer id col row width height))
+      (#?r"#(\d+) @ (\d+),(\d+): (\d+)x(\d+)" line)
+    (make-claim :id id
+                :left col
+                :top row
+                :right (+ col width)
+                :bottom (+ row height))))
+
+(defun claims-intersect-p (claim1 claim2)
+  (with-claim (claim1 id1 left1 right1 top1 bottom1)
+    (with-claim (claim2 id2 left2 right2 top2 bottom2)
+      (not (or (<= right2 left1)
+               (<= right1 left2)
+               (>= top2 bottom1)
+               (>= top1 bottom2))))))
+
+(defun make-fabric (claims)
+  (let ((fabric (make-array (list 1000 1000) :initial-element 0)))
+    (dolist (claim claims)
+      (with-claim (claim)
+        (do-range ((row top bottom)
+                   (col left right))
+                  (incf (aref fabric row col)))))
+    fabric))
+
+
+(define-problem (2018 3) (data read-lines)
+  (let* ((claims (mapcar #'parse-claim data))
+         (fabric (make-fabric claims)))
+    (values
+      (iterate (for uses :in-array fabric)
+               (counting (> uses 1)))
+      (claim-id (first (unique claims :test #'claims-intersect-p))))))
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/04.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/04.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,69 @@
+(defpackage :advent/2018/04 #.cl-user::*advent-use*)
+(in-package :advent/2018/04)
+(named-readtables:in-readtable :interpol-syntax)
+
+;; This problem gets much easier after you've unlocked the second question and
+;; realize you can solve everything by building histograms of each guard's
+;; sleeping minutes.
+
+(defun parse-line (line)
+  "Parse `line` into `(minute :event id?)`"
+  (ppcre:register-groups-bind
+      ((#'parse-integer minute) event)
+      (#?r"\[\d+-\d+-\d+ \d+:(\d+)\] (.*)" line)
+    (list* minute
+           (cond
+             ((string= "falls asleep" event) (list :sleep nil))
+             ((string= "wakes up" event) (list :wake nil))
+             (t (ppcre:register-groups-bind
+                    ((#'parse-integer id))
+                    (#?r"Guard #(\d+) begins shift" event)
+                  (list :guard id)))))))
+
+(defun sleep-intervals (events &aux start guard)
+  "Transform `events` into a list of `(guard-id start end)`"
+  (iterate
+    (for (minute event id?) :in events)
+    (ecase event
+      (:guard (setf guard id?))
+      (:wake (collect (list guard start minute)))
+      (:sleep (setf start minute)))))
+
+(defun guard-histograms (intervals)
+  "Return a hash-table of histograms of the guards' sleeping minutes."
+  (iterate
+    (with result = (make-hash-table))
+    (for (guard start end) :in intervals)
+    (for histogram = (ensure-gethash guard result
+                                     (make-array 60 :initial-element 0)))
+    (do-range ((minute start end))
+      (incf (aref histogram minute)))
+    (finally (return result))))
+
+
+(define-problem (2018 4) (data read-lines)
+  (let ((guard-histograms (-<> data
+                            (sort <> #'string<)
+                            (mapcar #'parse-line <>)
+                            sleep-intervals
+                            guard-histograms)))
+    (nest
+      (destructuring-bind
+          (sleepy-guard sleepy-guard-preferred-minute)
+          (iterate
+            (for (guard histogram) :in-hashtable guard-histograms)
+            (finding (list guard
+                           (nth-value 1 (extremum+ histogram #'>)))
+                     :maximizing (summation histogram))))
+      (destructuring-bind
+          (predictable-guard predictable-guard-time)
+          (iterate
+            (for (guard histogram) :in-hashtable guard-histograms)
+            (for (values time preferred-minute) = (extremum+ histogram #'>))
+            (finding (list guard preferred-minute) :maximizing time)))
+      (values (* sleepy-guard
+                 sleepy-guard-preferred-minute)
+              (* predictable-guard
+                 predictable-guard-time)))))
+
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/05.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/05.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,24 @@
+(defpackage :advent/2018/05 #.cl-user::*advent-use*)
+(in-package :advent/2018/05)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun reactivep (x y)
+  (char= x (char-invertcase y)))
+
+(defun react (string &aux result)
+  (doseq (char string)
+    (if (and result (reactivep char (car result)))
+      (pop result)
+      (push char result)))
+  (coerce (nreverse result) 'string))
+
+(define-problem (2018 5) (data alexandria:read-stream-content-into-string)
+  (deletef data #\newline)
+  (values
+    (length (react data))
+    (iterate
+      (for unit :in-vector (remove-duplicates data :test #'char-equal))
+      (for candidate = (react (remove unit data :test #'char-equal)))
+      (minimizing (length candidate)))))
+
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/06.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/06.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,45 @@
+(defpackage :advent/2018/06 #.cl-user::*advent-use*)
+(in-package :advent/2018/06)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun parse-line (line)
+  (apply #'complex (mapcar #'parse-integer (str:split ", " line))))
+
+(defun closest (point coordinates)
+  (let ((results (extremums coordinates '<
+                            :key (curry #'manhattan-distance point))))
+    (case (length results)
+      (1 (car results))
+      (t nil))))
+
+(define-problem (2018 6) (data read-lines)
+  (let* ((coordinates (mapcar #'parse-line data))
+         (xs (mapcar #'realpart coordinates))
+         (ys (mapcar #'imagpart coordinates))
+         (left (extremum xs #'<))
+         (bottom (extremum ys #'<))
+         (right (extremum xs #'>))
+         (top (extremum ys #'>))
+         (counts (make-hash-table))
+         (infinite (make-hash-set)))
+    (iterate
+      (for-nested ((x :from left :to right)
+                   (y :from bottom :to top)))
+      (for closest = (closest (complex x y) coordinates))
+      (when closest
+        (incf (gethash closest counts 0))
+        (when (or (= left x) (= bottom y)
+                  (= right x) (= top y))
+          (hset-insert! infinite closest))))
+    (values
+      (iterate
+        (for (point size) :in-hashtable counts)
+        (unless (hset-contains-p infinite point)
+          (maximizing size)))
+      (iterate
+        (for-nested ((x :from left :to right)
+                     (y :from bottom :to top)))
+        (for point = (complex x y))
+        (for total-distance = (summation coordinates :key (curry #'manhattan-distance point)))
+        (counting (< total-distance 10000))))))
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/07.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/07.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,62 @@
+(defpackage :advent/2018/07 #.cl-user::*advent-use*)
+(in-package :advent/2018/07)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(defun parse-line (line)
+  (ppcre:register-groups-bind
+      (((rcurry #'aref 0) requirement target))
+      (#?r"Step (\w) must be finished before step (\w) can begin." line)
+    (list target requirement)))
+
+(defun make-graph (edges)
+  (let* ((vertices (remove-duplicates (flatten-once edges)))
+         (graph (digraph:make-digraph :initial-vertices vertices)))
+    (dolist (edge edges)
+      (digraph:insert-edge graph (first edge) (second edge)))
+    graph))
+
+(defun char-number (char)
+  (1+ (- (char-code char) (char-code #\A))))
+
+(defun task-length (task)
+  (+ 60 (char-number task)))
+
+(defun decrement-workers (workers)
+  (gathering
+    (do-array (worker workers)
+      (when worker
+        (when (zerop (decf (cdr worker)))
+          (gather (car worker))
+          (setf worker nil))))))
+
+
+(define-problem (2018 7) (data read-lines)
+  (values
+    (let ((graph (make-graph (mapcar #'parse-line data))))
+      ;; (digraph.dot:draw graph)
+      (recursively ((result nil))
+        (if (emptyp graph)
+          (coerce (nreverse result) 'string)
+          (let ((next (extremum (digraph:leafs graph) 'char<)))
+            (digraph:remove-vertex graph next)
+            (recur (cons next result))))))
+    (iterate
+      (with graph = (make-graph (mapcar #'parse-line data)))
+      ;; workers is a vector of (task . remaining-time), or NILs for idle workers
+      (with workers = (make-array 5 :initial-element nil))
+      (for elapsed :from 0)
+      (for finished-tasks = (decrement-workers workers))
+      (map nil (curry #'digraph:remove-vertex graph) finished-tasks)
+      (for current-tasks = (remove nil (map 'list #'car workers)))
+      (for available-tasks = (-<> graph
+                               digraph:leafs
+                               (set-difference <> current-tasks)
+                               (sort <> 'char<)))
+      (do-array (worker workers)
+        (when (null worker)
+          (when-let ((task (pop available-tasks)))
+            (setf worker (cons task (task-length task))))))
+      (when (and (emptyp graph) (every #'null workers))
+        (return elapsed)))))
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/08.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/08.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,34 @@
+(defpackage :advent/2018/08 #.cl-user::*advent-use*)
+(in-package :advent/2018/08)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defstruct (node (:conc-name nil))
+  children metadata)
+
+(defun read-node (stream)
+  (let ((children-count (read stream))
+        (metadata-count (read stream)))
+    (make-node :children (iterate
+                           (repeat children-count)
+                           (collect (read-node stream) :result-type vector))
+               :metadata (iterate
+                           (repeat metadata-count)
+                           (collect (read stream))))))
+
+(defun node-value (node &aux (children (children node)))
+  (if (emptyp children)
+    (summation (metadata node))
+    (iterate
+      (for meta :in (metadata node))
+      (for index = (1- meta))
+      (when (array-in-bounds-p children index)
+        (summing (node-value (aref children index)))))))
+
+(define-problem (2018 8) (data)
+  (let ((root (read-node data)))
+    (values
+      (recursively ((node root))
+        (+ (summation (metadata node))
+           (summation (children node) :key #'recur)))
+      (node-value root))))
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/09.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/09.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,34 @@
+(defpackage :advent/2018/09 #.cl-user::*advent-use*)
+(in-package :advent/2018/09)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(defun parse-input (line)
+  (ppcre:register-groups-bind
+      ((#'parse-integer players marbles))
+      (#?r"(\d+) players\D*(\d+) points" line)
+    (values players marbles)))
+
+(defun play (players marbles)
+  (let ((circle (ring 0))
+        (elves (make-array players :initial-element 0)))
+    (iterate
+      (declare (iterate:declare-variables))
+      (for elf :first 0 :then (mod (1+ elf) players))
+      (for marble :from 1 :to marbles)
+      (if (dividesp marble 23)
+        (progn (incf (aref elves elf) marble)
+               (ring-movef circle -7)
+               (incf (aref elves elf) (ring-data circle))
+               (ring-cutf circle))
+        (progn (ring-movef circle 1)
+               (ring-insertf-after circle marble))))
+    (extremum elves '>)))
+
+
+(define-problem (2018 9) (data alexandria:read-stream-content-into-string)
+  (multiple-value-bind (players marbles) (parse-input data)
+    #+sbcl (sb-ext:gc :full t)
+    (values (play players marbles)
+            (play players (* marbles 100)))))
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/10.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/10.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,56 @@
+(defpackage :advent/2018/10 #.cl-user::*advent-use*)
+(in-package :advent/2018/10)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun parse-line (line)
+  (destructuring-bind (x y vx vy) line
+    (cons (complex x y)
+          (complex vx vy))))
+
+(defun x (star)
+  (realpart (car star)))
+
+(defun y (star)
+  (imagpart (car star)))
+
+(defun tick (stars)
+  (dolist (star stars)
+    (incf (car star) (cdr star))))
+
+(defun bounds (stars)
+  (values (x (extremum stars '< :key #'x)) ; left
+          (x (extremum stars '> :key #'x)) ; right
+          (y (extremum stars '< :key #'y)) ; bottom
+          (y (extremum stars '> :key #'y)))) ; top
+
+(defun field-size (stars)
+  (multiple-value-bind (left right bottom top)
+      (bounds stars)
+    (* (- right left) (- top bottom))))
+
+(defun draw (stars)
+  (multiple-value-bind (left right bottom top) (bounds stars)
+    (let* ((height (1+ (- top bottom)))
+           (width (1+ (- right left)))
+           (field (make-array height)))
+      (do-array (line field)
+        (setf line (make-string width :initial-element #\space)))
+      (dolist (star stars)
+        (setf (aref (aref field (- (y star) bottom))
+                    (- (x star) left))
+              #\*))
+      (map nil #'write-line field))))
+
+(define-problem (2018 10) (data read-lines-of-numbers-and-garbage)
+  (iterate
+    (with stars = (mapcar #'parse-line data))
+    (with ticks = 0)
+    (initially (iterate
+                 (tick stars)
+                 (incf ticks)
+                 (until (< (field-size stars) 3000))))
+    (format t "After tick ~D:~%" ticks)
+    (draw stars)
+    (until (string= "q" (read-line)))
+    (tick stars)))
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/11.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/11.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,59 @@
+(defpackage :advent/2018/11 #.cl-user::*advent-use*)
+(in-package :advent/2018/11)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun cell (x y)
+  (complex x y))
+
+(defun x (cell)
+  (realpart cell))
+
+(defun y (cell)
+  (imagpart cell))
+
+(defun rack-id (cell)
+  (+ (x cell) 10))
+
+(defun power-level (serial-number cell)
+  (-<> (rack-id cell)
+    (* <> (y cell))
+    (+ <> serial-number)
+    (* <> (rack-id cell))
+    (nth-digit 2 <>)
+    (- <> 5)))
+
+(define-problem (2018 11) (serial-number read)
+  (let ((totals (make-array (list 300 300))))
+    (flet ((gref (x y)
+             (let ((x (1- x))
+                   (y (1- y)))
+               (if (array-in-bounds-p totals x y)
+                 (aref totals x y)
+                 0)))
+           ((setf gref) (value x y)
+            (setf (aref totals (1- x) (1- y)) value)))
+      (iterate (for-nested ((x :from 300 :downto 1)
+                            (y :from 300 :downto 1)))
+               (setf (gref x y)
+                     (+ (power-level serial-number (cell x y))
+                        (gref (1+ x) y)
+                        (gref x (1+ y))
+                        (- (gref (1+ x) (1+ y))))))
+      (labels ((square-power (x y n)
+                 (let ((xn (+ x n))
+                       (yn (+ y n)))
+                   (+ (gref x y)
+                      (- (gref xn y))
+                      (- (gref x yn))
+                      (gref xn yn))))
+               (largest-square (n)
+                 (iterate
+                   (for-nested ((x :from 1 :to (- 301 n))
+                                (y :from 1 :to (- 301 n))))
+                   (for power = (square-power x y n))
+                   (finding (list x y power) :maximizing power))))
+        (values (subseq (largest-square 3) 0 2)
+                (iterate (for n :from 1 :to 300)
+                         (for (x y power) = (largest-square n))
+                         (finding (list x y n) :maximizing power)))))))
+
diff -r e3e015ad324c -r 75998992ab3c src/2018/12.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/12.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,99 @@
+(defpackage :advent/2018/12 #.cl-user::*advent-use*)
+(in-package :advent/2018/12)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(defstruct pots data min max)
+
+(defmethod print-object ((o pots) s)
+  (print-unreadable-object (o s :type t)
+    (format s "~D to ~D: ~A" (pots-min o) (pots-max o)
+            (iterate (for i :from (pots-min o) :to (pots-max o))
+                     (collect (if (zerop (gethash i (pots-data o) 0)) #\. #\#)
+                              :result-type 'string)))))
+(defun rune-bit (rune)
+  (ecase rune
+    (#\# 1)
+    (#\. 0)))
+
+(defun runes-to-bits (runes)
+  (map 'list #'rune-bit runes))
+
+(defun list-to-hash-table (list)
+  (iterate (for value :in list)
+           (for i :from 0)
+           (when (plusp value)
+             (collect-hash (i value) :test 'eq))))
+
+(defun surroundings-key (ll l x r rr)
+  (declare (type bit ll l x r rr))
+  (+ (* (expt 2 0) ll)
+     (* (expt 2 1) l)
+     (* (expt 2 2) x)
+     (* (expt 2 3) r)
+     (* (expt 2 4) rr)))
+
+(defun parse-initial-line (line)
+  (ppcre:register-groups-bind
+      (state)
+      (#?r"initial state: (\S+)" line)
+    (list-to-hash-table (runes-to-bits state))))
+
+(defun parse-rule (line)
+  (ppcre:register-groups-bind
+      (surroundings result)
+      (#?r"(\S+) => (\S)" line)
+    (values (apply #'surroundings-key (runes-to-bits surroundings))
+            (rune-bit (aref result 0)))))
+
+(defun surroundings (state i)
+  (let ((data (pots-data state)))
+    (surroundings-key (gethash (- i 2) data 0)
+                      (gethash (- i 1) data 0)
+                      (gethash i data 0)
+                      (gethash (+ i 1) data 0)
+                      (gethash (+ i 2) data 0))))
+
+(defun tick (state rules)
+  (with-slots (data min max) state
+    (iterate
+      (for i :from (- min 2) :to (+ max 2))
+      (for current = (gethash i data 0))
+      (for surroundings = (surroundings state i))
+      (for next = (aref rules surroundings))
+      (when (plusp next)
+        (minimizing i :into next-min)
+        (maximizing i :into next-max))
+      (when (/= current next)
+        (if (plusp next)
+          (collect i :into add)
+          (collect i :into rem)))
+      (finally
+        (dolist (i add) (setf (gethash i data) 1))
+        (dolist (i rem) (remhash i data))
+        (setf min next-min
+              max next-max)
+        state))))
+
+(define-problem (2018 12) (data)
+  (let* ((initial (parse-initial-line (read-line data)))
+         (state (prog1 (make-pots :data initial
+                                  :min (extremum (hash-table-keys initial) '<)
+                                  :max (extremum (hash-table-keys initial) '>))
+                  (read-line data)))
+         (rules (iterate
+                  (with rules = (make-array (expt 2 5) :initial-element 1))
+                  (for line :in-stream data :using #'read-line)
+                  (until (string= "" line))
+                  (for (values key result) = (parse-rule line))
+                  (setf (aref rules key) result)
+                  (finally (return rules)))))
+    (values
+      (progn (do-repeat 20
+               (tick state rules))
+             (summation (hash-table-keys (pots-data state))))
+      (progn (dotimes (i (- 500000 20))
+               (when (dividesp i 1000)
+                 (pr i))
+               (tick state rules))
+             (summation (hash-table-keys (pots-data state)))))))
diff -r e3e015ad324c -r 75998992ab3c src/2018/main.lisp
--- a/src/2018/main.lisp	Mon Dec 10 00:51:46 2018 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,290 +0,0 @@
-(in-package :advent)
-(named-readtables:in-readtable :interpol-syntax)
-
-;;;; Problems -----------------------------------------------------------------
-(define-problem (2018 1 1) (data read-all-from-file)
-  (summation data))
-
-(define-problem (2018 1 2) (data read-all-from-file)
-  (setf (cdr (last data)) data) ; make data a circular list for easy looping
-  (iterate
-    (with seen = (make-hash-set :initial-contents '(0)))
-    (for number :in data)
-    (summing number :into frequency)
-    (if (hset-contains-p seen frequency)
-      (return frequency)
-      (hset-insert! seen frequency))))
-
-
-(define-problem (2018 2 1) (data read-lines-from-file)
-  (let* ((freqs (mapcar #'frequencies data))
-         (counts (mapcar #'hash-table-values freqs)))
-    (* (count 2 counts :test #'member)
-       (count 3 counts :test #'member))))
-
-(define-problem (2018 2 2) (data read-lines-from-file)
-  ;; just brute force it
-  (multiple-value-bind (a b)
-      (iterate
-        (for (a . remaining) :on data)
-        (for b = (find 1 remaining :key (curry #'hamming-distance a)))
-        (when b
-          (return (values a b))))
-    (let ((i (mismatch a b)))
-      (str:concat (subseq a 0 i)
-                  (subseq a (1+ i))))))
-
-
-(defstruct claim id left right top bottom)
-
-(define-problem (2018 3) (data read-lines-from-file)
-  (labels ((parse-claim (line)
-             (ppcre:register-groups-bind
-                 ((#'parse-integer id col row width height))
-                 (#?/#(\d+) @ (\d+),(\d+): (\d+)x(\d+)/ line)
-               (make-claim :id id
-                           :left col
-                           :top row
-                           :right (+ col width)
-                           :bottom (+ row height))))
-           (claims-intersect-p (claim1 claim2)
-             (not (or (<= (claim-right claim2) (claim-left claim1))
-                      (<= (claim-right claim1) (claim-left claim2))
-                      (>= (claim-top claim2) (claim-bottom claim1))
-                      (>= (claim-top claim1) (claim-bottom claim2))))))
-    (let ((claims (mapcar #'parse-claim data))
-          (fabric (make-array (list 1000 1000) :initial-element 0)))
-      (dolist (claim claims)
-        (do-range ((row (claim-top claim) (claim-bottom claim))
-                   (col (claim-left claim) (claim-right claim)))
-          (incf (aref fabric row col))))
-      (values
-        (iterate (for uses :in-array fabric)
-                 (counting (> uses 1)))
-        (claim-id (first (unique claims :test #'claims-intersect-p)))))))
-
-
-(define-problem (2018 4) (data read-lines-from-file)
-  ;; This problem gets much easier after you've unlocked the second question and
-  ;; realize you can solve everything by building histograms of each guard's
-  ;; sleeping minutes.
-  (labels ((parse-line (line)
-             "Parse `line` into `(minute :event id?)`"
-             (ppcre:register-groups-bind
-                 ((#'parse-integer minute) event)
-                 (#?/\[\d+-\d+-\d+ \d+:(\d+)\] (.*)/ line)
-               (list* minute
-                      (cond
-                        ((string= "falls asleep" event) (list :sleep nil))
-                        ((string= "wakes up" event) (list :wake nil))
-                        (t (ppcre:register-groups-bind
-                               ((#'parse-integer id))
-                               (#?/Guard #(\d+) begins shift/ event)
-                             (list :guard id)))))))
-           (sleep-intervals (events &aux start guard)
-             "Transform `events` into a list of `(guard-id start end)`"
-             (iterate
-               (for (minute event id?) :in events)
-               (ecase event
-                 (:guard (setf guard id?))
-                 (:wake (collect (list guard start minute)))
-                 (:sleep (setf start minute)))))
-           (guard-histograms (intervals)
-             "Return a hash-table of histograms of the guards' sleeping minutes."
-             (iterate
-               (with result = (make-hash-table))
-               (for (guard start end) :in intervals)
-               (for histogram = (ensure-gethash guard result
-                                                (make-array 60 :initial-element 0)))
-               (do-range ((minute start end))
-                 (incf (aref histogram minute)))
-               (finally (return result)))))
-    (let ((guard-histograms (-<> data
-                              (sort <> #'string<)
-                              (mapcar #'parse-line <>)
-                              sleep-intervals
-                              guard-histograms)))
-      (nest
-        (destructuring-bind
-            (sleepy-guard sleepy-guard-preferred-minute)
-            (iterate
-              (for (guard histogram) :in-hashtable guard-histograms)
-              (finding (list guard
-                             (nth-value 1 (extremum+ histogram #'>)))
-                       :maximizing (summation histogram))))
-        (destructuring-bind
-            (predictable-guard predictable-guard-time)
-            (iterate
-              (for (guard histogram) :in-hashtable guard-histograms)
-              (for (values time preferred-minute) = (extremum+ histogram #'>))
-              (finding (list guard preferred-minute) :maximizing time)))
-        (values (* sleepy-guard
-                   sleepy-guard-preferred-minute)
-                (* predictable-guard
-                   predictable-guard-time))))))
-
-(define-problem (2018 5) (data read-file-into-string)
-  (setf data (remove #\newline data))
-  (labels ((reactivep (x y)
-             (char= x (char-invertcase y)))
-           (react (string &aux result)
-             (doseq (char string)
-               (if (and result (reactivep char (car result)))
-                 (pop result)
-                 (push char result)))
-             (coerce (nreverse result) 'string)))
-    (values (length (react data))
-            (iterate
-              (for unit :in-vector (remove-duplicates data :test #'char-equal))
-              (for candidate = (react (remove unit data :test #'char-equal)))
-              (minimizing (length candidate))))))
-
-
-(define-problem (2018 6) (data read-lines-from-file)
-  (flet ((parse-line (line)
-           (apply #'complex (mapcar #'parse-integer (str:split ", " line))))
-         (closest (point coordinates)
-           (let ((results (extremums coordinates '<
-                                     :key (curry #'manhattan-distance point))))
-             (case (length results)
-               (1 (car results))
-               (t nil)))))
-    (let* ((coordinates (mapcar #'parse-line data))
-           (xs (mapcar #'realpart coordinates))
-           (ys (mapcar #'imagpart coordinates))
-           (left (extremum xs #'<))
-           (bottom (extremum ys #'<))
-           (right (extremum xs #'>))
-           (top (extremum ys #'>))
-           (counts (make-hash-table))
-           (infinite (make-hash-set)))
-      (iterate
-        (for-nested ((x :from left :to right)
-                     (y :from bottom :to top)))
-        (for closest = (closest (complex x y) coordinates))
-        (when closest
-          (incf (gethash closest counts 0))
-          (when (or (= left x) (= bottom y)
-                    (= right x) (= top y))
-            (hset-insert! infinite closest))))
-      (values
-        (iterate
-          (for (point size) :in-hashtable counts)
-          (unless (hset-contains-p infinite point)
-            (maximizing size)))
-        (iterate
-          (for-nested ((x :from left :to right)
-                       (y :from bottom :to top)))
-          (for point = (complex x y))
-          (for total-distance = (summation coordinates :key (curry #'manhattan-distance point)))
-          (counting (< total-distance 10000)))))))
-
-
-(define-problem (2018 7) (data read-lines-from-file)
-  (labels ((parse-line (line)
-             (ppcre:register-groups-bind
-                 (((rcurry #'aref 0) requirement target))
-                 (#?/Step (\w) must be finished before step (\w) can begin./ line)
-               (list target requirement)))
-           (make-graph (edges)
-             (let* ((vertices (remove-duplicates (flatten-once edges)))
-                    (graph (digraph:make-digraph :initial-vertices vertices)))
-               (dolist (edge edges)
-                 (digraph:insert-edge graph (first edge) (second edge)))
-               graph))
-           (char-number (char)
-             (1+ (- (char-code char) (char-code #\A))))
-           (task-length (task)
-             (+ 60 (char-number task)))
-           (decrement-workers (workers)
-             (gathering
-               (do-array (worker workers)
-                 (when worker
-                   (when (zerop (decf (cdr worker)))
-                     (gather (car worker))
-                     (setf worker nil)))))))
-    (values
-      (let ((graph (make-graph (mapcar #'parse-line data))))
-        ;; (digraph.dot:draw graph)
-        (recursively ((result nil))
-          (if (emptyp graph)
-            (coerce (nreverse result) 'string)
-            (let ((next (extremum (digraph:leafs graph) 'char<)))
-              (digraph:remove-vertex graph next)
-              (recur (cons next result))))))
-      (iterate
-        (with graph = (make-graph (mapcar #'parse-line data)))
-        ;; workers is a vector of (task . remaining-time) conses,
-        ;; or NILs for idle workers
-        (with workers = (make-array 5 :initial-element nil))
-        ;; (pr elapsed workers)
-        (for elapsed :from 0)
-        (for finished-tasks = (decrement-workers workers))
-        (map nil (curry #'digraph:remove-vertex graph) finished-tasks)
-        (for current-tasks = (remove nil (map 'list #'car workers)))
-        (for available-tasks = (-<> graph
-                                 digraph:leafs
-                                 (set-difference <> current-tasks)
-                                 (sort <> 'char<)))
-        (do-array (worker workers)
-          (when (null worker)
-            (when-let ((task (pop available-tasks)))
-              (setf worker (cons task (task-length task))))))
-        (when (and (emptyp graph) (every #'null workers))
-          (return elapsed))))))
-
-
-(define-problem (2018 8) (data)
-  (labels
-      ((make-node (children metadata) (cons metadata children))
-       (children (node) (cdr node))
-       (metadata (node) (car node))
-       (read-node (stream)
-         (let* ((children-count (read stream))
-                (metadata-count (read stream))
-                (children (iterate
-                            (repeat children-count)
-                            (collect (read-node stream) :result-type vector)))
-                (metadata (iterate
-                            (repeat metadata-count)
-                            (collect (read stream)))))
-           (make-node children metadata)))
-       (node-value (node &aux (children (children node)))
-         (if (emptyp children)
-           (summation (metadata node))
-           (iterate
-             (for meta :in (metadata node))
-             (for index = (1- meta))
-             (when (array-in-bounds-p children index)
-               (summing (node-value (aref children index))))))))
-    (let ((root (read-node data)))
-      (values
-        (recursively ((node root))
-          (+ (summation (metadata node))
-             (summation (children node) :key #'recur)))
-        (node-value root)))))
-
-
-(define-problem (2018 9) (data read-file-into-string)
-  (ppcre:register-groups-bind
-      ((#'parse-integer players marbles))
-      (#?/(\d+) players\D*(\d+) points/ data)
-    (labels
-        ((play (players marbles)
-           (let ((circle (ring 0))
-                 (elves (make-array players :initial-element 0)))
-             (iterate
-               (declare (iterate:declare-variables))
-               (for elf :first 0 :then (mod (1+ elf) players))
-               (for marble :from 1 :to marbles)
-               (if (dividesp marble 23)
-                 (progn (incf (aref elves elf) marble)
-                        (ring-movef circle -7)
-                        (incf (aref elves elf) (ring-data circle))
-                        (ring-cutf circle))
-                 (progn (ring-movef circle 1)
-                        (ring-insertf-after circle marble))))
-             (extremum elves '>))))
-      #+sbcl (sb-ext:gc :full t)
-      (values (play players marbles)
-              (play players (* marbles 100))))))
diff -r e3e015ad324c -r 75998992ab3c src/old/2015/2015.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/old/2015/2015.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,898 @@
+; https://bitbucket.org/sjl/beef
+(ql:quickload "beef")
+(ql:quickload "alexandria")
+(ql:quickload "split-sequence")
+(ql:quickload "cl-arrows")
+(ql:quickload "fset")
+(ql:quickload "cl-ppcre")
+(ql:quickload "ironclad")
+(ql:quickload "smug")
+(ql:quickload "bit-smasher")
+(ql:quickload "optima")
+
+(defpackage #:advent
+  (:use #:cl)
+  (:use #:cl-arrows)
+  (:use #:split-sequence)
+  (:use #:smug))
+
+(in-package #:advent)
+
+(declaim (optimize (debug 3)))
+
+;;;; Day 1
+(defun instruction-to-num (ch)
+  (cond
+    ((eql ch #\() 1)
+    ((eql ch #\)) -1)
+    (t 0)))
+
+(defun advent-1-1 ()
+  (loop :for c :across (beef:slurp "data/1")
+        :sum (instruction-to-num c)))
+
+(defun advent-1-2 ()
+  (loop :for c :across (beef:slurp "data/1")
+        :sum (instruction-to-num c) :into floor
+        :sum 1
+        :until (= floor -1)))
+
+
+;;;; Day 2
+(defun advent-2-data ()
+  (->> (beef:slurp "data/2")
+       beef:trim-whitespace-right
+       beef:split-lines
+       (mapcar (lambda (s)
+                 (->> s
+                      (split-sequence #\x)
+                      (mapcar #'parse-integer))))))
+
+(defun advent-2-1 ()
+  (loop :for dims :in (advent-2-data)
+        :for (w h l) = dims
+        :for sides = (list (* w h)
+                           (* w l)
+                           (* h l))
+        :for paper = (* 2 (apply #'+ sides))
+        :for slack = (apply #'min sides)
+        :sum (+ paper slack)))
+
+(defun advent-2-2 ()
+  (loop :for dims :in (advent-2-data)
+        :for (w h l) = dims
+        :for sides = (list (* 2 (+ w h))
+                           (* 2 (+ w l))
+                           (* 2 (+ h l)))
+        :for ribbon = (apply #'min sides)
+        :for bow = (apply #'* dims)
+        :sum (+ ribbon bow)))
+
+
+;;;; Day 3
+(defun advent-3-data ()
+  (beef:trim-whitespace (beef:slurp "data/3")))
+
+(defun instruction-to-offsets (instruction)
+  (case instruction
+    (#\> '(1 0))
+    (#\< '(-1 0))
+    (#\^ '(0 1))
+    (#\v '(0 -1))))
+
+(defun step-santa (loc dir)
+  (destructuring-bind (x y) loc
+    (destructuring-bind (dx dy) (instruction-to-offsets dir)
+      (list (+ x dx) (+ y dy)))))
+
+(defun houses (data)
+  (loop
+    :with loc = '(0 0)
+    :with visited = (fset:set '(0 0))
+    :for dir :across data
+    :do (setq loc (step-santa loc dir))
+    :do (fset:includef visited loc)
+    :finally (return visited)))
+
+(defun advent-3-1 (data)
+  (fset:size (houses data)))
+
+(defun advent-3-2 (data)
+  (fset:size
+    (fset:union
+      ;                                 come directly at me
+      (houses (ppcre:regex-replace-all "(.)." data "\\1"))
+      (houses (ppcre:regex-replace-all ".(.)" data "\\1")))))
+
+
+;;;; Day 4
+(defun advent-4-data ()
+  "ckczppom")
+
+(defun md5 (str)
+  (ironclad:byte-array-to-hex-string
+    (ironclad:digest-sequence :md5
+                              (ironclad:ascii-string-to-byte-array str))))
+
+(defun mine (data zeroes)
+  (let ((target (apply #'concatenate 'string
+                       (loop :repeat zeroes :collect "0"))))
+    (loop :for i :upfrom 1
+          :for hash = (->> i
+                           prin1-to-string
+                           (concatenate 'string data)
+                           md5)
+          :until (equal target (subseq hash 0 zeroes))
+          :finally (return i))))
+
+(defun advent-4-1 (data)
+  (mine data 5))
+
+(defun advent-4-2 (data)
+  (mine data 6))
+
+
+;;;; Day 5
+(defun advent-5-data ()
+  (-> "data/5"
+      beef:slurp
+      beef:trim-whitespace-right
+      beef:split-lines))
+
+(defun join-strings (strings delim)
+  "Join strings into a single string with the given delimiter string interleaved.
+
+   Delim must not contain a ~.
+
+   "
+  (format nil (concatenate 'string "~{~A~^" delim "~}") strings))
+
+
+(defparameter *bad-pairs* '("ab" "cd" "pq" "xy"))
+
+(defun count-vowels (s)
+  (length (ppcre:regex-replace-all "[^aeiou]" s "")))
+
+(defun has-run (s)
+  (when (ppcre:scan "(.)\\1" s) t))
+
+(defun has-bad (s)
+  (when (ppcre:scan (join-strings *bad-pairs* "|") s) t))
+
+(defun is-nice (s)
+  (and (>= (count-vowels s) 3)
+       (has-run s)
+       (not (has-bad s))))
+
+(defun advent-5-1 (data)
+  (count-if #'is-nice data))
+
+(defun has-run-2 (s)
+  (when (ppcre:scan "(..).*\\1" s) t))
+
+(defun has-repeat (s)
+  (when (ppcre:scan "(.).\\1" s) t))
+
+(defun is-nice-2 (s)
+  (and (has-run-2 s)
+       (has-repeat s)))
+
+(defun advent-5-2 (data)
+  (count-if #'is-nice-2 data))
+
+
+;;;; Day 6
+(defun advent-6-data ()
+  (beef:slurp-lines "data/6" :ignore-trailing-newline t))
+
+(defmacro loop-array (arr name &rest body)
+  (let ((i (gensym "index")))
+    `(loop :for ,i :below (array-total-size ,arr)
+           :for ,name = (row-major-aref ,arr ,i)
+           ,@body)))
+
+(defun parse-indexes (s)
+  (->> s
+       (split-sequence #\,)
+       (mapcar #'parse-integer)))
+
+(defun flip (b)
+  (if (zerop b) 1 0))
+
+(defun parse-line (line)
+  (let ((parts (split-sequence #\space line)))
+    (list (parse-indexes (beef:index parts -3))
+          (parse-indexes (beef:index parts -1))
+          (cond
+            ((equal (car parts) "toggle") :toggle)
+            ((equal (cadr parts) "on") :on)
+            ((equal (cadr parts) "off") :off)
+            (t (error "Unknown operation!"))))))
+
+(defmacro loop-square (r c from-row from-col to-row to-col &rest body)
+  `(loop :for ,r :from ,from-row :to ,to-row
+         :do (loop :for ,c :from ,from-col :to ,to-col
+                   ,@body)))
+
+(defun advent-6-1 (data)
+  (let ((lights (make-array '(1000 1000) :element-type 'bit)))
+    (loop
+      :for line :in data
+      :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
+      :do (loop-square
+            r c from-row from-col to-row to-col
+            :do (setf (bit lights r c)
+                      (case operation
+                        (:toggle (flip (bit lights r c)))
+                        (:on 1)
+                        (:off 0)
+                        (t 0)))))
+    (loop-array lights b
+                :sum b)))
+
+(defun advent-6-2 (data)
+  (let ((lights (make-array '(1000 1000) :element-type 'integer)))
+    (loop
+      :for line :in data
+      :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
+      :do (loop-square
+            r c from-row from-col to-row to-col
+            :do (case operation
+                  (:toggle (incf (aref lights r c) 2))
+                  (:on (incf (aref lights r c)))
+                  (:off (when (not (zerop (aref lights r c)))
+                          (decf (aref lights r c)))))))
+    (loop-array lights b
+                :sum b)))
+
+
+;;;; Day 7
+(defun advent-7-data ()
+  (beef:slurp-lines "data/7" :ignore-trailing-newline t))
+
+(defun advent-7-2-data ()
+  (beef:slurp-lines "data/7-2" :ignore-trailing-newline t))
+
+(defun int->bits (i)
+  (bitsmash:bits<- (format nil "~4,'0X" i)))
+
+(defun bit-lshift (bit-array distance)
+  (replace (make-array (length bit-array) :element-type 'bit)
+           bit-array
+           :start1 0
+           :start2 (bitsmash:int<- distance)))
+
+(defun bit-rshift (bit-array distance)
+  (let ((width (length bit-array))
+        (distance (bitsmash:int<- distance)))
+    (replace (make-array width :element-type 'bit)
+             bit-array
+             :start1 distance
+             :end2 (- width distance))))
+
+(defun .zero-or-more (parser)
+  (.plus (.let* ((x parser)
+                 (xs (.zero-or-more parser)))
+           (.identity (cons x xs)))
+         (.identity ())))
+
+(defun .one-or-more (parser)
+  (.let* ((x parser)
+          (y (.zero-or-more parser)))
+    (.identity (cons x y))))
+
+(defun parse-7 (line)
+  (labels ((.whitespace ()
+             (.first (.one-or-more (.is 'member '(#\space #\tab)))))
+           (.arrow ()
+             (.first (.string= "->")))
+           (.number ()
+             (.let* ((digits (.first (.one-or-more (.is 'digit-char-p)))))
+                    (.identity (parse-integer (concatenate 'string digits)))))
+           (.wire ()
+             (.let* ((chars (.first (.one-or-more (.is 'lower-case-p)))))
+                    (.identity (concatenate 'string chars))))
+           (.source ()
+             (.or (.wire) (.number)))
+           (.string-choice (strs)
+             (if (not strs)
+               (.fail)
+               (.or (.string= (car strs))
+                    (.string-choice (cdr strs)))))
+           (.dest ()
+             (.progn (.whitespace) (.arrow) (.whitespace)
+                     (.wire)))
+           (.constant-source ()
+             (.let* ((val (.source)))
+                    (.identity (list #'identity (list val)))))
+           (.binary-op ()
+             (let ((ops '(("AND" . bit-and)
+                          ("OR" . bit-ior)
+                          ("LSHIFT" . bit-lshift)
+                          ("RSHIFT" . bit-rshift))))
+               (.let* ((name (.string-choice (mapcar #'car ops))))
+                      (.identity (cdr (assoc name ops :test #'equal))))))
+           (.binary-source ()
+             (.let* ((left (.source))
+                     (_ (.whitespace))
+                     (op (.binary-op))
+                     (_ (.whitespace))
+                     (right (.source)))
+                    (.identity (list op (list left right)))))
+           (.unary-op ()
+             (.let* ((_ (.string= "NOT")))
+                    (.identity #'bit-not)))
+           (.unary-source ()
+             (.let* ((op (.unary-op))
+                     (_ (.whitespace))
+                     (source (.source)))
+                    (.identity (list op (list source)))))
+           (.instruction ()
+             (.let* ((source (.or (.binary-source)
+                                  (.unary-source)
+                                  (.constant-source)))
+                     (dest (.dest)))
+                    (.identity (concatenate 'list source (list dest))))))
+    (parse (.instruction) line)))
+
+(defun advent-7-1 (data)
+  (let ((circuit (make-hash-table :test #'equal))
+        (commands (mapcar #'parse-7 data)))
+    (labels ((retrieve (source)
+               (cond
+                 ((stringp source) (gethash source circuit))
+                 ((integerp source) (int->bits source))
+                 (t (error "what?"))))
+             (ready (args)
+               (every #'identity args))
+             (perform (fn args dest)
+               (setf (gethash dest circuit)
+                     (apply fn args)))
+             (try-command (command)
+               "If the command is ready to go, run it and return nil.  Otherwise,
+                return the command itself."
+               (destructuring-bind (fn args dest) command
+                 (let ((vals (mapcar #'retrieve args)))
+                   (if (ready vals)
+                     (progn
+                       (perform fn vals dest)
+                       nil)
+                     command)))))
+      (loop :while commands
+            :do (setf commands
+                  (loop :for command :in commands
+                        :when (try-command command)
+                        :collect :it)))
+      (bitsmash:bits->int (gethash "a" circuit)))))
+
+
+;;;; Day 8
+(defun advent-8-data ()
+  (beef:slurp-lines "data/8" :ignore-trailing-newline t))
+
+
+(defconstant +backslash+ #\\ )
+(defconstant +quote+ #\" )
+
+(defun parse-8 (line)
+  (labels ((.hex-digit ()
+             (.or
+               (.is #'digit-char-p)
+               (.is #'member '(#\a #\b #\c #\d #\e #\f))))
+           (.hex-escape ()
+             (.let* ((_ (.char= #\x))
+                     (a (.hex-digit))
+                     (b (.hex-digit)))
+                    (.identity
+                      (->> (format nil "~A~A" a b)
+                           bitsmash:hex->int
+                           code-char))))
+           (.escaped-char ()
+             (.progn
+               (.char= +backslash+)
+               (.or (.char= +backslash+)
+                    (.char= +quote+)
+                    (.hex-escape))))
+           (.normal-char ()
+             (.is-not 'member (list +backslash+ +quote+)))
+           (.string-char ()
+             (.or (.normal-char)
+                  (.escaped-char)))
+           (.full-string ()
+             (.prog2
+               (.char= +quote+)
+               (.first (.zero-or-more (.string-char)))
+               (.char= +quote+))))
+    (parse (.full-string) line)))
+
+(defun .wrap (fn parser)
+  (.let* ((v parser))
+         (.identity (funcall fn v))))
+
+(defun parse-8-2 (line)
+  (labels ((.special-char ()
+             (.let* ((ch (.or (.char= +backslash+)
+                              (.char= +quote+))))
+                    (.identity (list +backslash+ ch))))
+           (.normal-char ()
+             (.wrap #'list
+                    (.is-not 'member (list +backslash+ +quote+))))
+           (.string-char ()
+             (.or (.normal-char)
+                  (.special-char)))
+           (.full-string ()
+             (.let* ((chars (.zero-or-more (.string-char))))
+                    (.identity (apply #'concatenate 'list chars)))))
+    (append (list +quote+)
+            (parse (.full-string) line)
+            (list +quote+))))
+
+(defun advent-8-1 (data)
+  (loop :for line :in data
+        :for chars = (parse-8 line)
+        :sum (- (length line)
+                (length chars))))
+
+(defun advent-8-2 (data)
+  (loop :for line :in data
+        :for chars = (parse-8-2 line)
+        :sum (- (length chars)
+                (length line))))
+
+
+;;;; Day 9
+(defun advent-9-data ()
+  (beef:slurp-lines "data/9" :ignore-trailing-newline t))
+
+; Thanks Norvig
+; http://norvig.com/paip/gps.lisp
+(defun permutations (bag)
+  "Return a list of all the permutations of the input."
+  ;; If the input is nil, there is only one permutation:
+  ;; nil itself
+  (if (null bag)
+      '(())
+      ;; Otherwise, take an element, e, out of the bag.
+      ;; Generate all permutations of the remaining elements,
+      ;; And add e to the front of each of these.
+      ;; Do this for all possible e to generate all permutations.
+      (mapcan #'(lambda (e)
+                  (mapcar #'(lambda (p) (cons e p))
+                          (permutations
+                            (remove e bag :count 1 :test #'eq))))
+              bag)))
+
+(defun advent-9 (data)
+  (let ((distances (make-hash-table :test #'equal)))
+    (loop :for line :in data
+          :for (a to b _ dist) = (split-sequence #\space line)
+          :for distance = (parse-integer dist)
+          :do (progn
+                (setf (gethash (cons a b) distances) distance)
+                (setf (gethash (cons b a) distances) distance)))
+    (labels ((score-route (route)
+               (optima:match route
+                 ((list _) 0)
+                 ((list* a b _) (+ (gethash (cons a b) distances)
+                                   (score-route (cdr route))))))
+             (dedupe (l)
+               (remove-duplicates l :test #'equal)))
+      (loop :for route :in (->> distances
+                             beef:hash-keys
+                             (mapcar #'car)
+                             dedupe
+                             permutations)
+            :for score = (score-route route)
+            :minimizing score :into min-dist
+            :maximizing score :into max-dist
+            :finally (return (cons min-dist max-dist))))))
+
+
+(defmethod print-object ((object hash-table) stream)
+  (format stream "#HASH{~%~{~{    (~s : ~s)~}~%~}}"
+          (loop for key being the hash-keys of object
+                using (hash-value value)
+                collect (list key value))))
+
+
+;;;; Day 10
+(defun advent-10-data ()
+  "1321131112")
+
+(defun look-and-say (seq)
+  (let ((runs (list))
+        (len 1)
+        (current -1))
+    (flet ((mark-run ()
+             (setf runs (cons current (cons len runs)))))
+    (loop :for n :in seq
+          :do (if (= current n)
+                (incf len)
+                (progn
+                  (when (not (= -1 current))
+                    (mark-run))
+                  (setf len 1)
+                  (setf current n)))
+          :finally (mark-run))
+    (reverse runs))))
+
+(defun iterate (n f data)
+  (declare (optimize speed (debug 0)))
+  (dotimes (_ n)
+    (setf data (funcall f data)))
+  data)
+
+(defun las-to-list (s)
+  (loop :for digit :across s
+        :collect (-> digit string parse-integer)))
+
+(defun advent-10-1 (data)
+  (length (iterate 40 #'look-and-say (las-to-list data))))
+
+(defun advent-10-2 (data)
+  (length (iterate 50 #'look-and-say (las-to-list data))))
+
+
+;;;; Day 11
+(defun advent-11-data ()
+  "vzbxkghb")
+
+
+(defparameter base 26)
+(defparameter ascii-alpha-start (char-code #\a))
+(defun num-to-char (n)
+  (code-char (+ n ascii-alpha-start)))
+
+(defun char-to-num (ch)
+  (- (char-code ch) ascii-alpha-start))
+
+
+(defmacro loop-window (seq width binding-form &rest body)
+  (let ((i (gensym "IGNORE"))
+        (s (gensym "SEQ"))
+        (n (gensym "WIDTH"))
+        (tail (gensym "TAIL")))
+    `(let ((,s ,seq)
+           (,n ,width))
+       (loop :for ,i :upto (- (length ,s) ,n)
+             :for ,tail :on ,s
+             :for ,binding-form = (subseq ,tail 0 ,n)
+             ,@body))))
+
+
+(defun is-straight-3 (l)
+  (destructuring-bind (a b c) l
+    (and (= 1 (- b a))
+         (= 1 (- c b)))))
+
+(defun has-straight-3 (nums)
+  (loop-window nums 3 triplet
+               :thereis (is-straight-3 triplet)))
+
+
+(defparameter bad-chars
+  (mapcar #'char-to-num '(#\i #\l #\o)))
+
+(defun no-bad (nums)
+  (loop :for bad :in bad-chars
+        :never (find bad nums)))
+
+
+(defun two-pairs (nums)
+  (-> nums
+      (loop-window 2 (a b)
+                   :when (= a b)
+                   :collect a)
+      remove-duplicates
+      length
+      (>= 2)))
+
+
+(defun valid (nums)
+  (and (has-straight-3 nums)
+       (no-bad nums)
+       (two-pairs nums)
+       nums))
+
+
+(defun incr-nums (nums)
+  (labels ((inc-mod (x)
+             (mod (1+ x) base))
+           (inc (nums)
+             (if (not nums)
+               '(1)
+               (let ((head (inc-mod (car nums))))
+                 (if (zerop head)
+                   (cons head (inc (cdr nums)))
+                   (cons head (cdr nums)))))))
+    (reverse (inc (reverse nums)))))
+
+
+(defun advent-11-1 (data)
+  (flet ((chars-to-string (chs)
+           (apply #'concatenate 'string (mapcar #'string chs)))
+         (nums-to-chars (nums)
+           (mapcar #'num-to-char nums))
+         (string-to-nums (str)
+           (loop :for ch :across str
+                 :collect (char-to-num ch))))
+    (-> (loop :for pw = (incr-nums (string-to-nums data))
+              :then (incr-nums pw)
+              :thereis (valid pw))
+        nums-to-chars
+        chars-to-string)))
+
+
+;;;; Day 12
+(defun advent-12-data ()
+  (beef:trim-whitespace (beef:slurp "data/12")))
+
+
+(defun parse-json (s)
+  (labels ((.number ()
+             (.let* ((negation (.optional (.char= #\-)))
+                     (digits (.first (.one-or-more (.is 'digit-char-p)))))
+               (.identity (let ((i (parse-integer (concatenate 'string digits)))
+                                (c (if negation -1 1)))
+                            (* i c)))))
+           (.string-char ()
+             (.wrap #'list (.is-not 'member (list +quote+))))
+           (.string-guts ()
+             (.let* ((chars (.zero-or-more (.string-char))))
+               (.identity (apply #'concatenate 'string chars))))
+           (.string ()
+             (.prog2
+               (.char= +quote+)
+               (.string-guts)
+               (.char= +quote+)))
+           (.map-pair ()
+             (.let* ((key (.string))
+                     (_ (.char= #\:))
+                     (value (.expression)))
+               (.identity (cons key value))))
+           (.map-guts ()
+             (.or
+               (.let* ((p (.map-pair))
+                       (_ (.char= #\,))
+                       (remaining (.map-guts)))
+                 (.identity (cons p remaining)))
+               (.wrap #'list (.map-pair))
+               (.identity '())))
+           (.map ()
+             (.prog2
+               (.char= #\{)
+               (.wrap (lambda (v) (cons :map v))
+                      (.map-guts))
+               (.char= #\})))
+           (.array-guts ()
+             (.or
+               (.let* ((item (.expression))
+                       (_ (.char= #\,))
+                       (remaining (.array-guts)))
+                 (.identity (cons item remaining)))
+               (.wrap #'list (.expression))
+               (.identity '())))
+           (.array ()
+             (.prog2
+               (.char= #\[)
+               (.wrap (lambda (v) (cons :array v))
+                      (.array-guts))
+               (.char= #\])))
+           (.expression ()
+             (.or (.array)
+                  (.map)
+                  (.string)
+                  (.number))))
+    (parse (.expression) s)))
+
+(defun walk-sum (v)
+  (cond
+    ((not v) 0)
+    ((typep v 'integer) v)
+    ((typep v 'string) 0)
+    ((eql (car v) :array) (loop :for value in (cdr v)
+                                :sum (walk-sum value)))
+    ((eql (car v) :map) (loop :for (key . value) :in (cdr v)
+                              :sum (walk-sum value)))
+    (:else (error (format nil "wat? ~a" v)))))
+
+(defun walk-sum-2 (v)
+  (cond
+    ((not v) 0)
+    ((typep v 'integer) v)
+    ((typep v 'string) 0)
+    ((eql (car v) :array) (loop :for value in (cdr v)
+                                :sum (walk-sum-2 value)))
+    ((eql (car v) :map)
+     (if (member "red" (mapcar #'cdr (cdr v))
+                 :test #'equal)
+       0
+       (loop :for (key . value) :in (cdr v)
+             :sum (walk-sum-2 value))))
+    (:else (error (format nil "wat? ~a" v)))))
+
+
+(defun advent-12-1 (data)
+  (walk-sum (parse-json data)))
+
+(defun advent-12-2 (data)
+  (walk-sum-2 (parse-json data)))
+
+
+;;;; Day 13
+(defun advent-13-data ()
+  (beef:slurp-lines "data/13" :ignore-trailing-newline t))
+
+
+(defvar *wat* nil)
+
+(defmacro map-when (test fn val &rest args)
+  (let ((v (gensym "VALUE")))
+    `(let ((,v ,val))
+       (if ,test
+         (apply ,fn ,v ,args)
+         ,v))))
+
+(defun split-lines-13 (lines)
+  (loop :for line :in lines
+        :collect (ppcre:register-groups-bind
+                   (a dir amount b)
+                   ("(\\w+) would (gain|lose) (\\d+) .*? next to (\\w+)."
+                    line)
+                   (list a b (map-when (equal "lose" dir)
+                                       #'-
+                                       (parse-integer amount))))))
+
+(defun rate-seating (vals arrangement)
+  (labels ((find-val (a b)
+             (or (gethash (cons a b) vals) 0))
+           (rate-one-direction (arr)
+             (+ (loop-window arr 2 (a b) :sum (find-val a b))
+                (find-val (car (last arr)) (car arr)))))
+    (+ (rate-one-direction arrangement)
+       (rate-one-direction (reverse arrangement)))))
+
+(defun advent-13-1 (data)
+  (let* ((tups (split-lines-13 data))
+         (attendees (remove-duplicates (mapcar #'car tups) :test #'equal))
+         (vals (make-hash-table :test #'equal)))
+    (loop :for (a b val) :in tups
+          :do (setf (gethash (cons a b) vals) val))
+    (loop :for arrangement :in (permutations attendees)
+          :maximize (rate-seating vals arrangement))))
+
+(defun advent-13-2 (data)
+  (let* ((tups (split-lines-13 data))
+         (attendees (cons "Self" (remove-duplicates (mapcar #'car tups) :test #'equal)))
+         (vals (make-hash-table :test #'equal)))
+    (loop :for (a b val) :in tups
+          :do (setf (gethash (cons a b) vals) val))
+    (loop :for arrangement :in (permutations attendees)
+          :maximize (rate-seating vals arrangement))))
+
+
+;;;; Day 14
+(defun advent-14-data ()
+  (beef:slurp-lines "data/14" :ignore-trailing-newline t))
+
+
+(defun tick (deer)
+  (destructuring-bind
+    (name speed sprint-period rest-period traveled currently remaining)
+    deer
+    (let ((remaining (1- remaining)))
+      (if (equal currently :resting)
+        (list name speed sprint-period rest-period
+              traveled
+              (if (zerop remaining) :sprinting :resting)
+              (if (zerop remaining) sprint-period remaining))
+        (list name speed sprint-period rest-period
+              (+ traveled speed)
+              (if (zerop remaining) :resting :sprinting)
+              (if (zerop remaining) rest-period remaining))))))
+
+(defun parse-deers (lines)
+  (loop :for line :in lines
+        :collect (ppcre:register-groups-bind
+                   (name speed sprint-period rest-period)
+                   ("(\\w+) can fly (\\d+) km/s for (\\d+) .* (\\d+) seconds."
+                    line)
+                   (list name
+                         (parse-integer speed)
+                         (parse-integer sprint-period)
+                         (parse-integer rest-period)
+                         0
+                         :sprinting
+                         (parse-integer sprint-period)))))
+
+(defun find-leaders (deers)
+  (let ((dist (reduce #'max deers :key (beef:partial #'nth 4))))
+    (remove-if-not (lambda (deer)
+                     (= dist (nth 4 deer)))
+                   deers)))
+
+
+(defun advent-14-1 (data n)
+  (apply #'max
+         (loop :for i :upto n
+               :for deers := (parse-deers data) :then (mapcar #'tick deers)
+               :finally (return (mapcar (beef:partial #'nth 4) deers)))))
+
+(defun advent-14-2 (data n)
+  (let ((scores (make-hash-table :test #'equal))
+        (deers (parse-deers data)))
+    (loop :for (name) :in deers
+          :do (setf (gethash name scores) 0))
+    (loop :for i :upto n
+          :do (setf deers (mapcar #'tick deers))
+          :do (loop :for (name) :in (find-leaders deers)
+                    :do (incf (gethash name scores))))
+    (apply #'max (beef:hash-values scores))))
+
+
+
+;;;; Day 15
+(defun advent-15-data ()
+  (beef:slurp-lines "data/15" :ignore-trailing-newline t))
+
+(defun split-ingredients (line)
+  (ppcre:register-groups-bind
+    (name (#'parse-integer capacity durability flavor texture calories))
+    ("(\\w+): capacity (-?\\d+), durability (-?\\d+), flavor (-?\\d+), texture (-?\\d+), calories (-?\\d+)"
+     line)
+    (list name capacity durability flavor texture calories)))
+
+(defun calc-contribution (ingr amount)
+  (cons (car ingr)
+        (mapcar (beef:partial #'* amount)
+                (cdr ingr))))
+
+(defun calc-contributions (ingrs alist)
+  (mapcar #'calc-contribution ingrs alist))
+
+(defun sum-totals (ingrs)
+  (->> ingrs
+       (mapcar #'cdr)
+       (apply #'mapcar #'+)
+       (mapcar (lambda (x) (if (< x 0) 0 x)))))
+
+(defun advent-15-1 (data)
+  (let ((ingredients (mapcar #'split-ingredients data))
+        (limit 100)
+        (amounts (list)))
+    ; fuckin lol
+    (loop :for a :upto limit :do
+          (loop :for b :upto (- limit a) :do
+                (loop :for c :upto (- limit a b) :do
+                      (setf amounts
+                            (cons (list a b c (- limit a b c))
+                                  amounts)))))
+    (loop :for alist :in amounts
+          :maximize (->> alist
+                         (calc-contributions ingredients)
+                         sum-totals
+                         butlast
+                         (apply #'*)))))
+
+(defun advent-15-2 (data)
+  (let ((ingredients (mapcar #'split-ingredients data))
+        (limit 100)
+        (amounts (list)))
+    ; fuckin lol
+    (loop :for a :upto limit :do
+          (loop :for b :upto (- limit a) :do
+                (loop :for c :upto (- limit a b) :do
+                      (setf amounts
+                            (cons (list a b c (- limit a b c))
+                                  amounts)))))
+    (loop :for alist :in amounts
+          :for val = (->> alist
+                          (calc-contributions ingredients)
+                          sum-totals)
+          :when (= (car (last val)) 500)
+          :maximize (apply #'* (butlast val)))))
+
+
+;;;; Scratch
+#+comment
+(advent-15-2 (advent-15-data))
diff -r e3e015ad324c -r 75998992ab3c src/old/2017/main.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/old/2017/main.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,155 @@
+(in-package :advent)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(define-problem (2017 1 1) (data read-file-of-digits)
+  (iterate
+    (for (x . y) :pairs-of-list data)
+    (when (= x y)
+      (sum x))))
+
+(define-problem (2017 1 2) (data read-file-of-digits)
+  (iterate
+    (with data = (coerce data 'vector))
+    (with length = (length data))
+    (for x :in-vector data)
+    (for iy :modulo length :from (truncate length 2))
+    (for y = (aref data iy))
+    (when (= x y)
+      (sum x))))
+
+
+(define-problem (2017 2 1) (data read-file-of-lines-of-numbers)
+  (flet ((checksum (line)
+           (- (extremum line #'>)
+              (extremum line #'<))))
+    (summation data :key #'checksum)))
+
+(define-problem (2017 2 2) (data read-file-of-lines-of-numbers)
+  (labels ((validp (a b)
+             (dividesp (max a b) (min a b)))
+           (head-valid-p (list)
+             (destructuring-bind (n . remaining) list
+               (some (curry #'validp n) remaining)))
+           (checksum (line)
+             (somelist #'head-valid-p line)))
+    (summation data :key #'checksum)))
+
+
+(define-problem (2017 3 1) (data read-form-from-file)
+  (labels ((manhattan-distance (a b)
+             (+ (abs (- (realpart a)
+                        (realpart b)))
+                (abs (- (imagpart a)
+                        (imagpart b)))))
+           (distance-to-origin (p)
+             (manhattan-distance #c(0 0) p)))
+    (distance-to-origin (advent.spiral:number-coordinates data))))
+
+(define-problem (2017 3 2) (data read-form-from-file)
+  (flet ((neighbors (coord)
+           (gathering
+             (do-irange ((dx -1 1)
+                         (dy -1 1))
+               (unless (= 0 dx dy)
+                 (gather (+ coord (complex dx dy))))))))
+    (iterate
+      (with memory = (make-hash-table))
+      (initially (setf (gethash #c(0 0) memory) 1))
+      (for n :from 2)
+      (for coord = (advent.spiral:number-coordinates n))
+      (for value = (summation (neighbors coord) :key (rcurry #'gethash memory 0)))
+      (finding value :such-that (> value data))
+      (setf (gethash coord memory) value))))
+
+
+(define-problem (2017 4 1) (data read-file-of-lines-of-words)
+  (labels ((contains-duplicates-p (list &key (test #'eql))
+             (iterate (for (head . tail) :on list)
+                      (thereis (member head tail :test test))))
+           (validp (phrase)
+             (not (contains-duplicates-p phrase :test #'string=))))
+    (count-if #'validp data)))
+
+(define-problem (2017 4 2) (data read-file-of-lines-of-words)
+  (labels ((anagramp (string1 string2)
+             (hash-table= (frequencies string1) (frequencies string2)))
+           (contains-anagram-p (phrase)
+             (iterate (for (word . tail) :on phrase)
+                      (thereis (member-if (curry #'anagramp word) tail)))))
+    (count-if-not #'contains-anagram-p data)))
+
+
+(define-problem (2017 5 1) (data read-all-from-file)
+  (iterate
+    (with maze = (coerce data 'simple-vector))
+    (with bound = (1- (length maze)))
+    (with address = 0)
+    (for steps :from 0)
+    (finding steps :such-that (not (<= 0 address bound)))
+    (for offset = (aref maze address))
+    (incf (aref maze address))
+    (incf address offset)))
+
+(define-problem (2017 5 2) (data read-all-from-file)
+  (iterate
+    (with maze = (coerce data 'simple-vector))
+    (with bound = (1- (length maze)))
+    (with address = 0)
+    (for steps :from 0)
+    (finding steps :such-that (not (<= 0 address bound)))
+    (for offset = (aref maze address))
+    (incf (aref maze address)
+          (if (>= offset 3) -1 1))
+    (incf address offset)))
+
+
+(define-problem (2017 6) (data read-all-from-file)
+  (let ((banks (coerce data 'vector))
+        (seen (make-hash-table :test 'equalp)))
+    (labels ((bank-to-redistribute ()
+               (iterate (for blocks :in-vector banks :with-index bank)
+                        (finding bank :maximizing blocks)))
+             (redistribute ()
+               (iterate
+                 (with bank = (bank-to-redistribute))
+                 (with blocks-to-redistribute = (aref banks bank))
+                 (initially (setf (aref banks bank) 0))
+                 (repeat blocks-to-redistribute)
+                 (for b :modulo (length banks) :from (1+ bank))
+                 (incf (aref banks b))))
+             (mark-seen (banks cycles)
+               (setf (gethash (copy-seq banks) seen) cycles)))
+      (iterate
+        (mark-seen banks cycle)
+        (summing 1 :into cycle)
+        (redistribute)
+        (for last-seen = (gethash banks seen))
+        (until last-seen)
+        (finally (return (values cycle (- cycle last-seen))))))))
+
+
+(define-problem (2017 7) (data read-lines-from-file)
+  (labels
+      ((parse-line (line)
+         (ppcre:register-groups-bind
+             (name (#'parse-integer weight) ((curry #'str:split ", ") holding))
+             (#?/(\w+) \((\d+)\)(?: -> (.+))?/ line)
+           (values name weight holding)))
+       (insert-edge (digraph pred succ)
+         (digraph:insert-vertex digraph pred)
+         (digraph:insert-vertex digraph succ)
+         (digraph:insert-edge digraph pred succ))
+       (build-tower (lines)
+         (iterate
+           (with tower = (digraph:make-digraph :test #'equal))
+           (for line :in lines)
+           (for (values name weight holding) = (parse-line line))
+           (collect-hash (name weight) :into weights :test #'equal)
+           (digraph:insert-vertex tower name)
+           (map nil (curry #'insert-edge tower name) holding)
+           (finally (return (values tower weights))))))
+    (multiple-value-bind (tower individual-weights) (build-tower data)
+      (declare (ignore individual-weights))
+      ;; (digraph.dot:draw tower)
+      (first (digraph:roots tower)))))
diff -r e3e015ad324c -r 75998992ab3c src/old/2017/number-spiral.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/old/2017/number-spiral.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,90 @@
+(defpackage :advent.spiral
+  (:use :cl :losh :iterate :advent.quickutils)
+  (:export :number-coordinates))
+
+(in-package :advent.spiral)
+
+(defun layer-side-length (layer)
+  "Return the length of one side of `layer`."
+  (1+ (* 2 layer)))
+
+(defun layer-size (layer)
+  "Return the total size of a number spiral with a final layer of `layer`."
+  (square (layer-side-length layer)))
+
+(defun layer-for-number (number)
+  "Return the index of the layer containing `number`."
+  (ceiling (/ (1- (sqrt number)) 2)))
+
+(defun layer-start (layer)
+  "Return the smallest number in `layer`."
+  (if (zerop layer)
+    1
+    (1+ (layer-size (1- layer)))))
+
+(defun layer-leg-length (layer)
+  "Return the length of one \"leg\" of `layer`."
+  (1- (layer-side-length layer)))
+
+
+(defun leg (layer number)
+  "Return the leg index and offset of `number` in `layer`."
+  (if (= 1 number)
+    (values 0 0)
+    (let ((idx (- number (layer-start layer)))
+          (legsize (layer-leg-length layer)))
+      (values (floor idx legsize)
+              (1+ (mod idx legsize))))))
+
+(defun corner-coordinates (layer leg)
+  "Return the coordinates of the corner starting `leg` in `layer`.
+
+  Leg | Corner
+   0  | Bottom Right
+   1  | Top Right
+   2  | Top Left
+   3  | Bottom Left
+
+  "
+
+  ;; 2   1
+  ;;
+  ;; 3   0
+  (ccase leg
+    (0 (complex layer (- layer)))
+    (1 (complex layer layer))
+    (2 (complex (- layer) layer))
+    (3 (complex (- layer) (- layer)))))
+
+(defun leg-direction (leg)
+  "Return the direction vector for the given `leg`.
+  "
+  ;;    <--
+  ;;   11110
+  ;; | 2   0 ^
+  ;; | 2   0 |
+  ;; v 2   0 |
+  ;;   23333
+  ;;    -->
+  (ccase leg
+    (0 (complex 0 1))
+    (1 (complex -1 0))
+    (2 (complex 0 -1))
+    (3 (complex 1 0))))
+
+
+(defun number-coordinates (number)
+  (nest
+    ;; Find the layer the number falls in.
+    (let ((layer (layer-for-number number))))
+
+    ;; Find which leg of that layer it's in, and how far along the leg it is.
+    (multiple-value-bind (leg offset) (leg layer number))
+
+    ;; Find the coordinates of the leg's corner, and its direction vector.
+    (let ((corner (corner-coordinates layer leg))
+          (direction (leg-direction leg))))
+
+    ;; Start at the corner and add the offset in the leg's direction to find the
+    ;; number's coordinates.
+    (+ corner (* direction offset))))
diff -r e3e015ad324c -r 75998992ab3c src/utils.lisp
--- a/src/utils.lisp	Mon Dec 10 00:51:46 2018 -0500
+++ b/src/utils.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -1,60 +1,85 @@
 (in-package :advent)
 
+;;;; Clipboard ----------------------------------------------------------------
+(defun sh (command &key (input "") output)
+  (uiop:run-program command
+                    :output (when output :string)
+                    :input (make-string-input-stream input)))
+
+(defun pbcopy (object)
+  (sh '("pbcopy") :input (aesthetic-string object))
+  (values))
+
+(defun pbpaste ()
+  (values (sh '("pbpaste") :output t)))
+
+
+;;;; Streams ------------------------------------------------------------------
+(defun ensure-stream (input)
+  (ctypecase input
+    (stream input)
+    (string (make-string-input-stream input))))
+
+(defun ensure-string (input)
+  (ctypecase input
+    (stream (alexandria:read-stream-content-into-string input))
+    (string (copy-seq input))))
+
+
 ;;;; Problems -----------------------------------------------------------------
-(defmacro define-problem ((year day &optional part)
-                          (data-symbol &optional reader)
+(defmacro define-problem ((year day)
+                          (arg &optional (reader 'identity))
                           &body body)
-  (let ((function-name (if part
-                         (symb 'advent- year '- day '/ part)
-                         (symb 'advent- year '- day)))
-        (path (format nil "data/~D/~2,'0D.txt" year day)))
-    `(defun ,function-name ()
-       ,(if (null reader)
-          `(with-open-file (,data-symbol ,path)
-             ,@body)
-          `(let ((,data-symbol (,reader ,path)))
-             ,@body)))))
+  (multiple-value-bind (body declarations docstring)
+      (alexandria:parse-body body :documentation t)
+    (with-gensyms (file)
+      (let ((run (symb 'run)))
+        `(defun ,run (&optional ,arg)
+           ,@(when docstring (list docstring))
+           ,@declarations
+           (let ((,file (unless ,arg (open (problem-data-path ,year ,day)))))
+             (unwind-protect
+                 (progn (setf ,arg (,reader (ensure-stream (or ,arg ,file))))
+                        ,@body)
+               (when ,file (close ,file)))))))))
+
+(defun problem-data-path (year day)
+  (make-pathname
+    :directory `(:relative "data" ,(aesthetic-string year))
+    :name (format nil "~2,'0D" day)
+    :type "txt"))
 
 
 ;;;; Readers ------------------------------------------------------------------
-(defun read-form-from-file (path)
-  "Read the first form from `path`."
-  (with-open-file (s path)
-    (read s)))
-
-(defun read-lines-from-file (path)
-  "Read the lines in `path` into a list of strings."
-  (iterate (for line :in-file path :using #'read-line)
-           (collect line)))
+(defun read-numbers-from-line (line)
+  (mapcar #'parse-integer (ppcre:all-matches-as-strings "-?\\d+" line)))
 
 
-(defun read-file-of-digits (path)
-  "Read all the ASCII digits in `path` into a list of integers.
+(defun read-and-collect (stream reader)
+  (iterate (for value :in-stream stream :using reader)
+           (collect value)))
+
+(defun read-all (stream)
+  "Read all forms from `stream` and return them as a fresh list."
+  (read-and-collect stream #'read))
 
-  Any character in the file that's not an ASCII digit will be silently ignored.
+(defun read-lines (stream)
+  "Read all lines from `stream` and return them as a fresh list of strings."
+  (read-and-collect stream #'read-line))
+
+(defun read-lines-of-numbers-and-garbage (stream)
+  "Read the lines of numbers in `stream` into a list of lists of numbers.
+
+  Numbers can be separated by anything, even garbage.
+
+  Lines without any numbers will be discarded.
 
   "
-  (-<> path
-    read-file-into-string
-    (map 'list #'digit-char-p <>)
-    (remove nil <>)))
-
-(defun read-file-of-lines-of-numbers (path)
-  "Read the lines of numbers in `path` into a list of lists of numbers.
-
-  Each line must consist of whitespace-separated integers.  Empty lines will be
-  discarded.
-
-  "
-  (iterate (for line :in-file path :using #'read-line)
-           (for numbers = (mapcar #'parse-integer (str:words line)))
+  (iterate (for line :in-stream stream :using #'read-line)
+           (for numbers = (read-numbers-from-line line))
            (when numbers
              (collect numbers))))
 
-(defun read-file-of-lines-of-words (path)
-  (iterate (for line :in-file path :using #'read-line)
-           (collect (str:words line))))
-
 
 ;;;; Rings --------------------------------------------------------------------
 (declaim (inline ring-prev ring-next ring-data))
@@ -292,3 +317,23 @@
 
 (defmethod emptyp ((hset hash-set))
   (hset-empty-p hset))
+
+
+(defun-inline nth-digit (n integer &optional (radix 10))
+  "Return the `n`th digit of `integer` in base `radix`, counting from the right."
+  (mod (truncate integer (expt radix n)) radix))
+
+(defun-inlineable integral-image (width height value-function)
+  ;; https://en.wikipedia.org/wiki/Summed-area_table
+  (let ((image (make-array (list width height)))
+        (last-row (1- height))
+        (last-col (1- width)))
+    (dotimes (x width)
+      (dotimes (y height)
+        (setf (aref image x y)
+              (+ (funcall value-function x y)
+                 (if (= x last-col) 0 (aref image (1+ x) y))
+                 (if (= y last-row) 0 (aref image x (1+ y)))
+                 (if (or (= x last-col) (= y last-row))
+                   0
+                   (- (aref image (1+ x) (1+ y))))))))))
diff -r e3e015ad324c -r 75998992ab3c vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Mon Dec 10 00:51:46 2018 -0500
+++ b/vendor/make-quickutils.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -7,16 +7,18 @@
                :compose
                :copy-hash-table
                :curry
+               :deletef
                :ensure-gethash
                :extremum
                :flatten-once
                :hash-table-keys
                :hash-table-values
-               :with-gensyms
                :once-only
                :rcurry
                :read-file-into-string
+               :removef
                :symb
+               :with-gensyms
 
                )
   :package "ADVENT.QUICKUTILS")
diff -r e3e015ad324c -r 75998992ab3c vendor/quickutils.lisp
--- a/vendor/quickutils.lisp	Mon Dec 10 00:51:46 2018 -0500
+++ b/vendor/quickutils.lisp	Sat Dec 15 16:52:29 2018 -0500
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-GETHASH :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :WITH-GENSYMS :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ADVENT.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :DELETEF :ENSURE-GETHASH :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :REMOVEF :SYMB :WITH-GENSYMS) :ensure-package T :package "ADVENT.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "ADVENT.QUICKUTILS")
@@ -15,13 +15,13 @@
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
                                          :COMPOSE :COPY-HASH-TABLE :CURRY
-                                         :ENSURE-GETHASH :EXTREMUM
+                                         :DELETEF :ENSURE-GETHASH :EXTREMUM
                                          :FLATTEN-ONCE :MAPHASH-KEYS
                                          :HASH-TABLE-KEYS :MAPHASH-VALUES
-                                         :HASH-TABLE-VALUES :STRING-DESIGNATOR
-                                         :WITH-GENSYMS :ONCE-ONLY :RCURRY
+                                         :HASH-TABLE-VALUES :ONCE-ONLY :RCURRY
                                          :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
-                                         :READ-FILE-INTO-STRING :MKSTR :SYMB))))
+                                         :READ-FILE-INTO-STRING :REMOVEF :MKSTR
+                                         :SYMB :STRING-DESIGNATOR :WITH-GENSYMS))))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-gensym-list (length &optional (x "G"))
     "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -118,6 +118,16 @@
            (apply ,fun ,@curries more)))))
   
 
+  (declaim (inline delete/swapped-arguments))
+  (defun delete/swapped-arguments (sequence item &rest keyword-arguments)
+    (apply #'delete item sequence keyword-arguments))
+
+  (define-modify-macro deletef (item &rest remove-keywords)
+    delete/swapped-arguments
+    "Modify-macro for `delete`. Sets place designated by the first argument to
+the result of calling `delete` with `item`, place, and the `keyword-arguments`.")
+  
+
   (defmacro ensure-gethash (key hash-table &optional default)
     "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
 under key before returning it. Secondary return value is true if key was
@@ -217,50 +227,6 @@
       values))
   
 
-  (deftype string-designator ()
-    "A string designator type. A string designator is either a string, a symbol,
-or a character."
-    `(or symbol string character))
-  
-
-  (defmacro with-gensyms (names &body forms)
-    "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
-    (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
-    (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
-    `(let ,(mapcar (lambda (name)
-                     (multiple-value-bind (symbol string)
-                         (etypecase name
-                           (symbol
-                            (values name (symbol-name name)))
-                           ((cons symbol (cons string-designator null))
-                            (values (first name) (string (second name)))))
-                       `(,symbol (gensym ,string))))
-            names)
-       ,@forms))
-
-  (defmacro with-unique-names (names &body forms)
-    "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
-    (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
-    (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
-    `(with-gensyms ,names ,@forms))
-  
-
   (defmacro once-only (specs &body forms)
     "Evaluates `forms` with symbols specified in `specs` rebound to temporary
 variables, ensuring that each initform is evaluated only once.
@@ -362,6 +328,16 @@
               :while (= bytes-read buffer-size)))))))
   
 
+  (declaim (inline remove/swapped-arguments))
+  (defun remove/swapped-arguments (sequence item &rest keyword-arguments)
+    (apply #'remove item sequence keyword-arguments))
+
+  (define-modify-macro removef (item &rest remove-keywords)
+    remove/swapped-arguments
+    "Modify-macro for `remove`. Sets place designated by the first argument to
+the result of calling `remove` with `item`, place, and the `keyword-arguments`.")
+  
+
   (defun mkstr (&rest args)
     "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
 
@@ -378,9 +354,53 @@
 See also: `symbolicate`"
     (values (intern (apply #'mkstr args))))
   
+
+  (deftype string-designator ()
+    "A string designator type. A string designator is either a string, a symbol,
+or a character."
+    `(or symbol string character))
+  
+
+  (defmacro with-gensyms (names &body forms)
+    "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+    (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+    (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+    `(let ,(mapcar (lambda (name)
+                     (multiple-value-bind (symbol string)
+                         (etypecase name
+                           (symbol
+                            (values name (symbol-name name)))
+                           ((cons symbol (cons string-designator null))
+                            (values (first name) (string (second name)))))
+                       `(,symbol (gensym ,string))))
+            names)
+       ,@forms))
+
+  (defmacro with-unique-names (names &body forms)
+    "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+    (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+    (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+    `(with-gensyms ,names ,@forms))
+  
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose copy-hash-table curry ensure-gethash extremum flatten-once
-            hash-table-keys hash-table-values with-gensyms with-unique-names
-            once-only rcurry read-file-into-string symb)))
+  (export '(compose copy-hash-table curry deletef ensure-gethash extremum
+            flatten-once hash-table-keys hash-table-values once-only rcurry
+            read-file-into-string removef symb with-gensyms with-unique-names)))
 
 ;;;; END OF quickutils.lisp ;;;;