mbutterick
/
beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

burnish

Browse Source
v6.3-exception
Matthew Butterick 7 years ago
parent 1826f8a00f
commit 545b4229fb
11 changed files with 50 additions and 271 deletions
Show Stats Download Patch File Download Diff File

27
beautiful-racket-demo/hdl-demo/DMux.tst
Unescape Escape View File

@ -1,27 +0,0 @@
// This file is part of www.nand2tetris.org
// and the book "The Elements of Computing Systems"
// by Nisan and Schocken, MIT Press.
// File name: projects/01/DMux.tst
load DMux.hdl,
output-file DMux.out,
compare-to DMux.cmp,
output-list in%B3.1.3 sel%B3.1.3 a%B3.1.3 b%B3.1.3;
set in 0,
set sel 0,
eval,
output;
set sel 1,
eval,
output;
set in 1,
set sel 0,
eval,
output;
set sel 1,
eval,
output;

43
beautiful-racket-demo/hdl-demo/DMux4Way.tst
Unescape Escape View File

@ -1,43 +0,0 @@
// This file is part of www.nand2tetris.org
// and the book "The Elements of Computing Systems"
// by Nisan and Schocken, MIT Press.
// File name: projects/01/DMux4Way.tst
load DMux4Way.hdl,
output-file DMux4Way.out,
compare-to DMux4Way.cmp,
output-list in%B2.1.2 sel%B2.2.2 a%B2.1.2 b%B2.1.2 c%B2.1.2 d%B2.1.2;
set in 0,
set sel %B00,
eval,
output;
set sel %B01,
eval,
output;
set sel %B10,
eval,
output;
set sel %B11,
eval,
output;
set in 1,
set sel %B00,
eval,
output;
set sel %B01,
eval,
output;
set sel %B10,
eval,
output;
set sel %B11,
eval,
output;

49
beautiful-racket-demo/hdl-demo/Mux.tst
Unescape Escape View File

@ -1,49 +0,0 @@
// This file is part of www.nand2tetris.org
// and the book "The Elements of Computing Systems"
// by Nisan and Schocken, MIT Press.
// File name: projects/01/Mux.tst
load Mux.hdl,
output-file Mux.out,
compare-to Mux.cmp,
output-list a%B3.1.3 b%B3.1.3 sel%B3.1.3 out%B3.1.3;
set a 0,
set b 0,
set sel 0,
eval,
output;
set sel 1,
eval,
output;
set a 0,
set b 1,
set sel 0,
eval,
output;
set sel 1,
eval,
output;
set a 1,
set b 0,
set sel 0,
eval,
output;
set sel 1,
eval,
output;
set a 1,
set b 1,
set sel 0,
eval,
output;
set sel 1,
eval,
output;

17
beautiful-racket-demo/hdl-demo/Not-sexp.rkt
Unescape Escape View File

@ -1,17 +0,0 @@
#lang s-exp hdl-demo/expander
#|
CHIP Not {
IN in;
OUT out;
PARTS:
Nand(a=in, b=in, out=out);
}
|#
(chip-program Not
(in-spec (in))
(out-spec (out))
(part Nand (a in) (b in) (out out)))

34
beautiful-racket-demo/hdl-demo/Not.tst-sexp.rkt
Unescape Escape View File

