d7

2017/aoc-lang.rkt

@@ -27,6 +27,6 @@
        (define (read-syntax path port)
          (strip-context #`(module mod MOD-PATH
                             #,@(for/list ([line (in-lines port)])
-                                 (for/list ([datums (in-port read (open-input-string line))])
+                                 (for/list ([datums (in-port read (open-input-string (string-replace line "," "")))])
                                    datums)))))
        . ARGS)))

2017/d7/main.rkt

@@ -0,0 +1,41 @@
+#lang reader "../aoc-lang.rkt"
+(require sugar/cache)
+(provide (rename-out [#%mb #%module-begin]))
+(define current-stars (make-parameter #f))
+(define-macro (#%mb (STARS) (NAME . TOKS) ...)
+  #`(#%module-begin
+     (current-stars 'STARS)
+     (define names (list 'NAME ...))
+     (handle (length names) NAME . TOKS) ...))
+
+(define (weights-equal? subsyms)
+  (or (null? subsyms)
+      (andmap (λ (ss) (= ((car subsyms) 'wt) (ss 'wt))) (cdr subsyms))))
+
+(define (unique-member ss subsyms)
+  (= 1 (length (filter (λ (subsym) (= (ss 'wt) (subsym 'wt))) subsyms))))
+
+(define (exceptional-subsym subsyms)
+  (for/first ([ss (in-list subsyms)] #:when (unique-member ss subsyms)) ss))
+
+(define (typical-subsym subsyms)
+  (for/first ([ss (in-list subsyms)] #:unless (unique-member ss subsyms)) ss))
+
+(define-macro-cases handle
+  [(M TARGET-LEN SYM (NUM) -> SUBSYM ...)
+   #'(begin (define (SYM [x #f])
+              (match x
+                ['wt (+ NUM (SUBSYM 'wt) ...)]
+                [(? number?)
+                 (define target-weight x)
+                 (define subsyms (list SUBSYM ...))
+                 (if (weights-equal? subsyms)
+                     (displayln (format "~a is bad: needs to be ~a" 'SYM (- NUM (- (SYM 'wt) target-weight))))
+                     (let ([next-target-weight ((typical-subsym subsyms) 'wt)])
+                       ((exceptional-subsym subsyms) next-target-weight)))]
+                [else (cons 'SYM (append (SUBSYM) ...))]))
+            (module+ main (when (= TARGET-LEN (length (SYM)))
+                            (case (current-stars)
+                              [(★) 'SYM]
+                              [else (SYM 0)]))))]
+  [(M TARGET-LEN SYM (NUM)) #'(M TARGET-LEN SYM (NUM) ->)])

2017/d7/test1.rkt

@@ -0,0 +1,14 @@
+#lang reader "main.rkt" ★
+pbga (66)
+xhth (57)
+ebii (61)
+havc (66)
+ktlj (57)
+fwft (72) -> ktlj, cntj, xhth
+qoyq (66)
+padx (45) -> pbga, havc, qoyq
+tknk (41) -> ugml, padx, fwft
+jptl (61)
+ugml (68) -> gyxo, ebii, jptl
+gyxo (61)
+cntj (57)

2017/d7/test2.rkt

@@ -0,0 +1,14 @@
+#lang reader "main.rkt" ★★
+pbga (66)
+xhth (57)
+ebii (61)
+havc (66)
+ktlj (57)
+fwft (72) -> ktlj, cntj, xhth
+qoyq (66)
+padx (45) -> pbga, havc, qoyq
+tknk (41) -> ugml, padx, fwft
+jptl (61)
+ugml (68) -> gyxo, ebii, jptl
+gyxo (61)
+cntj (57)