pull/2/head
Matthew Butterick 8 years ago
parent 3af79f911f
commit e631c39bf2

@ -1,4 +1,5 @@
#lang br
(require (for-syntax br/syntax))
(provide #%top-interaction #%module-begin #%datum (rename-out [my-top #%top]) #%app
(all-defined-out))
@ -10,25 +11,27 @@
(define #'(tst-program _arg ...) #'(begin _arg ...))
(begin-for-syntax
(define-scope blue))
(define #'(header-expr _filename (_colid ... _outid))
(with-syntax* ([filename-string (symbol->string (syntax->datum #'_filename))]
[procname (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))]
[output (syntax-local-introduce (datum->syntax #f 'output))])
#'(begin
(provide (all-defined-out))
(define procname
(dynamic-require (findf file-exists?
(list filename-string (format "~a.rkt" filename-string))) 'procname))
(display-header '_colid ... '_outid)
(define _colid (make-parameter 0)) ...
(define (_outid)
(keyword-apply procname
(map (compose1 string->keyword symbol->string) (list '_colid ...))
(list (_colid) ...) null))
(define (output)
(display-values (_colid) ... (_outid))))))
[procname (string->symbol (cadr (regexp-match #rx"^(.*)\\.hdl$"(symbol->string (syntax->datum #'_filename)))))])
(with-blue-binding-form (output)
#'(begin
(provide (all-defined-out))
(define procname
(dynamic-require (findf file-exists?
(list filename-string (format "~a.rkt" filename-string))) 'procname))
(display-header '_colid ... '_outid)
(define _colid (make-parameter 0)) ...
(define (_outid)
(keyword-apply procname
(map (compose1 string->keyword symbol->string) (list '_colid ...))
(list (_colid) ...) null))
(define (output)
(display-values (_colid) ... (_outid)))))))
(define #'(display-header _sym ...)
#'(begin
@ -47,5 +50,5 @@
(define #'eval-expr #'void)
(define #'(output-expr)
(inject-syntax ([#'output 'output])
#'(output)))
(with-blue-identifiers (output)
#'(output)))

@ -1,4 +1,4 @@
#lang br/demo/hdl/tst
#lang br/demo/hdl-tst
// This file is part of www.nand2tetris.org
// and the book "The Elements of Computing Systems"

@ -1,13 +0,0 @@
#lang br
(define+provide (Nand #:a a #:b b)
(if (< (+ a b) 2)
1
0))
(module+ test
(require rackunit)
(check-equal? (Nand #:a 0 #:b 0) 1)
(check-equal? (Nand #:a 0 #:b 1) 1)
(check-equal? (Nand #:a 1 #:b 0) 1)
(check-equal? (Nand #:a 1 #:b 1) 0))

@ -0,0 +1,28 @@
#lang br
(define Nand-a
(let ([Nand-a-val 0])
(λ ([val #f])
(if val
(set! Nand-a-val val)
Nand-a-val))))
(define Nand-b
(let ([Nand-b-val 0])
(λ ([val #f])
(if val
(set! Nand-b-val val)
Nand-b-val))))
(define (Nand-out)
(if (< (+ (Nand-a) (Nand-b)) 2)
1
0))
(module+ test
(require rackunit)
(check-equal? (begin (Nand-a 0) (Nand-b 0) (Nand-out)) 1)
(check-equal? (begin (Nand-a 0) (Nand-b 1) (Nand-out)) 1)
(check-equal? (begin (Nand-a 1) (Nand-b 0) (Nand-out)) 1)
(check-equal? (begin (Nand-a 1) (Nand-b 1) (Nand-out)) 0))

@ -1,4 +1,4 @@
#lang br/demo/hdl/tst
#lang br/demo/hdl-tst
/* nand */

@ -1,4 +1,4 @@
#lang br/demo/hdl/tst
#lang br/demo/hdl-tst
/* Not */

@ -1,4 +1,4 @@
#lang br/demo/hdl/tst
#lang br/demo/hdl-tst
/* or */

@ -0,0 +1,13 @@
#lang br/demo/hdl
CHIP And {
IN a, b;
OUT out;
PARTS:
Nand(a=a, b=b, out=nandout);
Not(in=nandout, out=out);
}

@ -1,4 +1,4 @@
#lang br/demo/hdl/tst
#lang br/demo/hdl-tst
load Xor.hdl,
output-list a, b, out;
Loading…
Cancel
Save