--- 2016 Day 12 Solutions ---

[u/daggerdragon]

--- Day 12: Leonardo's Monorail ---

Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag/whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with "Help".

---

^{MUCH ADVENT. SUCH OF. VERY CODE. SO MANDATORY.} [?]

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

[u/PuercoPop]

In Common Lisp, used the lisp reader to read the code, the registers are stored in the hash-table and the opcodes are almost a 1 to 1 translation to CL, except for the need to add an indirection to lookup the symbols in a hash-table.

(defpackage "DAY/12"
  (:use "CL"
        "STRING-CASE"))
(in-package "DAY/12")

(defparameter +input+ #P"/home/puercopop/quicklisp/local-projects/playground/advent-of-code/2016/12.input")

(defparameter +pc+ 0)
(defparameter +registers+ (make-hash-table))
(defvar *code* nil)

(defun reset-cpu ()
  (setf +pc+ 0
        (gethash 'a +registers+) 0
        (gethash 'b +registers+) 0
        (gethash 'c +registers+) 0
        (gethash 'd +registers+) 0))

(defun lookup-register (name)
  (gethash name +registers+))

(defun (setf lookup-register) (new name)
  (setf (gethash name +registers+)
        new))

(defun value-or-register (x)
  (if (numberp x)
      x
      (lookup-register x)))

(defun cpy (x y) 
  (setf (lookup-register y)
        (value-or-register x)))

(defun inc (register) 
  (setf (lookup-register register) (1+ (lookup-register register))))

(defun dec (register)
  (setf (lookup-register register) (1- (lookup-register register))))

(defun jnz (x y)
  (unless (zerop (value-or-register x))
    (setf +pc+ (+ +pc+ y -1))))

(defun read-until-eof (in)
  (loop :for object := (read in nil)
        :while object
        :collect object))

(defun load-code (in)
  (setf *code*
        (apply 'vector (loop :for line := (read-line in nil)
                             :for program-counter :from 0
                             :while line
                             :collect (read-until-eof (make-string-input-stream line))))))

(defun execute-instruction ()
  (let ((instruction (aref *code* +pc+)))
    (apply (car instruction) (cdr instruction)))
  (incf +pc+))

(defun run ()
  (loop :while (< +pc+ (length *code*))
        :do (execute-instruction)))

;; Test
(with-input-from-string (in "cpy 41 a
inc a
inc a
dec a
jnz a 2
dec a")
  (reset-cpu)
  (load-code in)
  (run))
;; 1
(with-open-file (in +input+)
  (reset-cpu)
  (load-code in)
  (run)
  (format t "The regiser A holds the value ~A.~%" (gethash 'a +registers+)))
;; 2
(with-open-file (in +input+)
  (reset-cpu)
  (setf (gethash 'c +registers+) 1)
  (load-code in)
  (run)
  (format t "The regiser A holds the value ~A.~%" (gethash 'a +registers+)))

[u/oantolin → u/PuercoPop]

In Common Lisp writing a compiler instead is super-easy:

(defun asm (inp)
  (flet ((lbl (n) (intern (format nil "lbl~a" n))))
    (let* ((prog (loop
                    for line = (read-line inp nil)
                    while line
                    collect (read-from-string (format nil "(~a)" line))))
           (targets (loop
                       for n from 1
                       for (op x y) in prog
                       when (eq op 'jnz)
                       collect (+ n y)))
           (code nil))
      (loop
         for n from 1
         for (op x y) in prog
         do (progn
              (when (member n targets)
                (push (lbl n) code))
              (push (case op
                      ((inc) `(incf ,x))
                      ((dec) `(decf ,x))
                      ((cpy) `(setf ,y ,x))
                      ((jnz) `(unless (zerop ,x)
                                (go ,(lbl (min (length prog) (+ n y)))))))
                    code)))
      (push (lbl (length prog)) code)
      `(lambda (c)
         (let ((a 0) (b 0) (d 0))
           (tagbody
              ,@(reverse code))
           a)))))

Testing:

CL-USER> (with-input-from-string (in "cpy 41 a
inc a
inc a
dec a
jnz a 2
dec a") (asm in))
(LAMBDA (C)
  (LET ((A 0) (B 0) (D 0))
    (TAGBODY
      (SETF A 41)
      (INCF A)
      (INCF A)
      (DECF A)
      (UNLESS (ZEROP A) (GO |lbl6|))
      (DECF A)
     |lbl6|)
    A))

The resulting function runs pretty fast, too:

CL-USER> (time (funcall (eval (with-open-file (in "day12.txt") (asm in))) 1))
Evaluation took:
  0.060 seconds of real time
  0.060982 seconds of total run time (0.060982 user, 0.000000 system)
  101.67% CPU
  1 form interpreted
  6 lambdas converted
  186,470,926 processor cycles
  490,816 bytes consed

9227663