148 lines
5.0 KiB
Racket
148 lines
5.0 KiB
Racket
#lang racket
|
|
|
|
(require racket/async-channel)
|
|
|
|
;; First some helpers
|
|
|
|
(define (op-mode opcode idx)
|
|
(match (modulo (floor (/ opcode (expt 10 (+ idx 2)))) 10)
|
|
[0 'pos]
|
|
[1 'imm]
|
|
[_ (error "invalid mode")]))
|
|
|
|
(define (op-op opcode)
|
|
(modulo opcode 100))
|
|
|
|
(define (tape-ref/mode tape pos mode)
|
|
(match mode
|
|
['pos (list-ref tape (list-ref tape pos))]
|
|
['imm (list-ref tape pos)]
|
|
[_ (error "invalid mode")]))
|
|
|
|
;; Generic abstracted opcode interpreter function
|
|
;; Calls handler for opcode-specific handling, which should call callback to continue or return to
|
|
;; exit.
|
|
(define (intcode-handle-opcode callback spec handler tape pos)
|
|
(let* ([opcode (list-ref tape pos)]
|
|
[args (for/list ([spec-item spec] [idx (in-range (length spec))])
|
|
(tape-ref/mode tape (+ pos idx 1)
|
|
(match spec-item
|
|
['in (op-mode opcode idx)]
|
|
['out 'imm])))])
|
|
(apply handler callback tape (+ pos (length spec) 1) args)))
|
|
|
|
;; Create a system to register intcode ops
|
|
(struct intcode-op [code spec handler])
|
|
(define opcode-table (make-hash))
|
|
|
|
;; Evil mutation incoming!!!!
|
|
(define (intcode-register code spec handler)
|
|
(hash-set! opcode-table code (intcode-op code spec handler)))
|
|
|
|
;; Main eval function
|
|
(define (intcode-eval tape [pos 0])
|
|
(let* ([opcode (list-ref tape pos)]
|
|
[handler-entry (hash-ref opcode-table (op-op opcode))])
|
|
(intcode-handle-opcode intcode-eval
|
|
(intcode-op-spec handler-entry)
|
|
(intcode-op-handler handler-entry)
|
|
tape pos)))
|
|
|
|
;; Now it's time to define all the operations we can do
|
|
|
|
;; Binary operations!!!
|
|
(define spec-binop '(in in out))
|
|
(define ((intcode-generic-binop op) cb tape pos lhs rhs dst)
|
|
(cb (list-set tape dst (op lhs rhs)) pos))
|
|
|
|
(intcode-register 1 spec-binop (intcode-generic-binop +))
|
|
(intcode-register 2 spec-binop (intcode-generic-binop *))
|
|
(define (bool->number b) (if b 1 0))
|
|
(intcode-register 7 spec-binop (intcode-generic-binop (compose bool->number <)))
|
|
(intcode-register 8 spec-binop (intcode-generic-binop (compose bool->number =)))
|
|
|
|
;; I/O time
|
|
(define current-input-channel (make-parameter (make-async-channel)))
|
|
(define current-output-channel (make-parameter (make-async-channel)))
|
|
(define instance (make-parameter '()))
|
|
(define (instance-log what)
|
|
(if (empty? (instance)) (void) (displayln (format "~a ~a" (instance) what))))
|
|
(define (intcode-input cb tape pos dst)
|
|
(define inp (async-channel-get (current-input-channel)))
|
|
(instance-log (list "input" inp))
|
|
(cb (list-set tape dst inp) pos))
|
|
(intcode-register 3 '(out) intcode-input)
|
|
|
|
(define (intcode-output cb tape pos src)
|
|
(instance-log (list "output" src))
|
|
(async-channel-put (current-output-channel) src)
|
|
(cb tape pos))
|
|
(intcode-register 4 '(in) intcode-output)
|
|
|
|
;; Jumps
|
|
(define ((intcode-generic-jump which) cb tape pos arg dst)
|
|
(cb tape (if (which arg) dst pos)))
|
|
(intcode-register 5 '(in in) (intcode-generic-jump (compose not zero?)))
|
|
(intcode-register 6 '(in in) (intcode-generic-jump zero?))
|
|
|
|
;; Exit
|
|
(define (intcode-exit cb tape pos)
|
|
(instance-log "exit")
|
|
(void))
|
|
(intcode-register 99 '() intcode-exit)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (parse-input input)
|
|
(map string->number (string-split (string-trim input) ",")))
|
|
|
|
(define input (parse-input (file->string "input.7.txt")))
|
|
|
|
(define (intcode-eval-layer tape phase signal)
|
|
(parameterize ([current-input-channel (make-async-channel)]
|
|
[current-output-channel (make-async-channel)])
|
|
(begin
|
|
(async-channel-put (current-input-channel) phase)
|
|
(async-channel-put (current-input-channel) signal)
|
|
(intcode-eval tape)
|
|
(async-channel-get (current-output-channel)))))
|
|
|
|
(define initial-signal 0)
|
|
|
|
(define (intcode-eval-layers tape phases)
|
|
(foldl (lambda (phase signal)
|
|
(intcode-eval-layer tape phase signal))
|
|
initial-signal
|
|
phases))
|
|
|
|
;; Part 1
|
|
(apply max
|
|
(map (lambda (phases)
|
|
(intcode-eval-layers input phases))
|
|
(permutations (range 0 5))))
|
|
|
|
(define (list-rotate lst)
|
|
(cond
|
|
[(empty? list) '()]
|
|
[else `(,@(rest lst) ,(first lst))]))
|
|
|
|
(define (intcode-eval-layers/threaded tape phases first-signal)
|
|
(define channels (for/list ([_ phases]) (make-async-channel)))
|
|
(map (lambda (chan phase) (async-channel-put chan phase)) channels phases)
|
|
(define threads
|
|
(for/list ([chan-in channels]
|
|
[chan-out (list-rotate channels)]
|
|
[i (in-range (length channels))])
|
|
(parameterize ([current-input-channel chan-in]
|
|
[current-output-channel chan-out]
|
|
#|[instance i]|#)
|
|
(thread (lambda () (intcode-eval tape))))))
|
|
(async-channel-put (first channels) first-signal)
|
|
(map thread-wait threads)
|
|
(async-channel-get (first channels)))
|
|
|
|
;; Part 2
|
|
(apply max
|
|
(map (lambda (phases)
|
|
(intcode-eval-layers/threaded input phases initial-signal))
|
|
(permutations (range 5 10)))) |