You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
aoc-racket/2019/14.rkt

75 lines
3.0 KiB
Racket

5 years ago
#lang br/quicklang
(require (for-syntax racket/string racket/sequence) racket/file rackunit)
5 years ago
(define ore? number?)
(define (make-reactor reax-output proc-or-ore [t (current-thread)])
5 years ago
(let* ([ch (make-channel)]
[r (thread (λ ()
(define reax 0)
(define reax-formula (match proc-or-ore
[(? ore? ore) ore]
[proc proc]))
(let loop ([supply 0])
(match (channel-get ch)
['ore
(channel-put ch (match reax-formula
[(? ore? ore) (* ore reax)]
[_ 0]))
(loop supply)]
['reset
(set! reax 0)
(channel-put ch always-evt)
(loop 0)]
[amt (let inner ([supply supply])
(cond
[(< supply amt)
(set! reax (add1 reax))
(unless (ore? reax-formula)
(reax-formula))
(inner (+ supply reax-output))]
[else
(channel-put ch always-evt)
(loop (- supply amt))]))]))))])
5 years ago
(λ (arg)
5 years ago
(channel-put ch arg)
(channel-get ch))))
5 years ago
5 years ago
(define-syntax (handle stx)
(syntax-case stx (ORE)
[(_) #'(begin)]
[(_ X ORE => Q ID) #'(define ID (make-reactor Q X))]
[(_ ARG ... => Q ID)
(with-syntax ([(PR ...)
(for/list ([duo (in-slice 2 (reverse (syntax->datum #'(ARG ...))))])
(list (datum->syntax stx (car duo))
(cadr duo)))]
[ID (datum->syntax stx (syntax->datum #'ID))])
#'(define ID (make-reactor Q (λ () (sync PR ...)))))]))
5 years ago
5 years ago
(define-syntax (total stx)
(syntax-case stx ()
[(_ ID ...)
(with-syntax ([(ID ...) (for/list ([idstx (in-list (syntax->list #'(ID ...)))])
(datum->syntax stx (syntax->datum idstx)))])
#'(+ (ID 'ore) ...))]))
(provide handle quote total void)
5 years ago
5 years ago
(module+ reader
(provide read-syntax)
(define (read-syntax name ip)
(define lns (for/list ([ln (in-list (port->lines ip))]
#:when (positive? (string-length ln)))
(string-replace ln "," "")))
(define src-datums (format-datums '(handle ~a) lns))
(datum->syntax #f `(module _ "14.rkt"
,@src-datums
(void (FUEL 1))
(total ,@(map last src-datums))))))
5 years ago
5 years ago
(define-macro (mb ARG ...)
(with-syntax ([FUEL (datum->syntax caller-stx 'FUEL)])
#'(#%module-begin
ARG ...)))
(provide (rename-out [mb #%module-begin]))