master
Matthew Butterick 5 years ago
parent 023d056bc8
commit 64e54f2f63

@ -1,61 +1,74 @@
#lang br #lang br/quicklang
(require racket/file rackunit) (require (for-syntax racket/string racket/sequence) racket/file rackunit)
(define ore? number?) (define ore? number?)
(define (make-reactor reax-output proc-or-ore [t (current-thread)]) (define (make-reactor reax-output proc-or-ore [t (current-thread)])
(let ([r (thread (λ () (let* ([ch (make-channel)]
(define reax 0) [r (thread (λ ()
(define reax-formula (match proc-or-ore (define reax 0)
[(? ore? ore) ore] (define reax-formula (match proc-or-ore
[proc proc])) [(? ore? ore) ore]
(let loop ([supply 0]) [proc proc]))
(match (thread-receive) (let loop ([supply 0])
['ore (match (channel-get ch)
(thread-send t (match reax-formula ['ore
[(? ore? ore) (* ore reax)] (channel-put ch (match reax-formula
[_ 0])) [(? ore? ore) (* ore reax)]
(loop supply)] [_ 0]))
['reset (loop supply)]
(set! reax 0) ['reset
(loop 0)] (set! reax 0)
[amt (let inner ([supply supply]) (channel-put ch always-evt)
(cond (loop 0)]
[(< supply amt) [amt (let inner ([supply supply])
(set! reax (add1 reax)) (cond
(unless (ore? reax-formula) [(< supply amt)
(reax-formula)) (set! reax (add1 reax))
(inner (+ supply reax-output))] (unless (ore? reax-formula)
[else (loop (- supply amt))]))]))))]) (reax-formula))
(inner (+ supply reax-output))]
[else
(channel-put ch always-evt)
(loop (- supply amt))]))]))))])
(λ (arg) (λ (arg)
(thread-send r arg) (channel-put ch arg)
(when (eq? arg 'ore) (channel-get ch))))
(thread-receive)))))
(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 ...)))))]))
(define A (make-reactor 10 10)) (define-syntax (total stx)
#|(A 7) (syntax-case stx ()
(A 7) [(_ ID ...)
(A 7) (with-syntax ([(ID ...) (for/list ([idstx (in-list (syntax->list #'(ID ...)))])
(A 7) (datum->syntax stx (syntax->datum idstx)))])
(check-eq? (A 'ore) 30) #'(+ (ID 'ore) ...))]))
(A 'reset) (provide handle quote total void)
|#
(define B (make-reactor 1 1)) (module+ reader
#|(B 7) (provide read-syntax)
(B 7) (define (read-syntax name ip)
(B 7) (define lns (for/list ([ln (in-list (port->lines ip))]
(B 7) #:when (positive? (string-length ln)))
(check-eq? (B 'ore) 28) (string-replace ln "," "")))
(B 'reset) (define src-datums (format-datums '(handle ~a) lns))
|# (datum->syntax #f `(module _ "14.rkt"
,@src-datums
(void (FUEL 1))
(total ,@(map last src-datums))))))
(define C (make-reactor 1 (λ () (A 7) (B 1)))) (define-macro (mb ARG ...)
(define D (make-reactor 1 (λ () (A 7) (C 1)))) (with-syntax ([FUEL (datum->syntax caller-stx 'FUEL)])
(define E (make-reactor 1 (λ () (A 7) (D 1)))) #'(#%module-begin
(define FUEL (make-reactor 1 (λ () (A 7) (E 1)))) ARG ...)))
(FUEL 1) (provide (rename-out [mb #%module-begin]))
(A 'ore)
(A 'ore)
(A 'ore)

@ -1,3 +1,4 @@
#lang reader (submod "14.rkt" reader)
1 FVBHS, 29 HWPND => 4 CPXDX 1 FVBHS, 29 HWPND => 4 CPXDX
5 TNWDG, 69 VZMS, 1 GXSD, 48 NCLZ, 3 RSRZ, 15 HWPND, 25 SGPK, 2 SVCQ => 1 FUEL 5 TNWDG, 69 VZMS, 1 GXSD, 48 NCLZ, 3 RSRZ, 15 HWPND, 25 SGPK, 2 SVCQ => 1 FUEL
1 PQRLB, 1 TWPMQ => 4 QBXC 1 PQRLB, 1 TWPMQ => 4 QBXC

@ -0,0 +1,7 @@
#lang reader (submod "14.rkt" reader)
10 ORE => 10 A
1 ORE => 1 B
7 A, 1 B => 1 C
7 A, 1 C => 1 D
7 A, 1 D => 1 E
7 A, 1 E => 1 FUEL