d14 p1

2019/14.rkt

@@ -1,23 +1,25 @@
-#lang br
+#lang br/quicklang
-(require racket/file rackunit)
+(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)
+      (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)

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