commit 0372dbdec3d209ba51f73f4a8572505fed15b415 from: Lukas Henkel date: Tue Dec 17 10:24:52 2024 UTC Add optional compiler Just for fun. While the resulting code is much faster than the interpreter, the compile process eats up any speedups and it ends up being slower overall. commit - a757f2ccecb5b65c1c76e6099f2ae82a0d934f08 commit + 0372dbdec3d209ba51f73f4a8572505fed15b415 blob - 36f4d0d9cc3b26f7b345fd09053b10a3c62ff345 blob + 7e73376903a354528d09ed3b9a1abdcca5067893 --- src/day-17.lisp +++ src/day-17.lisp @@ -1,11 +1,16 @@ (defpackage #:aoc/day-17 (:use #:cl #:aoc/utils) (:export + #:*use-compiler* #:make-registers - #:run-program + #:make-program + #:interpret + #:compile-program #:day-17)) (in-package #:aoc/day-17) +(defparameter *use-compiler* nil) + (defun parse-register (line) (parse-integer line :start (1+ (position #\: line)))) @@ -35,11 +40,93 @@ (aref registers (- operand 4)) (error "Invalid operand ~A for combo operator" operand)))) -(defun run-program (registers program) +(declaim (inline adv bxl bst bxc bdv cdv) + (ftype (function ((simple-array fixnum (3)) fixnum) null) adv bxl bst bxc bdv cdv)) + +(defun adv (registers operand) + (setf (aref registers 0) + (floor (aref registers 0) + (the fixnum (expt 2 (the (integer 0 61) + (combo-operand operand registers)))))) + nil) + +(defun bxl (registers operand) + (setf (aref registers 1) + (logxor (aref registers 1) + operand)) + nil) + +(defun bst (registers operand) + (setf (aref registers 1) + (mod (combo-operand operand registers) 8)) + nil) + +(defun bxc (registers operand) + (declare (ignore operand)) + (setf (aref registers 1) + (logxor (aref registers 1) + (aref registers 2))) + nil) + +(defun bdv (registers operand) + (setf (aref registers 1) + (floor (aref registers 0) + (the fixnum (expt 2 (the (integer 0 61) + (combo-operand operand registers)))))) + nil) + +(defun cdv (registers operand) + (setf (aref registers 2) + (floor (aref registers 0) + (the fixnum (expt 2 (the (integer 0 61) + (combo-operand operand registers)))))) + nil) + +(defun make-jump (jump-tags registers op) + `(when (not (zerop (aref ,registers 0))) + (go ,(aref jump-tags op)))) + +(defun make-output (output registers op) + `(push (mod (combo-operand ,op ,registers) 8) ,output)) + +(defun compile-program (program) + (let* ((registers (gensym "REGISTERS")) + (jump-tags (coerce + (loop repeat (/ (length program) 2) + for i from 0 + collect (gensym (format nil "INST-~A" i))) + 'vector)) + (output (gensym "OUTPUT")) + (code (loop for i from 0 below (length program) by 2 + for inst-id from 0 + for inst = (aref program i) + for op = (aref program (1+ i)) + collect (aref jump-tags inst-id) + collect (case inst + (0 `(adv ,registers ,op)) + (1 `(bxl ,registers ,op)) + (2 `(bst ,registers ,op)) + (3 (make-jump jump-tags registers op)) + (4 `(bxc ,registers ,op)) + (5 (make-output output registers op)) + (6 `(bdv ,registers ,op)) + (7 `(cdv ,registers ,op)))))) + (compile nil + `(lambda (,registers) + (declare (optimize speed) + (type (simple-array fixnum (3)) ,registers)) + (let ((,output nil)) + (tagbody + ,@code) + ,output))))) + +(declaim (ftype (function ((simple-array fixnum (3)) simple-vector) list) interpret)) + +(defun interpret (registers code) (loop with output = nil - for ip from 0 below (length program) by 2 - for instruction = (aref program ip) - for operand = (aref program (1+ ip)) + for ip from 0 below (length code) by 2 + for instruction = (aref code ip) + for operand = (aref code (1+ ip)) do (case instruction (0 (setf (aref registers 0) (floor (aref registers 0) @@ -68,13 +155,13 @@ (aref registers 1) (aref original-registers 1) (aref registers 2) (aref original-registers 2))) -(defun task-2 (registers code) +(defun task-2 (registers program code) (let ((original-registers (copy-seq registers))) (labels ((%solve (register-a depth) (loop for n from 0 below 8 for nra = (+ register-a n) do (reset-registers registers original-registers nra) - (let* ((res (run-program registers code)) + (let* ((res (funcall program registers)) (value (nth depth res))) (when (= value (aref code (- (length code) 1 depth))) (when (= depth (1- (length code))) @@ -84,9 +171,16 @@ (return-from %solve solved-register-a)))))))) (%solve 1 0)))) +(defun make-program (code) + (if *use-compiler* + (compile-program code) + (lambda (registers) + (interpret registers code)))) + (defun day-17 (input) (multiple-value-bind (registers code) (parse-input input) - (values - (format nil "~{~A~^,~}" (nreverse (run-program (copy-seq registers) code))) - (task-2 registers code)))) + (let ((program (make-program code))) + (values + (format nil "~{~A~^,~}" (nreverse (funcall program (copy-seq registers)))) + (task-2 registers program code))))) blob - 52665687fc58e4471b012f298f9155f03148cad2 blob + 54d9eae63d17f5c7b0d1a0099ad4d41632fe8b09 --- t/day-17.lisp +++ t/day-17.lisp @@ -2,30 +2,35 @@ (:use #:cl #:lisp-unit2 #:aoc/day-17)) (in-package #:aoc-test/day-17) -(define-test test-day-17 - () +(defun day-17-tests () (let ((registers (make-registers 0 0 9)) - (program (vector 2 6))) - (aoc/day-17:run-program registers program) + (program (make-program (vector 2 6)))) + (funcall program registers) (assert= 1 (aref registers 1))) (let ((registers (make-registers 10 0 0)) - (program (vector 5 0 5 1 5 4))) + (program (make-program (vector 5 0 5 1 5 4)))) (assert-equal (list 0 1 2) - (nreverse (run-program registers program)))) + (nreverse (funcall program registers)))) (let ((registers (make-registers 2024 0 0)) - (program (vector 0 1 5 4 3 0))) + (program (make-program (vector 0 1 5 4 3 0)))) (assert-equal (list 4 2 5 6 7 7 7 7 3 1 0) - (nreverse (run-program registers program))) + (nreverse (funcall program registers))) (assert= 0 (aref registers 0))) (let ((registers (make-registers 0 29 0)) - (program (vector 1 7))) - (run-program registers program) + (program (make-program (vector 1 7)))) + (funcall program registers) (assert= 26 (aref registers 1))) (let ((registers (make-registers 0 2024 43690)) - (program (vector 4 0))) - (run-program registers program) + (program (make-program (vector 4 0)))) + (funcall program registers) (assert= 44354 (aref registers 1))) (let ((registers (make-registers 729)) - (program (vector 0 1 5 4 3 0))) + (program (make-program (vector 0 1 5 4 3 0)))) (assert-equal (list 4 6 3 5 6 3 5 2 1 0) - (nreverse (run-program registers program))))) + (nreverse (funcall program registers))))) + +(define-test test-day-17 + () + (day-17-tests) + (let ((*use-compiler* t)) + (day-17-tests)))