d14 p1

2019/14.rkt

@@ -1,61 +1,74 @@
-#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 (λ ()
-                     (define reax 0)
-                     (define reax-formula (match proc-or-ore
-                                            [(? ore? ore) ore]
-                                            [proc proc]))
-                     (let loop ([supply 0])
-                       (match (thread-receive)
-                         ['ore
-                          (thread-send t (match reax-formula
-                                           [(? ore? ore) (* ore reax)]
-                                           [_ 0]))
-                          (loop supply)]
-                         ['reset
-                          (set! reax 0)
-                          (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 (loop (- supply amt))]))]))))])
+  (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))]))]))))])
     (λ (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]))

2019/14input.rkt

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

2019/14test.rkt

@@ -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