You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
beautiful-racket/beautiful-racket/br/demo/wires/expander.rkt

41 lines
1.3 KiB
Racket

8 years ago
#lang br/quicklang
8 years ago
(provide #%module-begin wire
AND OR LSHIFT RSHIFT NOT)
8 years ago
(define-macro-cases wire
8 years ago
[(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)))]
8 years ago
[else #'(void)])
8 years ago
(define-macro (define/display (ID) BODY)
#'(begin
(define (ID) BODY)
(module+ main
(displayln (format "~a: ~a" 'ID (ID))))))
8 years ago
8 years ago
(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)))))
8 years ago
8 years ago
(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))))
8 years ago
8 years ago
(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))