@ -1,34 +0,0 @@
#lang s-exp hdl-tst-demo/expander
#|
load Not.hdl,
output-file Not.out,
compare-to Not.cmp,
output-list in%B3.1.3 out%B3.1.3;
set in 0,
eval,
output;
set in 1,
eval,
output;
|#
(require hdl-demo-tst/hdlprint rackunit racket/file)
(require "Not.hdl.rkt") ; load Not.hdl,
(define of (open-output-file "Not.out" #:mode 'text #:exists 'replace)) ; output-file Not.out,
(define (output in out) ; output-list in%B3.1.3 out%B3.1.3;
(fprintf of (format "~a\n" (string-join (list (hdlprint in "%B3.1.3") (hdlprint out "%B3.1.3")) "|" #:before-first "|" #:after-last "|"))))
(define eval-result #f)
(define eval-thunk (λ () (list (Not-in) (Not-out)))) ; output-list in%B3.1.3 out%B3.1.3;
(output "in" "out") ; put names at top of output
(Not-in-write 0) ; set in 0,
(set! eval-result (eval-thunk)) ; eval,
(apply output eval-result) ; output;
(Not-in-write 1) ; set in 1,
(set! eval-result (eval-thunk)) ; eval,
(apply output eval-result) ; output;
(close-output-port of)
(display (file->string "Not.out"))
(check-equal? (file->lines "Not.out") (file->lines "Not.cmp")) ; compare-to Not.cmp,

29
beautiful-racket-demo/hdl-demo/Or.tst
Unescape Escape View File

@ -1,29 +0,0 @@
// This file is part of www.nand2tetris.org
// and the book "The Elements of Computing Systems"
// by Nisan and Schocken, MIT Press.
// File name: projects/01/Or.tst
load Or.hdl,
output-file Or.out,
compare-to Or.cmp,
output-list a%B3.1.3 b%B3.1.3 out%B3.1.3;
set a 0,
set b 0,
eval,
output;
set a 0,
set b 1,
eval,
output;
set a 1,
set b 0,
eval,
output;
set a 1,
set b 1,
eval,
output;

29
beautiful-racket-demo/hdl-demo/Xor.tst
Unescape Escape View File

@ -1,29 +0,0 @@
// This file is part of www.nand2tetris.org
// and the book "The Elements of Computing Systems"
// by Nisan and Schocken, MIT Press.
// File name: projects/01/Xor.tst
load Xor.hdl,
output-file Xor.out,
compare-to Xor.cmp,
output-list a%B3.1.3 b%B3.1.3 out%B3.1.3;
set a 0,
set b 0,
eval,
output;
set a 0,
set b 1,
eval,
output;
set a 1,
set b 0,
eval,
output;
set a 1,
set b 1,
eval,
output;

8
beautiful-racket-demo/hdl-demo/bus.rkt
Unescape Escape View File

@ -33,7 +33,7 @@
(reverse (for/list ([i (in-range width)]) (reverse (for/list ([i (in-range width)])
(bitwise-bit-field int i (add1 i))))) (bitwise-bit-field int i (add1 i)))))
(define max-bus-width 64) (define max-bus-width 16)
(define default-bus-width 1) (define default-bus-width 1)
@ -113,9 +113,9 @@ base bus:
(define ID (define ID
(begin (begin
(unless (<= bus-width max-bus-width) (unless (<= bus-width max-bus-width)
(raise-argument-error 'id (format "bus width <= max width ~a" max-bus-width) bus-width)) (raise-argument-error 'ID (format "bus width <= max width ~a" max-bus-width) bus-width))
(impersonate-procedure (impersonate-procedure
(let ([reader (make-bus-reader 'id bus-width)]) (let ([reader (make-bus-reader 'ID bus-width)])
(procedure-rename (λ args (apply reader (ID-THUNK) args)) (string->symbol (format "~a:~a-bit" 'ID bus-width)))) (procedure-rename (λ args (apply reader (ID-THUNK) args)) (string->symbol (format "~a:~a-bit" 'ID bus-width))))
#f BUS-TYPE #t))) #f BUS-TYPE #t)))
#,(when (syntax-property caller-stx 'writer) #,(when (syntax-property caller-stx 'writer)
@ -201,7 +201,7 @@ input bus:
(check-false (bus? ib)) (check-false (bus? ib))
(check-false (output-bus? ib)) (check-false (output-bus? ib))
(check-true (input-bus? ib)) (check-true (input-bus? ib))
(check-exn exn:fail? (λ () (define-input-bus ib 17) ib)) ; exceeds 16-bit width #;(check-exn exn:fail? (λ () (define-input-bus ib 17) ib)) ; exceeds 16-bit width
(check-equal? (ib) 0) (check-equal? (ib) 0)
(ib-write 11) ; set whole value (ib-write 11) ; set whole value
(check-equal? (ib) 11) (check-equal? (ib) 11)

71
beautiful-racket-demo/hdl-demo/expander.rkt
Unescape Escape View File

@ -7,28 +7,28 @@
(out-spec (OUT-BUS OUT-WIDTH ...) ...) (out-spec (OUT-BUS OUT-WIDTH ...) ...)
PART ...) PART ...)
(with-pattern (with-pattern
([CHIP-PREFIX (suffix-id #'CHIPNAME "-")] ([CHIP-PREFIX (suffix-id #'CHIPNAME "-")]
[(IN-BUS-WRITE ...) (suffix-id #'(IN-BUS ...) "-write")] [(IN-BUS-WRITE ...) (suffix-id #'(IN-BUS ...) "-write")]
[(PREFIX-OUT-BUS ...) (prefix-id #'CHIP-PREFIX #'(OUT-BUS ...))]) [(PREFIX-OUT-BUS ...) (prefix-id #'CHIP-PREFIX #'(OUT-BUS ...))])
#'(begin #'(begin
(provide (prefix-out CHIP-PREFIX (combine-out IN-BUS ... IN-BUS-WRITE ...))) (provide (prefix-out CHIP-PREFIX (combine-out IN-BUS ... IN-BUS-WRITE ...)))
(define-input-bus IN-BUS IN-WIDTH ...) ... (define-input-bus IN-BUS IN-WIDTH ...) ...
PART ... PART ...
(provide PREFIX-OUT-BUS ...) (provide PREFIX-OUT-BUS ...)
(define-output-bus PREFIX-OUT-BUS OUT-BUS OUT-WIDTH ...) ...))) (define-output-bus PREFIX-OUT-BUS OUT-BUS OUT-WIDTH ...) ...)))
(define-macro (part PARTNAME ((BUS-LEFT . BUS-LEFT-ARGS) BUS-RIGHT-EXPR) ...) (define-macro (part PARTNAME ((BUS-LEFT . BUS-LEFT-ARGS) BUS-RIGHT-EXPR) ...)
(with-pattern (with-pattern
([(PARTNAME-BUS-LEFT ...) (prefix-id #'PARTNAME "-" #'(BUS-LEFT ...))] ([(PARTNAME-BUS-LEFT ...) (prefix-id #'PARTNAME "-" #'(BUS-LEFT ...))]
[PARTNAME-MODULE-PATH (format-string "~a.hdl.rkt" #'PARTNAME)]) [PARTNAME-MODULE-PATH (format-string "~a.hdl.rkt" #'PARTNAME)])
#'(begin #'(begin
(require (import-chip PARTNAME-MODULE-PATH) (require (import-chip PARTNAME-MODULE-PATH)
;; need for-syntax to make phase 1 binding available ;; need for-syntax to make phase 1 binding available
;; so we can determine during expansion which buses are `input-bus?` ;; so we can determine during expansion which buses are `input-bus?`
;; because the pin-spec syntax is inherently ambiguous ;; because the pin-spec syntax is inherently ambiguous
(for-syntax (import-chip PARTNAME-MODULE-PATH))) (for-syntax (import-chip PARTNAME-MODULE-PATH)))
(handle-buses ((PARTNAME-BUS-LEFT . BUS-LEFT-ARGS) BUS-RIGHT-EXPR) ...)))) (handle-buses ((PARTNAME-BUS-LEFT . BUS-LEFT-ARGS) BUS-RIGHT-EXPR) ...))))
(define-syntax import-chip (define-syntax import-chip
@ -38,23 +38,26 @@
[(_ module-path) [(_ module-path)
(expand-import #'module-path)])))) (expand-import #'module-path)]))))
(require (for-syntax racket/list))
(define-macro (handle-buses BUS-ASSIGNMENTS ...) (define-macro (handle-buses BUS-ASSIGNMENTS ...)
(let-values (let-values
;; we "pre-evaluate" #'PREFIXED-WIRE so we can set up the program correctly.
;; This is not ideal: usually we want evaluate runtime expressions only at runtime.
;; But in this case, it controls which identifiers we `define` as output buses
;; so there's no way around it. Runtime would be too late.
([(in-bus-assignments out-bus-assignments) ([(in-bus-assignments out-bus-assignments)
(syntax-case-partition #'(BUS-ASSIGNMENTS ...) () (partition (λ (stx)
[((PREFIXED-WIRE . _) _) (syntax-case stx ()
;; we "pre-evaluate" #'PREFIXED-WIRE so we can set up the program correctly. [((PREFIXED-WIRE . _) _)
;; This is not ideal: usually we want evaluate runtime expressions only at runtime. (input-bus? (syntax-local-eval #'PREFIXED-WIRE))
;; But in this case, it controls which identifiers we `define` as output buses #'PREFIXED-WIRE]
;; so there's no way around it. Runtime would be too late. [else #f])) (syntax->list #'(BUS-ASSIGNMENTS ...)))])
(input-bus? (syntax-local-eval #'PREFIXED-WIRE))])])
(with-pattern (with-pattern
([(((IN-BUS IN-BUS-ARG ...) IN-BUS-VALUE) ...) in-bus-assignments] ([(((IN-BUS IN-BUS-ARG ...) IN-BUS-VALUE) ...) in-bus-assignments]
[(IN-BUS-WRITE ...) (suffix-id #'(IN-BUS ...) "-write")] [(IN-BUS-WRITE ...) (suffix-id #'(IN-BUS ...) "-write")]
[((OUT-BUS-EXPR (NEW-OUT-BUS)) ...) out-bus-assignments]) [((OUT-BUS-EXPR (NEW-OUT-BUS)) ...) out-bus-assignments])
#'(begin #'(begin
(define-output-bus NEW-OUT-BUS (define-output-bus NEW-OUT-BUS
(λ () (λ ()
(IN-BUS-WRITE IN-BUS-ARG ... IN-BUS-VALUE) ... (IN-BUS-WRITE IN-BUS-ARG ... IN-BUS-VALUE) ...
OUT-BUS-EXPR)) ...)))) OUT-BUS-EXPR)) ...))))

8
beautiful-racket-demo/hdl-demo/reader.rkt
Unescape Escape View File

@ -1,6 +1,8 @@
#lang br #lang br
(require "parser.rkt" "tokenizer.rkt") (require "parser.rkt" "tokenizer.rkt")
(provide read-syntax) (provide read-syntax)
(define (read-syntax source-path input-port) (define (read-syntax src ip)
#`(module hdl-mod hdl-demo/expander (strip-context
#,(parse source-path (tokenize input-port)))) (with-syntax ([PT (parse src (tokenize ip))])
#'(module hdl-mod hdl-demo/expander
PT))))

6
beautiful-racket-demo/hdl-tst-demo/main.rkt
Unescape Escape View File

@ -8,5 +8,7 @@
(define port+newline (input-port-append #f port (open-input-string "\n"))) (define port+newline (input-port-append #f port (open-input-string "\n")))
(port-count-lines! port+newline) (port-count-lines! port+newline)
(set-port-next-location! port+newline line col pos) (set-port-next-location! port+newline line col pos)
#`(module hdl-mod hdl-tst-demo/expander (strip-context
#,(parse source-path (make-tokenizer port+newline))))) (with-syntax ([PT (parse source-path (make-tokenizer port+newline))])
#'(module hdl-mod hdl-tst-demo/expander
PT)))))

Write Preview
Loading…
Cancel
Save