From 5303f4ced1d10f08f788f340feb08c77b39a3346 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 26 Apr 2016 00:25:25 -0700 Subject: [PATCH] ugly but effective --- beautiful-racket/br/demo/hdl/And.hdl | 27 ++++++------ .../br/demo/hdl/Nand-Derived.hdl.rkt | 1 + beautiful-racket/br/demo/hdl/Not.hdl | 20 +++++---- beautiful-racket/br/demo/hdl/Not2.hdl.rkt | 7 ++-- beautiful-racket/br/demo/hdl/Or.hdl | 27 ++++++------ beautiful-racket/br/demo/hdl/expander.rkt | 41 +++++++++++-------- beautiful-racket/br/demo/hdl/parser.rkt | 10 ++--- beautiful-racket/br/demo/hdl/tokenizer.rkt | 2 +- 8 files changed, 70 insertions(+), 65 deletions(-) create mode 100644 beautiful-racket/br/demo/hdl/Nand-Derived.hdl.rkt diff --git a/beautiful-racket/br/demo/hdl/And.hdl b/beautiful-racket/br/demo/hdl/And.hdl index e5f9b1b..b519f67 100644 --- a/beautiful-racket/br/demo/hdl/And.hdl +++ b/beautiful-racket/br/demo/hdl/And.hdl @@ -1,14 +1,13 @@ -#lang s-exp br/demo/hdl/expander0 - -(chip And - (a b) - (out) - ((Nand [a a] [b b] [out nand-out]) - (Not [in nand-out] [out out]))) - -(module+ test - (require rackunit) - (check-equal? (And #:a 0 #:b 0) 0) - (check-equal? (And #:a 0 #:b 1) 0) - (check-equal? (And #:a 1 #:b 0) 0) - (check-equal? (And #:a 1 #:b 1) 1)) \ No newline at end of file +#lang br/demo/hdl + +CHIP And { + IN a, b; + OUT out; + + PARTS: + Nand(a=a, b=b, out=nandout); + Not(in=nandout, out=out); + } + + + diff --git a/beautiful-racket/br/demo/hdl/Nand-Derived.hdl.rkt b/beautiful-racket/br/demo/hdl/Nand-Derived.hdl.rkt new file mode 100644 index 0000000..6f1f7b4 --- /dev/null +++ b/beautiful-racket/br/demo/hdl/Nand-Derived.hdl.rkt @@ -0,0 +1 @@ +#lang racket diff --git a/beautiful-racket/br/demo/hdl/Not.hdl b/beautiful-racket/br/demo/hdl/Not.hdl index 6c9ee66..df87a41 100644 --- a/beautiful-racket/br/demo/hdl/Not.hdl +++ b/beautiful-racket/br/demo/hdl/Not.hdl @@ -1,11 +1,13 @@ -#lang s-exp br/demo/hdl/expander0 +#lang br/demo/hdl + +CHIP Not { + IN in; + OUT out; + + PARTS: + Nand(a=in, b=in, out=out); + + } + -(chip Not - (in) - (out) - ((Nand [a in] [b in] [out out]))) -(module+ test - (require rackunit) - (check-equal? (Not #:in 0) 1) - (check-equal? (Not #:in 1) 0)) \ No newline at end of file diff --git a/beautiful-racket/br/demo/hdl/Not2.hdl.rkt b/beautiful-racket/br/demo/hdl/Not2.hdl.rkt index 698fd5b..b519f67 100644 --- a/beautiful-racket/br/demo/hdl/Not2.hdl.rkt +++ b/beautiful-racket/br/demo/hdl/Not2.hdl.rkt @@ -1,11 +1,12 @@ #lang br/demo/hdl -CHIP Not { - IN in; +CHIP And { + IN a, b; OUT out; PARTS: - Nand(a=in, b=in, out=out); + Nand(a=a, b=b, out=nandout); + Not(in=nandout, out=out); } diff --git a/beautiful-racket/br/demo/hdl/Or.hdl b/beautiful-racket/br/demo/hdl/Or.hdl index 7794ab9..36457aa 100644 --- a/beautiful-racket/br/demo/hdl/Or.hdl +++ b/beautiful-racket/br/demo/hdl/Or.hdl @@ -1,16 +1,13 @@ -#lang s-exp br/demo/hdl/expander0 +#lang br/demo/hdl -(chip Or - (a b) - (out) - ((Not [in a] [out nota]) - (Not [in b] [out notb]) - (And [a nota] [b notb] [out and-out]) - (Not [in and-out] [out out]))) - -(module+ test - (require rackunit) - (check-equal? (Or #:a 0 #:b 0) 0) - (check-equal? (Or #:a 0 #:b 1) 1) - (check-equal? (Or #:a 1 #:b 0) 1) - (check-equal? (Or #:a 1 #:b 1) 1)) \ No newline at end of file +CHIP Or { + IN a, b; + OUT out; + + PARTS: + Not(in=a, out=nota); + Not(in=b, out=notb); + And(a=nota, b=notb, out=andout); + Not(in=andout, out=out); + + } diff --git a/beautiful-racket/br/demo/hdl/expander.rkt b/beautiful-racket/br/demo/hdl/expander.rkt index f2d4f80..4f94eb4 100644 --- a/beautiful-racket/br/demo/hdl/expander.rkt +++ b/beautiful-racket/br/demo/hdl/expander.rkt @@ -5,40 +5,46 @@ (define #'(chip-program "CHIP" _arg ...) #'(chip _arg ...)) -(provide pin-spec-in) -(define #'(pin-spec-in "IN" _pin-list ";") +(provide pin-spec) +(define #'(pin-spec _label _pin-list ";") #'_pin-list) -(provide pin-spec-out) -(define #'(pin-spec-out "OUT" _pin-list ";") - #'_pin-list) - - (require (for-syntax sugar/debug)) +(define-for-syntax (remove-separators stx-or-list sep) + (for/list ([item (in-list (if (list? stx-or-list) + stx-or-list + (syntax->list stx-or-list)))] + #:when (not (equal? sep (syntax->datum item)))) + item)) + (provide pin-list) (define #'(pin-list . _pin-or-commas) - (for/list ([stx (in-list (syntax->list #'_pin-or-commas))] - #:when (not (equal? "," (report (syntax->datum stx))))) - stx)) + (remove-separators #'_pin-or-commas ",")) (begin-for-syntax (define (expand-macro mac) - (syntax-disarm (report (local-expand mac 'expression #f)) #f))) + (syntax-disarm (local-expand mac 'expression #f) #f))) (provide part-spec) (define #'(part-spec "PARTS:" _part-list) #'_part-list) (provide part-list) -(define #'(part-list _part ";") - #'_part) +(define #'(part-list . _part-or-semicolons) + (inject-syntax ([#'(part ...) (remove-separators #'_part-or-semicolons "'")]) + #'(begin part ...))) + +(require (for-syntax sugar/list)) +(define-for-syntax (ugly-processing stx) + (slice-at (remove-separators (remove-separators stx ",") "=") 2)) (provide part) -(define #'(part _partname "(" _pin-in "=" _val-id "," _pin-in2 "=" _val-id2 "," out "=" _pin-out ")") +(define #'(part _partname "(" _pin-id-etc ... out "=" _pin-out ")" ";") + (with-syntax ([((_pin-in _val-id) ...) (ugly-processing #'(_pin-id-etc ...))]) #'(begin - (define _pin-out (call-part _partname [_pin-in _val-id][_pin-in2 _val-id2])))) + (define _pin-out (call-part _partname [_pin-in _val-id] ...))))) (define #'(chip _chipname "{" _input-pins @@ -50,12 +56,13 @@ #'(begin (provide _chipname) (define _chipname - (make-keyword-procedure + (procedure-rename + (make-keyword-procedure (λ (kws kw-args . rest) (define kw-pairs (map cons kws kw-args)) (let ([_input-pin (cdr (assq (string->keyword (format "~a" '_input-pin)) kw-pairs))] ...) _part - (values _output-pin ...)))))))) + (values _output-pin ...)))) '_chipname))))) (provide call-part) (define #'(call-part _Part [_pin-in _val-id] ...) diff --git a/beautiful-racket/br/demo/hdl/parser.rkt b/beautiful-racket/br/demo/hdl/parser.rkt index 0fee21a..9ddd06c 100644 --- a/beautiful-racket/br/demo/hdl/parser.rkt +++ b/beautiful-racket/br/demo/hdl/parser.rkt @@ -1,15 +1,13 @@ #lang ragg -chip-program : "CHIP" ID "{" pin-spec-in pin-spec-out part-spec "}" +chip-program : "CHIP" ID "{" pin-spec pin-spec part-spec "}" -pin-spec-in : "IN" pin-list ";" - -pin-spec-out : "OUT" pin-list ";" +pin-spec : ("IN" | "OUT") pin-list ";" pin-list : ID ["," ID]* part-spec : "PARTS:" part-list -part-list : [part ";"]+ +part-list : [part]+ -part : ID "(" ID "=" ID ["," ID "=" ID]* ")" +part : ID "(" ID "=" ID ["," ID "=" ID]* ")" ";" diff --git a/beautiful-racket/br/demo/hdl/tokenizer.rkt b/beautiful-racket/br/demo/hdl/tokenizer.rkt index 37b5986..8612454 100644 --- a/beautiful-racket/br/demo/hdl/tokenizer.rkt +++ b/beautiful-racket/br/demo/hdl/tokenizer.rkt @@ -12,6 +12,6 @@ [(union #\tab #\space #\newline) (get-token input-port)] [(union "CHIP" "IN" "OUT" "PARTS:") lexeme] [(char-set "{}(),;=") lexeme] - [(repetition 1 +inf.0 (union alphabetic numeric)) (token 'ID (string->symbol lexeme))])) + [(repetition 1 +inf.0 (union alphabetic numeric "-")) (token 'ID (string->symbol lexeme))])) (get-token input-port)) next-token)