Setup

.dir-locals.el

@@ -0,0 +1,8 @@
+((smalltalk-mode
+  (eval . (unless (featurep 'aoc2024-eutro)
+            (let ((load-path (cons (locate-dominating-file
+                                    (or load-file-name (buffer-file-name))
+                                    "aoc2024-eutro.el")
+                                   load-path)))
+              (require 'aoc2024-eutro))))
+  (eval . (aoc2024-eutro-mode))))

.gitignore

@@ -0,0 +1,6 @@
+*~
+session.key
+input
+.tup
+out
+*.im

Tupfile

@@ -0,0 +1,7 @@
+preload days
+
+!smalltalk = | input/%B.txt |> ./run.sh %g > %o |> out/%B.txt
+
+run ./Tuprules
+
+: foreach days/day*.st |> !smalltalk |>

Tuprules

@@ -0,0 +1,10 @@
+#!/usr/bin/env sh
+
+DIR="$(readlink -f "$(dirname "$0")")"
+cd "$DIR/days" || exit 1
+DAYS_DONE="$(find . -name "day*.st" | sort | tail -1 | sed -E 's/[^0-9]//g')"
+
+for i in $(seq "$DAYS_DONE"); do
+    DAYP="$(printf "%02d" "$i")"
+    echo ": |> ./fetch.sh $i |> input/day$DAYP.txt"
+done

aoc2024-eutro.el

@@ -0,0 +1,50 @@
+;;; aoc2024-eutro.el --- Advent of Code utilities -*- lexical-binding: t -*-
+
+;;; Code:
+
+(require 'smalltalk-mode)
+
+(defgroup aoc2024-eutro nil
+  "Group for Eutro's Advent of Code 2024"
+  :prefix 'aoc2024-eutro-
+  :group 'misc)
+
+(defconst aoc-root
+  (locate-dominating-file
+   (or load-file-name (buffer-file-name))
+   "Tupfile.ini"))
+
+(defconst aoc-dayfile-pattern "day\\([0-9]\\{2\\}\\)")
+
+(defun aoc-day-number ()
+  "Determine the day number of the current file, or the current day."
+  (or
+   (let ((file-name (buffer-file-name)))
+     (and (string-match aoc-dayfile-pattern file-name)
+          (string-to-number (match-string 1 file-name))))
+   (cadr (calendar-current-date))))
+
+(defun aoc-run ()
+  "Run the current day."
+  (interactive)
+  (let ((default-directory aoc-root))
+    (async-shell-command
+     (format  "./run.sh %s" (aoc-day-number))
+     "*aoc-output*"
+     "*aoc-error*")))
+
+(defconst aoc-mode-map
+  (let ((keys (make-sparse-keymap)))
+    (define-key keys (kbd "C-c C-c") #'aoc-run)
+    keys))
+
+(define-minor-mode aoc-mode
+  "Minor mode for Advent of Code utilities"
+  :lighter " AoC24")
+
+;; Local Variables:
+;; read-symbol-shorthands: (("aoc-" . "aoc2024-eutro-"))
+;; End:
+
+(provide 'aoc2024-eutro)
+;;; aoc2024-eutro.el ends here

days/day01.st

@@ -0,0 +1,66 @@
+Object subclass: CharPattern [
+    | pattern assoc next |
+    pattern [ ^pattern ]
+    assoc [ ^assoc ]
+    init: patIn
+    [ pattern := patIn.
+      assoc := patIn tokenize: '\|'.
+      ^self ]
+
+    next: nextPat
+    [ nextPat ifNotNil: [
+        next := nextPat.
+        pattern := pattern,'|',nextPat pattern ] ]
+
+    findIn: line
+    [ ^(line searchRegex: pattern) match ]
+
+    interpWord: word
+    [ ^(assoc indexOf: word ifAbsent: [nil])
+          ifNil: [ next interpWord: word ]
+          ifNotNil: [:it | it - 1] ]
+
+    findAndInterp: line
+    [ ^self interpWord: (self findIn: line) ]
+
+    reversed
+    [ ^(CharPattern
+            new: ((assoc collect: [:it | it reverse])
+                      join: '|'))
+           next: next ]
+]
+
+CharPattern class extend [
+    new: pattern
+    [ | r | r := super new. r init: pattern. ^r ]
+]
+
+String extend [
+    calibration: pat rpat: rpat
+    [ | d1 d2 |
+      d1 := pat findAndInterp: self.
+      d2 := rpat findAndInterp: self reverse.
+      ^(d1 * 10) + d2 ]
+]
+
+OrderedCollection extend [
+    collectPart: pat
+    [ | rpat |
+      rpat := pat reversed.
+      ^self collect: [
+          :line |
+          [ line calibration: pat rpat: rpat ]
+          ifError: [ :exn | exn ]
+      ]
+    ]
+]
+
+pat1 := CharPattern new: '0|1|2|3|4|5|6|7|8|9'.
+pat2 := CharPattern new: 'zero|one|two|three|four|five|six|seven|eight|nine'.
+pat2 next: pat1.
+
+AOC part1: pat1;
+    part2: pat2;
+    arg: [ FileStream stdin toLines ];
+    map: [ :lines :pat | (lines collectPart: pat) sum ];
+    finish.

days/utils.st

@@ -0,0 +1,146 @@
+Object subclass: AOC []
+AOC class extend [
+    | savedP1 savedP2 mapper getArg |
+    part1: p1Block [ savedP1 := p1Block ]
+    part2: p2Block [ savedP2 := p2Block ]
+    map: mapBlock [ mapper := mapBlock ]
+    arg: argBlock [ getArg := argBlock ]
+
+    output: value part: part
+    [ FileStream stdout << 'Part '; << part; << ': '; << value; nl. ]
+
+    runPart: saved part: part arg: arg
+    [ saved ifNotNil: [
+        | mapped |
+        mapped := mapper value: arg value: saved.
+        self output: mapped part: part ] ]
+
+    run
+    [ | arg |
+      arg := getArg value.
+      self runPart: savedP1 part: 1 arg: arg.
+      self runPart: savedP2 part: 2 arg: arg. ]
+
+    "TODO: save as an image?"
+    finish [ self run ]
+]
+
+Iterable extend [
+    sum [ ^self fold: [ :l :r | l + r ] ]
+    toList
+    [ | list |
+      list := OrderedCollection new.
+      self do: [:x | list add: x].
+      ^list ]
+]
+
+Object subclass: ScannerState [
+    | scanner oc dispatch failed |
+    init: sc
+    [ scanner := sc.
+      oc := OrderedCollection new.
+      dispatch := nil.
+      failed := false. ]
+
+    failed [ ^failed ]
+
+    accept: c on: stream
+    [ dispatch ifNotNil:
+          [ :dp | dispatch := nil. dp value: c value: stream ] ifNil:
+          [ (c = $%) ifTrue:
+                [ dispatch := [ :c :stream | self dispatch: c on: stream ] ]
+                ifFalse: [ self require: c on: stream ] ] ]
+
+    dispatch: c on: stream [ (scanner dispatchFor: c) value: self value: stream ]
+    require: c on: stream
+    [ c isSeparator ifTrue:
+          [ stream whilePeek: [ :c | c isSeparator ] do: [ :ignored | nil ] ] ifFalse:
+          [ failed := (stream peekFor: c) not ] ]
+    parseCharOn: stream [ oc add: stream next ]
+    badCmd: c [ self error: 'Bad command' ]
+    finish [ ^oc asArray ]
+
+    parseIntOn: stream
+    [ | d |
+      d := 0.
+      stream whilePeek: [ :c | c isDigit ] do:
+             [ :c | d := d * 10 + c digitValue ].
+      oc add: d ]
+
+    parseStringOn: stream
+    [ | s | s := OrderedCollection new.
+      stream whilePeek: [ :c | c isSeparator not ] do:
+             [ :c | s add: c ].
+      oc add: s asString ]
+
+    parseCharsetOn: stream [ dispatch := [ :c :stream | self parseCharset: c on: stream set: Set new ] ]
+    parseCharset: c on: stream set: set
+    [ (c = $^) ifTrue:
+          [ dispatch := [
+              :c :stream |
+              self parseCharset: c on: stream inv: true set: set ] ] ifFalse:
+          [ self parseCharset: c on: stream inv: false set: set ] ]
+    parseCharset: c on: stream inv: inv set: set
+    [ (c = $]) ifTrue:
+          [ self parseCharsetOn: stream inv: inv set: set ] ifFalse:
+          [ set add: c.
+            dispatch := [
+              :c :stream |
+              self parseCharset: c on: stream inv: inv set: set ] ] ]
+    parseCharsetOn: stream inv: inv set: set
+    [ | s | s := OrderedCollection new.
+      stream whilePeek: [ :c | inv ~= (set includes: c) ] do:
+             [ :c | s add: c ].
+      oc add: s asString ]
+]
+ScannerState class extend [
+    new: sc [ |r| r := super new. r init: sc. ^r ]
+]
+Object subclass: Scanner [
+    | dispatch |
+    init
+    [ dispatch := Dictionary new.
+      dispatch at: $% put: [ :s :st | s require: $% on: st ].
+      dispatch at: $d put: [ :s :st | s parseIntOn: st ].
+      dispatch at: $c put: [ :s :st | s parseCharOn: st ].
+      dispatch at: $s put: [ :s :st | s parseStringOn: st ].
+      dispatch at: $[ put: [ :s :st | s parseCharsetOn: st ]. ]
+
+    dispatchFor: c [ ^dispatch at: c ifAbsent: [[ :s :st | s badCmd: c ]] ]
+
+    scanf: fmt on: stream
+    [ | s |
+      s := ScannerState new: self.
+      fmt do: [ :c | s accept: c on: stream.
+                s failed ifTrue: [ ^nil ] ].
+      ^s finish ]
+]
+Scanner class extend [
+    | defaultsc |
+    default [ ^defaultsc ]
+    default: it [ defaultsc := it ]
+    new [ |r| r := super new. r init. ^r ]
+]
+Scanner default: Scanner new.
+
+Object extend [
+    memfn: selector [ DirectedMessage receiver: self selector: selector ]
+]
+
+Stream extend [
+    toLines [ ^self lines toList ]
+
+    scanf: fmt [ ^Scanner default scanf: fmt on: self ]
+    scanf: fmt with: block
+    [ ^(self scanf: fmt) ifNotNil: [ :it | block valueWithArguments: it ] ]
+
+    whilePeek: pred do: block
+    [ [ self peek ifNil: [ false ]
+                  ifNotNil: [ :it | pred value: it ] ]
+          whileTrue: [ block value: self next ] ]
+]
+
+String extend [
+    scanf: fmt [ ^(ReadStream on: self) scanf: fmt ]
+    scanf: fmt with: block [ ^(ReadStream on: self) scanf: fmt with: block ]
+]

fetch.sh

@@ -0,0 +1,26 @@
+#!/usr/bin/env sh
+
+YEAR=2024
+DIR="$(readlink -f "$(dirname "$0")")"
+cd "$DIR" || exit 1
+
+if [ ! -f session.key ] ; then
+   echo "session.key missing"
+   exit 1
+fi
+
+KEY="$(cat session.key)"
+
+if [ -z "$1" ]
+then DAYN="$(date +%d)"
+else DAYN="$1"
+fi
+DAY="$(echo "$DAYN" | sed 's/^0*//')"
+DAYP="$(printf "%02d" "$DAY")"
+
+mkdir -p input
+echo "Fetching day $DAY..."
+curl -fs -H"Cookie: session=$KEY" \
+     "https://adventofcode.com/$YEAR/day/$DAY/input" \
+     -o "input/day$DAYP.txt" &&
+    echo "Success" && exit 0 || echo "Errored" && exit 1

run.sh

@@ -0,0 +1,25 @@
+#!/usr/bin/env sh
+
+DIR="$(readlink -f "$(dirname "$0")")"
+cd "$DIR" || exit 1
+
+if [ -z "$1" ]
+then DAYN="$(date +%d)"
+else DAYN="$1"
+fi
+DAY="$(echo "$DAYN" | sed 's/^0*//')"
+DAYP="$(printf "%02d" "$DAY")"
+
+export AOC_INPUT
+if [ "$1" = "--" ]
+then AOC_INPUT="/dev/stdin"; shift
+elif [ "$1" = "-i" ]
+then AOC_INPUT="$2"; shift; shift
+else
+    AOC_INPUT="$DIR/input/day$DAYP.txt"
+    if ! [ -f "$AOC_INPUT" ]
+    then ./fetch.sh "$DAY" || exit 1
+    fi
+fi
+
+exec gst "days/utils.st" "days/day$DAYP.st" < "$AOC_INPUT"