solve puzzle

beautiful-racket/br/demo/wires/expander.rkt

@@ -1,41 +1,41 @@
 #lang br/quicklang
-(define-macro (wires-module-begin WIRE-DATUM ...)
-  #'(#%module-begin
-     WIRE-DATUM ...))
-(provide (rename-out [wires-module-begin #%module-begin]))
+(provide #%module-begin wire
+         AND OR LSHIFT RSHIFT NOT)
 
 (define-macro-cases wire
-  [(wire VAL -> ID) #'(define (ID)
-                        (val VAL))]
-  [(wire OP VAL -> ID) #'(define (ID)
-                           (OP (val VAL)))]
-  [(wire VAL1 OP VAL2 -> ID) #'(define (ID)
-                                 (OP (val VAL1) (val VAL2)))]
+  [(wire ARG -> ID) #'(define/display (ID)
+                        (val ARG))]
+  [(wire OP ARG -> ID) #'(define/display (ID)
+                           (OP (val ARG)))]
+  [(wire ARG1 OP ARG2 -> ID) #'(define/display (ID)
+                                 (OP (val ARG1) (val ARG2)))]
   [else #'(void)])
-(provide wire)
 
-(define-macro (print-wire ID)
-  #'(println (format "~a: ~a" 'ID (ID))))
+(define-macro (define/display (ID) BODY)
+  #'(begin
+      (define (ID) BODY)
+      (module+ main
+        (displayln (format "~a: ~a" 'ID (ID))))))
 
-(define wire-cache (make-hash))
-(define (val num-or-func)
-  (if (number? num-or-func)
-      num-or-func
-      (hash-ref! wire-cache num-or-func num-or-func)))
+(define val
+  (let ([wire-cache (make-hash)])
+    (λ (num-or-wire)
+      (if (number? num-or-wire)
+          num-or-wire
+          (hash-ref! wire-cache num-or-wire num-or-wire)))))
 
-(define (16bitize x)
-  (define 16bit-max (expt 2 16))
-  (define r (modulo x 16bit-max))
-  (if (negative? r)
-      (16bitize (+ 16bit-max r))
-      r))
- 
-(define-macro (define-16bit ID PROC)
-  #'(define ID (compose1 16bitize PROC)))
+(define (mod-16bit x)
+  (define max-16bit (expt 2 16))
+  (define remainder (modulo x max-16bit))
+  (if (not (negative? remainder))
+      remainder
+      (mod-16bit (+ max-16bit remainder))))
 
-(define-16bit AND bitwise-and)
-(define-16bit OR bitwise-ior)
-(define-16bit LSHIFT arithmetic-shift)
-(define-16bit RSHIFT (λ(x y) (arithmetic-shift x (- y))))
-(define-16bit NOT bitwise-not)
-(provide AND OR LSHIFT RSHIFT NOT)
+(define-macro (define-16bit ID+ARGS BODY)
+  #'(define ID+ARGS (mod-16bit BODY)))
+
+(define-16bit (AND arg1 arg2) (bitwise-and arg1 arg2))
+(define-16bit (OR arg1 arg2) (bitwise-ior arg1 arg2))
+(define-16bit (LSHIFT arg1 arg2) (arithmetic-shift arg1 arg2))
+(define-16bit (RSHIFT arg1 arg2) (arithmetic-shift arg1 (- arg2)))
+(define-16bit (NOT arg) (bitwise-not arg))