Day 1 cleanup

aoc2024-eutro.el

@@ -16,32 +16,88 @@
 
 (defconst aoc-dayfile-pattern "day\\([0-9]\\{2\\}\\)")
 
+(defvar-local aoc-pinned-day-number nil)
+
 (defun aoc-day-number ()
   "Determine the day number of the current file, or the current day."
   (or
-   (let ((file-name (buffer-file-name)))
+   aoc-pinned-day-number
+   (when-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 ()
+(defun aoc-get-out-buffer (&optional clear day)
-  "Run the current day."
+  "Get the *aoc-output* buffer."
+  (let ((buf (get-buffer-create "*aoc-output*")))
+    (when (or clear
+              (not (eq 'aoc-run-mode
+                       (buffer-local-value 'major-mode buf))))
+      (with-current-buffer buf
+        (erase-buffer)
+        (when day (setq aoc-pinned-day-number day))
+        (aoc-run-mode)))
+    buf))
+
+(defun aoc-run (&optional prefix)
+  "Run the current day.
+
+With PREFIX, read input from the buffer."
+  (interactive "P")
+  (let* ((day (aoc-day-number))
+         (inp-args (when prefix '("--")))
+         (buf (aoc-get-out-buffer t day))
+         (args (cons (number-to-string day) inp-args))
+         (proc (apply
+                #'start-process
+                "aoc-run" buf
+                (expand-file-name "run.sh" aoc-root)
+                args))
+         (win (selected-window)))
+    (unless (eq (window-buffer win) buf)
+      (pop-to-buffer buf 'display-buffer-use-least-recent-window))
+    (message "./run.sh %s" (string-join (mapcar #'shell-quote-argument args) " "))
+    (unless prefix (select-window win))))
+
+(defun aoc-copy-part-answer (part)
+  "Copy the answer for the given PART from *aoc-output*."
+  (with-current-buffer (aoc-get-out-buffer)
+    (goto-char (point-max))
+    (unless (re-search-backward (format "Part %d: " part) nil t)
+      (user-error "Part %d not found in buffer" part))
+    (goto-char (match-end 0))
+    (let ((start (point)))
+      (end-of-line)
+      (copy-region-as-kill start (point))
+      (message "Copied: %s" (current-kill 0 t)))))
+
+(defmacro aoc-copy-n (part)
+  `(defun ,(intern (format "aoc-copy-%d" part)) ()
+     ,(format "Copy the answer for part %d in *aoc-output*." part)
      (interactive)
-  (let ((default-directory aoc-root))
+     (aoc-copy-part-answer ,part)))
-    (async-shell-command
+
-     (format  "./run.sh %s" (aoc-day-number))
+(aoc-copy-n 1)
-     "*aoc-output*"
+(aoc-copy-n 2)
-     "*aoc-error*")))
 
 (defconst aoc-mode-map
   (let ((keys (make-sparse-keymap)))
     (define-key keys (kbd "C-c C-c") #'aoc-run)
+    (define-key keys (kbd "C-c 1") #'aoc-copy-1)
+    (define-key keys (kbd "C-c 2") #'aoc-copy-2)
     keys))
 
 (define-minor-mode aoc-mode
   "Minor mode for Advent of Code utilities"
   :lighter " AoC24")
 
+(defconst aoc-run-mode-map
+  (let ((keys (copy-keymap aoc-mode-map)))
+    keys))
+
+(define-derived-mode aoc-run-mode comint-mode "AoC-Run"
+  "Major mode for the *aoc-run* buffer.")
+
 ;; Local Variables:
 ;; read-symbol-shorthands: (("aoc-" . "aoc2024-eutro-"))
 ;; End:

days/day01.st

@@ -1,15 +1,7 @@
-AOC part1: [ :lines | | sorted |
+AOC input: [ (stdin toLines collect: [ :ln | ln scanf: '%d %d' ])
-             sorted := (lines collect: [ :it | it asSortedCollection readStream ]).
+                 transposed collect: [ :it | it asSortedCollection ] ];
-             ((sorted at: 1) with: (sorted at: 2)) collect:
+    part1: [ :left :right | left with: right collect: [ :l :r | (l - r) abs ] ];
-                 [ :arr | ((arr at: 1) - (arr at: 2)) abs ] ];
+    part2: [ :left :right | | counts | counts := left toBag.
-    part2: [ :lines | | counts | counts := Dictionary new.
+             right collect: [ :elt | elt * (counts occurrencesOf: elt) ] ];
-             (lines at: 2) do: [
+    result: [ :input :part | (part valueWithArguments: input) sum ];
-                 :elt | counts at: elt
-                               put: 1 + (counts at: elt ifAbsent: [0]) ].
-             (lines at: 1) collect: [ :elt | elt * (counts at: elt ifAbsent: [0]) ] ];
-    arg: [ | inp l r | inp := FileStream stdin toLines collect: [ :ln | ln scanf: '%d %d' ].
-           l := inp collect: [ :e | e at: 1 ].
-           r := inp collect: [ :e | e at: 2 ].
-           {l . r} ];
-    map: [ :lines :part | (part value: lines) sum ];
     finish.

days/utils.st

@@ -1,39 +1,29 @@
+"--- AOC helper class ---"
 Object subclass: AOC []
 AOC class extend [
-    | savedP1 savedP2 mapper getArg |
+    | savedP1 savedP2 mapper getInput |
+    input: inpBlock [ getInput := inpBlock ]
     part1: p1Block [ savedP1 := p1Block ]
     part2: p2Block [ savedP2 := p2Block ]
-    map: mapBlock [ mapper := mapBlock ]
+    result: mapBlock [ mapper := mapBlock ]
-    arg: argBlock [ getArg := argBlock ]
 
-    output: value part: part
+    output: value part: part [ stdout << 'Part ' << part << ': ' << value; nl. ]
-    [ FileStream stdout << 'Part '; << part; << ': '; << value; nl. ]
 
     runPart: saved part: part arg: arg
     [ saved ifNotNil: [
-        | mapped |
+        | mapped | mapped := mapper value: arg value: saved.
-        mapped := mapper value: arg value: saved.
         self output: mapped part: part ] ]
 
     run
-    [ | arg |
+    [ | inp | inp := getInput value.
-      arg := getArg value.
+      self runPart: savedP1 part: 1 arg: inp.
-      self runPart: savedP1 part: 1 arg: arg.
+      self runPart: savedP2 part: 2 arg: inp. ]
-      self runPart: savedP2 part: 2 arg: arg. ]
 
     "TODO: save as an image?"
     finish [ self run ]
 ]
 
-Iterable extend [
+"--- Scanf ---"
-    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
@@ -98,7 +88,7 @@ ScannerState class extend [
 ]
 Object subclass: Scanner [
     | dispatch |
-    init
+    initialize
     [ dispatch := Dictionary new.
       dispatch at: $% put: [ :s :st | s require: $% on: st ].
       dispatch at: $d put: [ :s :st | s parseIntOn: st ].
@@ -109,8 +99,7 @@ Object subclass: Scanner [
     dispatchFor: c [ ^dispatch at: c ifAbsent: [[ :s :st | s badCmd: c ]] ]
 
     scanf: fmt on: stream
-    [ | s |
+    [ | s | s := ScannerState new: self.
-      s := ScannerState new: self.
       fmt do: [ :c | s accept: c on: stream.
                 s failed ifTrue: [ ^nil ] ].
       ^s finish ]
@@ -119,12 +108,31 @@ Scanner class extend [
     | defaultsc |
     default [ ^defaultsc ]
     default: it [ defaultsc := it ]
-    new [ |r| r := super new. r init. ^r ]
 ]
 Scanner default: Scanner new.
 
+"--- Extensions ---"
 Object extend [
-    memfn: selector [ DirectedMessage receiver: self selector: selector ]
+    memfn: selector [ ^DirectedMessage receiver: self selector: selector ]
+]
+
+Iterable extend [
+    sum [ ^self fold: [ :l :r | l + r ] ]
+    toList [ ^self toCollection: OrderedCollection ]
+    toBag [ ^self toCollection: Bag ]
+    toSet [ ^self toCollection: Set ]
+
+    toCollection: clazz [ ^self intoCollection: clazz new ]
+    intoCollection: acc [ self do: [:x | acc add: x]. ^acc ]
+]
+
+Collection extend [
+    transposed
+    [ ^(self size <= 0) ifTrue:
+           [ #() ] ifFalse:
+           [ | selfArr | selfArr := self asArray.
+             (1 to: (self at: 1) size) collect: [
+                 :i | selfArr collect: [ :elt | elt at: i ifAbsent: [nil] ] ] ] ]
 ]
 
 Stream extend [
@@ -135,8 +143,7 @@ Stream extend [
     [ ^(self scanf: fmt) ifNotNil: [ :it | block valueWithArguments: it ] ]
 
     whilePeek: pred do: block
-    [ [ self peek ifNil: [ false ]
+    [ [ self peek ifNil: [ false ] ifNotNil: [ :it | pred value: it ] ]
-                  ifNotNil: [ :it | pred value: it ] ]
           whileTrue: [ block value: self next ] ]
 ]
 
@@ -144,3 +151,11 @@ String extend [
     scanf: fmt [ ^(ReadStream on: self) scanf: fmt ]
     scanf: fmt with: block [ ^(ReadStream on: self) scanf: fmt with: block ]
 ]
+
+BlockClosure extend [
+    asSpreader [ ^[ :args | self valueWithArguments: args ] ]
+]
+
+Array extend [
+    letArrayInBlock: block [ ^block valueWithArguments: self ]
+]