d25 s1

2017/d25/main.rkt

@@ -0,0 +1,48 @@
+#lang br/quicklang
+(require "../helper.rkt")
+(provide read-syntax (rename-out [#%mb #%module-begin]) ★ ★★)
+
+(define (read-syntax path port)
+  (define lines (for/list ([ln (in-lines port)])
+                  (string-trim ln #px"\\W")))
+  (strip-context #`(module mod "main.rkt"
+                     #,(for/list ([datum (in-port read (open-input-string (car lines)))])
+                         datum)
+                     #,(list
+                        (string->symbol (last (string-split (second lines))))
+                        (string->number (car (take-right (string-split (third lines)) 2))))
+                     #,@(for/list ([state-line-group (in-list (filter-split (cdddr lines) (λ (ln) (equal? ln ""))))])
+                          (for/list ([state-line (in-list state-line-group)])
+                            (read (open-input-string (last (string-split state-line)))))))))
+
+(define-macro (#%mb (STARS) (STATE STEPS) (TOK ...) ...)
+  #`(#%module-begin
+     (time (STARS STATE STEPS (TOK ...) ...))))
+
+(define-macro (★ STATE STEPS (TOK ...) ...)
+  #'(begin
+      (define-state TOK ...) ...
+      (run STATE STEPS)))
+
+(define tape (make-hasheqv))
+
+(define (read-tape pos) (hash-ref! tape pos 0))
+(define (write-tape pos val) (hash-set! tape pos val))
+(define (change-pos pos dir) (+ pos (if (eq? dir 'left) -1 1)))
+
+(define-macro (define-state STATE 0 VAL0 DIR0 THEN0 1 VAL1 DIR1 THEN1)
+  #'(define (STATE pos)
+      (case (read-tape pos)
+        [(0)
+         (write-tape pos VAL0)
+         (values (change-pos pos 'DIR0) THEN0)]
+        [(1)
+         (write-tape pos VAL1)
+         (values (change-pos pos 'DIR1) THEN1)])))
+
+(define (run state steps)
+  (for/fold ([pos 0]
+             [state state]
+             #:result (apply + (hash-values tape)))
+            ([step (in-range steps)])
+    (state pos)))

2017/d25/star1.rkt

@@ -0,0 +1,63 @@
+#lang reader "main.rkt" ★ ; 5744
+Begin in state A.
+Perform a diagnostic checksum after 12261543 steps.
+
+In state A:
+  If the current value is 0:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state B.
+  If the current value is 1:
+    - Write the value 0.
+    - Move one slot to the left.
+    - Continue with state C.
+
+In state B:
+  If the current value is 0:
+    - Write the value 1.
+    - Move one slot to the left.
+    - Continue with state A.
+  If the current value is 1:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state C.
+
+In state C:
+  If the current value is 0:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state A.
+  If the current value is 1:
+    - Write the value 0.
+    - Move one slot to the left.
+    - Continue with state D.
+
+In state D:
+  If the current value is 0:
+    - Write the value 1.
+    - Move one slot to the left.
+    - Continue with state E.
+  If the current value is 1:
+    - Write the value 1.
+    - Move one slot to the left.
+    - Continue with state C.
+
+In state E:
+  If the current value is 0:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state F.
+  If the current value is 1:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state A.
+
+In state F:
+  If the current value is 0:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state A.
+  If the current value is 1:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state E.

2017/d25/test1.rkt

@@ -0,0 +1,23 @@
+#lang reader "main.rkt" ★ ; 3
+Begin in state A.
+Perform a diagnostic checksum after 6 steps.
+
+In state A:
+  If the current value is 0:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state B.
+  If the current value is 1:
+    - Write the value 0.
+    - Move one slot to the left.
+    - Continue with state B.
+
+In state B:
+  If the current value is 0:
+    - Write the value 1.
+    - Move one slot to the left.
+    - Continue with state A.
+  If the current value is 1:
+    - Write the value 1.
+    - Move one slot to the right.
+    - Continue with state A.