Modified IntCode interpreter to return a state on input/output/halt.

lib.rkt

@@ -1,7 +1,11 @@
 #lang racket
 
-(require racket/format
+(require
-         2htdp/batch-io)
+  (only-in data/queue
+           make-queue
+           enqueue!)
+  (only-in 2htdp/batch-io
+           read-lines))
 
 (provide problem-input
          show-solution
@@ -14,6 +18,7 @@
          list-ref*
          chunks-of
          transpose
+         list->queue
          vector-ref*
          vector-set!*)
 
@@ -97,6 +102,13 @@
             [layers (map cdr layers)])
         (cons pixels (transpose layers)))))
 
+;; list->queue : (listof any) -> (queueof any)
+;; Creates a queue and adds elements of list in order
+(define (list->queue lst)
+  (let ([Q (make-queue)])
+    (for-each (curry enqueue! Q) lst)
+    Q))
+
 
 ;; Vector helpers ;;
 

src/02.rkt

@@ -1,8 +1,8 @@
 #lang racket
 
-(require "../lib.rkt"
+(require racket/vector
-         "IntCode.rkt"
+         "../lib.rkt"
-         racket/vector)
+         "IntCode.rkt")
 
 (define input
   (string->program (car (problem-input 2))))
@@ -14,8 +14,7 @@
     input))
 
 (define (exec-pos0 program)
-  (let-values ([(program _)
+  (let ([program (halt-with-program (exec program))])
-                (exec program)])
     (vector-ref program 0)))
 
 (define part1

src/05.rkt

@@ -7,11 +7,9 @@
   (string->program (car (problem-input 5))))
 
 (define part1
-  (let-values ([(_ out) (exec input #:in '(1))])
+  (last (resume-with-io (exec input) '(1))))
-    (last out)))
 
 (define part2
-  (let-values ([(_ out) (exec input #:in '(5))])
+  (last (resume-with-io (exec input) '(5))))
-    (last out)))
 
 (show-solution part1 part2)

src/07.rkt

@@ -1,4 +1,4 @@
-#lang racket
+#lang plai
 
 (require data/queue
          "../lib.rkt"
@@ -8,80 +8,30 @@
   (string->program (car (problem-input 7))))
 
 (define (amplify phase)
-  (let*-values ([(_ outA) (exec input #:in (list (first  phase) 0))]
+  (let* ([outA (resume-with-io (exec input) (list (first  phase) 0))]
-                [(_ outB) (exec input #:in (list (second phase) (car outA)))]
+         [outB (resume-with-io (exec input) (list (second phase) (car outA)))]
-                [(_ outC) (exec input #:in (list (third  phase) (car outB)))]
+         [outC (resume-with-io (exec input) (list (third  phase) (car outB)))]
-                [(_ outD) (exec input #:in (list (fourth phase) (car outC)))]
+         [outD (resume-with-io (exec input) (list (fourth phase) (car outC)))]
-                [(_ outE) (exec input #:in (list (fifth  phase) (car outD)))])
+         [outE (resume-with-io (exec input) (list (fifth  phase) (car outD)))])
     (car outE)))
 
 (define part1
   (let ([phases (permutations '(0 1 2 3 4))])
     (apply max (append (map amplify phases)))))
 
-(struct state (program pointer input) #:transparent)
-
-(define (exec-state program #:ptr [pointer 0] #:in [input '()])
-  (let* ([instruction (list-ref program pointer)]
-         [opcode (remainder instruction 100)]
-         [mode1 (remainder (quotient instruction 100) 10)]
-         [mode2 (remainder (quotient instruction 1000) 10)]
-         [mode3 (remainder (quotient instruction 10000) 10)]
-         ;; l* : call to get write location from program
-         [l1 (λ () (if (zero? mode1) (list-ref program (+ pointer 1)) (+ pointer 1)))]
-         [l2 (λ () (if (zero? mode2) (list-ref program (+ pointer 2)) (+ pointer 2)))]
-         [l3 (λ () (if (zero? mode3) (list-ref program (+ pointer 3)) (+ pointer 3)))]
-         ;; v* : call to read values from program
-         [v1 (λ () (list-ref program (l1)))]
-         [v2 (λ () (list-ref program (l2)))]
-         [v3 (λ () (list-ref program (l3)))]
-         [next-pointer
-          (match opcode
-            [(or 1 2 7 8) (+ pointer 4)]
-            [(or 3 4) (+ pointer 2)]
-            [(or 5 6) (+ pointer 3)]
-            [99 (+ pointer 1)])])
-    (match opcode
-      [(or 1 2)
-       (let* ([arith (match opcode [1 +] [2 *])]
-              [value (arith (v1) (v2))]
-              [program (list-set program (l3) value)])
-         (exec-state program #:ptr next-pointer #:in input))]
-      [3
-       (let* ([value (car input)]
-              [input (cdr input)]
-              [program (list-set program (l1) value)])
-         (exec-state program #:ptr next-pointer #:in input))]
-      [4
-       (values 'yield (v1)
-               (state program next-pointer input))]
-      [(or 5 6)
-       (let* ([jump-if (match opcode [5 nzero?] [6 zero?])]
-              [next-pointer (if (jump-if (v1)) (v2) next-pointer)])
-         (exec-state program #:ptr next-pointer #:in input))]
-      [(or 7 8)
-       (let* ([lt-eq (match opcode [7 <] [8 =])]
-              [value (if (lt-eq (v1) (v2)) 1 0)]
-              [program (list-set program (l3) value)])
-         (exec-state program #:ptr next-pointer #:in input))]
-      [99
-       (values 'halt (car input)
-               (state program next-pointer (cdr input)))])))
-
 (define (amplify-loop phase)
-  (let* ([input (vector->list input)]
+  (let* ([amps (map (curry resume-with-input (exec input)) phase)]
-         [amps (map (compose (curry state input 0) list) phase)]
+         [Q (list->queue amps)])
-         [Q (make-queue)])
-    (map (curry enqueue! Q) amps)
     (let loop ([signal 0])
-      (let* ([amp (dequeue! Q)])
+      (define amp (dequeue! Q))
-        (let-values ([(code signal amp)
+      (type-case state amp
-                      (exec-state (state-program amp)
+        [halt (_) signal]
-                            #:ptr (state-pointer amp)
+        [in (resume)
-                            #:in (rac (state-input amp) signal))])
+            (define-values (signal st)
-          (match code
+              (resume-with-output (resume signal)))
-            ['yield (enqueue! Q amp) (loop signal)]
+            (enqueue! Q st)
-            ['halt signal]))))))
+            (loop signal)]
+        [else (error "amplify-loop: Unexpected program state.")]))))
 
 (define part2
   (let ([phases (permutations '(5 6 7 8 9))])

src/09.rkt

@@ -6,10 +6,10 @@
 (define input
   (string->program (car (problem-input 9))))
 
-(define-values (_ part1)
+(define part1
-  (exec input #:in '(1)))
+  (car (resume-with-io (exec input) '(1))))
 
-(define-values (__ part2)
+(define part2
-  (exec input #:in '(2)))
+  (car (resume-with-io (exec input) '(2))))
 
-(show-solution (car part1) (car part2))
+(show-solution part1 part2)

src/IntCode.rkt

@@ -1,11 +1,8 @@
-#lang racket
+#lang plai
 
 (require racket/vector
          "../lib.rkt")
 
-(provide string->program
-         exec)
-
 (define (vector-ref** vec pos)
   (vector-ref* vec pos 0))
 
@@ -15,7 +12,38 @@
 (define (string->program str)
   (list->vector (map string->number (string-split str ","))))
 
-;; exec* : program -> number -> number -> (listof number) -> (listof number) -> program
+(define (program? p)
+  (vectorof number?))
+
+(define-type state
+  (out [value number?] [resume procedure?])
+  (in  [resume procedure?])
+  (halt [program program?]))
+
+(define (resume-with-output st)
+  (type-case state st
+    [out (value resume) (values value (resume))]
+    [else (error "resume-with-output: Unexpected program state.")]))
+
+(define (resume-with-input st input)
+  (type-case state st
+    [in (resume) (resume input)]
+    [else (error "resume-with-input: Unexpected program state.")]))
+
+(define (resume-with-io st inputs)
+  (type-case state st
+    [in (resume)
+        (resume-with-io (resume (car inputs)) (cdr inputs))]
+    [out (value resume)
+         (cons value (resume-with-io (resume) inputs))]
+    [halt (program) '()]))
+
+(define (halt-with-program st)
+  (type-case state st
+    [halt (program) program]
+    [else (error "halt-with-program: Unexpected program state.")]))
+
+;; exec* : program -> number -> number -> state
 ;; An encoded instruction is anywhere from 1 to 4 digits long.
 ;; The last one or two digits represent the opcode, which can be:
 ;;   - 1/2: add/multiply parameters 1 and 2 and store in parameter 3
@@ -33,7 +61,7 @@
 ;; If the mode is 1, the value at pointer is immediate.
 ;; If the mode is 2, the value at pointer is an address to be offset by base.
 ;; Note that leading zeroes in the encoded instruction are omitted.
-(define (exec* program #:ptr [pointer 0] #:base [base 0] #:in [input '()] #:out [output '()])
+(define (exec* program #:ptr [pointer 0] #:base [base 0])
   (define instruction (vector-ref** program pointer))
   (define opcode (remainder instruction 100))
   (define next-pointer
@@ -63,29 +91,33 @@
        (let* ([arith (match opcode [1 +] [2 *])]
               [value (arith (v1) (v2))]
               [program (vector-set!* program (l3) value)])
-         (exec* program #:ptr next-pointer #:base base #:in input #:out output))]
+         (exec* program #:ptr next-pointer #:base base))]
       [3
-       (let* ([value (car input)]
+       (let* ([resume
-              [input (cdr input)]
+               (λ (input)
-              [program (vector-set!* program (l1) value)])
+                 (vector-set!* program (l1) input)
-         (exec* program #:ptr next-pointer #:base base #:in input #:out output))]
+                 (exec* program #:ptr next-pointer #:base base))])
+         (in resume))]
       [4
-       (let* ([output (append output `(,(v1)))])
+       (let* ([output (v1)]
-         (exec* program #:ptr next-pointer #:base base #:in input #:out output))]
+              [resume
+               (λ () (exec* program #:ptr next-pointer #:base base))])
+         (out output resume))]
       [(or 5 6)
        (let* ([jump-if (match opcode [5 nzero?] [6 zero?])]
               [next-pointer (if (jump-if (v1)) (v2) next-pointer)])
-         (exec* program #:ptr next-pointer #:base base #:in input #:out output))]
+         (exec* program #:ptr next-pointer #:base base))]
       [(or 7 8)
        (let* ([lt-eq (match opcode [7 <] [8 =])]
               [value (if (lt-eq (v1) (v2)) 1 0)]
               [program (vector-set!* program (l3) value)])
-         (exec* program #:ptr next-pointer #:base base #:in input #:out output))]
+         (exec* program #:ptr next-pointer #:base base))]
       [9
        (let ([base (+ base (v1))])
-         (exec* program #:ptr next-pointer #:base base #:in input #:out output))]
+         (exec* program #:ptr next-pointer #:base base))]
-      [99 (values program output)])))
+      [99
+       (halt program)])))
 
 ;; Just so we always run the program on a fresh copy
-(define (exec program #:ptr [pointer 0] #:base [base 0] #:in [input '()] #:out [output '()])
+(define (exec program #:ptr [pointer 0] #:base [base 0])
-  (exec* (vector-copy program) #:ptr pointer #:base base #:in input #:out output))
+  (exec* (vector-copy program) #:ptr pointer #:base base))