solve puzzle

dev-srcloc
Matthew Butterick 8 years ago
parent a4474340b5
commit ea28427d86

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