|
|
|
|
@ -1,23 +1,25 @@
|
|
|
|
|
#lang br
|
|
|
|
|
(require racket/file rackunit)
|
|
|
|
|
#lang br/quicklang
|
|
|
|
|
(require (for-syntax racket/string racket/sequence) racket/file rackunit)
|
|
|
|
|
|
|
|
|
|
(define ore? number?)
|
|
|
|
|
|
|
|
|
|
(define (make-reactor reax-output proc-or-ore [t (current-thread)])
|
|
|
|
|
(let ([r (thread (λ ()
|
|
|
|
|
(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 (thread-receive)
|
|
|
|
|
(match (channel-get ch)
|
|
|
|
|
['ore
|
|
|
|
|
(thread-send t (match reax-formula
|
|
|
|
|
(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
|
|
|
|
|
@ -26,36 +28,47 @@
|
|
|
|
|
(unless (ore? reax-formula)
|
|
|
|
|
(reax-formula))
|
|
|
|
|
(inner (+ supply reax-output))]
|
|
|
|
|
[else (loop (- supply amt))]))]))))])
|
|
|
|
|
[else
|
|
|
|
|
(channel-put ch always-evt)
|
|
|
|
|
(loop (- supply amt))]))]))))])
|
|
|
|
|
(λ (arg)
|
|
|
|
|
(thread-send r arg)
|
|
|
|
|
(when (eq? arg 'ore)
|
|
|
|
|
(thread-receive)))))
|
|
|
|
|
(channel-put ch arg)
|
|
|
|
|
(channel-get ch))))
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
#|(A 7)
|
|
|
|
|
(A 7)
|
|
|
|
|
(A 7)
|
|
|
|
|
(A 7)
|
|
|
|
|
(check-eq? (A 'ore) 30)
|
|
|
|
|
(A 'reset)
|
|
|
|
|
|#
|
|
|
|
|
(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)
|
|
|
|
|
|
|
|
|
|
(define B (make-reactor 1 1))
|
|
|
|
|
#|(B 7)
|
|
|
|
|
(B 7)
|
|
|
|
|
(B 7)
|
|
|
|
|
(B 7)
|
|
|
|
|
(check-eq? (B 'ore) 28)
|
|
|
|
|
(B 'reset)
|
|
|
|
|
|#
|
|
|
|
|
(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))))))
|
|
|
|
|
|
|
|
|
|
(define C (make-reactor 1 (λ () (A 7) (B 1))))
|
|
|
|
|
(define D (make-reactor 1 (λ () (A 7) (C 1))))
|
|
|
|
|
(define E (make-reactor 1 (λ () (A 7) (D 1))))
|
|
|
|
|
(define FUEL (make-reactor 1 (λ () (A 7) (E 1))))
|
|
|
|
|
(FUEL 1)
|
|
|
|
|
(A 'ore)
|
|
|
|
|
(A 'ore)
|
|
|
|
|
(A 'ore)
|
|
|
|
|
(define-macro (mb ARG ...)
|
|
|
|
|
(with-syntax ([FUEL (datum->syntax caller-stx 'FUEL)])
|
|
|
|
|
#'(#%module-begin
|
|
|
|
|
ARG ...)))
|
|
|
|
|
(provide (rename-out [mb #%module-begin]))
|
|
|
|
|
|
