daylang.rkt

#lang s-exp syntax/module-reader
(submod "daylang.rkt" semantics)
#:read my-read
#:read-syntax my-read-syntax

(define (my-read in) (syntax->datum (my-read-syntax #f in)))

(define (my-read-syntax src in)
  (define line (read-line in))
  (if (eof-object? line)
      eof
      (read-syntax src (open-input-string (format "(wire ~a)" line)))))

(module semantics racket
  (provide (all-defined-out) (all-from-out racket))

  (define-syntax (wire stx)
    (syntax-case stx (->)
      [(_ arg -> id)
       #'(define (id) (get-val arg))]
      [(_ op arg -> id)
       #'(define (id) (op (get-val arg)))]
      [(_ arg1 op arg2 -> id)
       #'(define (id) (op (get-val arg1) (get-val arg2)))]
      [(_ expr) #'(begin expr)]
      [else #'(void)]))
  
  (define wire-value-cache (make-hash))
  (define (get-val x)
    (if (procedure? x)
        (hash-ref! wire-value-cache x (λ _ (x)))
        x))
  
  (define (16bitize x)
    (define 16bit-max (expt 2 16))
    (define r (modulo x 16bit-max))
    (if (negative? r)
        (16bitize (+ 16bit-max r))
        r))
  
  (define-syntax-rule (define-16bit id proc) (define id (compose1 16bitize proc)))
  (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))