commit 35dfaacf7838e916e7bebf9a02c17488493785b6
parent c8859bce66424fc093ae4f999552d80c4bfc0989
Author: Lukas Henkel <lh@entf.net>
Date: Tue, 3 Dec 2024 22:04:02 +0100
Use simple parser generator to generate a parser
This is quite a lot faster than using regex
Diffstat:
| M | src/day-3.lisp | | | 44 | +++++++++++++++++++++++++++----------------- |
| M | src/utils.lisp | | | 55 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++- |
2 files changed, 81 insertions(+), 18 deletions(-)
diff --git a/src/day-3.lisp b/src/day-3.lisp
@@ -1,25 +1,35 @@
(defpackage #:aoc/day-3
(:use #:cl #:aoc/utils)
- (:import-from :cl-ppcre)
(:export #:day-3))
(in-package #:aoc/day-3)
-(defparameter *regex* "(mul\\((\\d+),(\\d+)\\))|((do|don't)\\(\\))")
+(defun try-read-number (stream)
+ (loop while (digit-char-p (peek-char nil stream))
+ collect (read-char stream) into bag
+ finally (return (if bag
+ (parse-integer (coerce bag 'string))
+ nil))))
+
+(define-parser day-3-parser (stream)
+ ((mul-enabled t)
+ (num-1 0)
+ (num-2 0)
+ (task-1 0)
+ (task-2 0))
+ (#\d #\o #\( #\) (setf mul-enabled t))
+ (#\d #\o #\n #\' #\t #\( #\) (setf mul-enabled nil))
+ (#\m #\u #\l #\(
+ (setf num-1 (try-read-number stream))
+ #\,
+ (setf num-2 (try-read-number stream))
+ #\)
+ (let ((result (* num-1 num-2)))
+ (incf task-1 result)
+ (when mul-enabled
+ (incf task-2 result)))))
(defun day-3 (input)
- (let ((input-string (read-stream-content-into-string input))
- (mul-enabled t)
- (task-1 0)
- (task-2 0))
- (ppcre:do-scans (start end reg-starts reg-ends *regex* input-string)
- (case (aref input-string start)
- (#\d
- (setf mul-enabled (char/= (aref input-string (+ start 2)) #\n)))
- (#\m
- (let* ((num-1 (parse-integer input-string :start (aref reg-starts 1) :end (aref reg-ends 1)))
- (num-2 (parse-integer input-string :start (aref reg-starts 2) :end (aref reg-ends 2)))
- (result (* num-1 num-2)))
- (incf task-1 result)
- (when mul-enabled
- (incf task-2 result))))))
+ (multiple-value-bind (mul-enabled num-1 num-2 task-1 task-2)
+ (day-3-parser input)
+ (declare (ignore mul-enabled num-1 num-2))
(values task-1 task-2)))
diff --git a/src/utils.lisp b/src/utils.lisp
@@ -24,7 +24,8 @@
#:manhattan-distance
#:do-map-neighbours
#:read-number-list
- #:find-pattern))
+ #:find-pattern
+ #:define-parser))
(in-package #:aoc/utils)
(defun normalize-type (type)
@@ -208,3 +209,55 @@
for c-2 = (elt list (+ i length))
always (= c-1 c-2))
do (return-from find-pattern length)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun transform-state-table (definitions)
+ (loop with table = (list nil nil)
+ with callbacks = nil
+ with current = nil
+ for definition in definitions
+ do (setf current table)
+ (loop for element in definition
+ do (etypecase element
+ (character
+ (setf current (or (assoc element (cddr current))
+ (car (setf (cdr (last current))
+ (list (list element nil)))))))
+ (list
+ (let ((sym (GENSYM "CALLBACK")))
+ (setf (cadr current) sym)
+ (push (cons sym element) callbacks)))))
+ finally (return (values table
+ callbacks)))))
+
+(defun do-parse (stream table)
+ (loop with current = table
+ with callback = nil
+ with global = t
+ for char = (read-char stream nil)
+ until (null char)
+ do (setf current (assoc char (cddr current))
+ callback (cadr current))
+ (if (or (null current)
+ (and callback
+ (null (funcall (symbol-value callback)))))
+ (progn
+ (setf current table)
+ (unless global
+ (unread-char char stream))
+ (setf global t))
+ (setf global nil))))
+
+(defmacro define-parser (name (stream) (&rest variable-bindings) &body parse-tables)
+ (multiple-value-bind (table callbacks)
+ (transform-state-table parse-tables)
+ (let ((table-var (gensym "TABLE"))
+ (callback-syms (mapcar #'car callbacks)))
+ `(defun ,name (,stream)
+ (let ((,table-var ',table)
+ ,@variable-bindings)
+ (let ,(loop for (sym . code) in callbacks
+ collect `(,sym (lambda () ,code)))
+ (declare (special ,@callback-syms))
+ (do-parse stream ,table-var))
+ (values ,@(mapcar #'car variable-bindings)))))))
