day 14: solution without bitvectors

14.rkt

@@ -1,17 +1,8 @@
 #lang curly-fn racket
 
 (require "scripts/aoc.rkt")
-;; data/bit-vector is hella nerfed so.... rosette uwu
-;; rosette is slow af for this but whatever
-(require (only-in rosette bv bvand bvor bvxor rotate-left concat bitvector zero-extend
-                  bitvector->natural))
 
 ;; solution for day 14
-(define (mask->bv bits select)
-  (apply concat (map #{if (equal? % select) (bv select 1) (bv (- 1 select) 1)} bits)))
-
-(define (pos->bv pos)
-  (rotate-left (- 35 pos) (zero-extend (bv 1 1) (bitvector 36))))
 
 (define (part1 input)
   (define orval #f)
@@ -19,30 +10,28 @@
   (define mem (make-hash))
   (for ([ins (in-list input)])
     (match ins
-      [(list 'mask bits ...)
+      [(list 'mask mask)
-       (set! orval (mask->bv bits 1))
+       (set! orval (string->number (string-replace mask "X" "0") 2))
-       (set! andval (mask->bv bits 0))]
+       (set! andval (string->number (string-replace mask "X" "1") 2))]
       [(list 'set addr val)
-       (hash-set! mem addr
+       (hash-set! mem addr (bor (band val andval) orval))]))
-                  (bitvector->natural (bvor (bvand (bv val 36) andval) orval)))]))
+  (apply + (hash-values mem)))
-  (for/sum ([(k v) (in-hash mem)])
-    v))
 
 (define (part2 input)
   (define mem (make-hash))
-  (define mask #f)
+  (define orval #f)
+  (define xorvals #f)
   (for ([ins (in-list input)])
     (match ins
-      [(list 'mask bits ...) (set! mask bits)]
+      [(list 'mask mask)
+       (set! orval (string->number (string-replace mask "X" "0") 2))
+       (set! xorvals
+         (for/fold ([xorvals '(0)]) ([i (in-naturals)] [m (in-string mask)] #:when (char=? #\X m))
+          (append xorvals (map #{bor (bshl 1 (- 35 i)) %} xorvals))))]
       [(list 'set addr val)
-       (define addr-bits (bvor (bv addr 36) (mask->bv mask 1)))
+       (for ([xv (in-list xorvals)])
-       (define addrs-set (list addr-bits))
+         (hash-set! mem (bxor (bor orval addr) xv) val))]))
-       (for ([item (in-list mask)] [i (in-naturals)] #:when (equal? 'x item))
+  (apply + (hash-values mem)))
-         (set! addrs-set (append addrs-set (map #{bvxor (pos->bv i) %} addrs-set))))
-       (for ([addr (in-list addrs-set)])
-         (hash-set! mem (bitvector->natural addr) val))]))
-  (for/sum ([(k v) (in-hash mem)])
-    v))
 
 ;; parse input file
 (define (parse fname)
@@ -50,20 +39,11 @@
   (for/list ([i (in-list input)])
     (match i
       [(pregexp #px"^mask = (.*?)$" (list _ mask))
-       (cons 'mask (for/list ([chr (in-string mask)])
+       (list 'mask mask)]
-                     (match chr
-                       [#\1 1]
-                       [#\0 0]
-                       [#\X 'x])))]
       [(pregexp #px"^mem\\[([0-9]+)\\] = ([0-9]+)$" (list _ addr val))
        (list 'set (string->number addr) (string->number val))]
       [_ (error "not shonks i")])))
 
-(module+ test
-  (require rackunit)
-  ;; tests here
-  (displayln "no tests :("))
-
 (module+ main
   (define input (parse "inputs/14"))
   (answer 14 1 (time (part1 input)))

scripts/aoc.rkt

@@ -4,6 +4,7 @@
 
 (require "aoc-lib.rkt" threading syntax/parse/define (for-syntax racket/syntax) graph)
 (provide answer dbg memoize define/memoized
+         band bor bxor bshl bshr
          (all-from-out threading syntax/parse/define graph)
          (for-syntax (all-from-out racket/syntax)))
 
@@ -12,6 +13,12 @@
   (pretty-write x)
   x)
 
+(define band bitwise-and)
+(define bor bitwise-ior)
+(define bxor bitwise-xor)
+(define bshl arithmetic-shift)
+(define bshr #{arithmetic-shift %1 (- %2)})
+
 ;; makes a memoization wrapper around a function
 (define (memoize func)
   (define memo (make-hash))