suzanne.soy/beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refine

Browse Source
This commit is contained in:
Matthew Butterick 2016-04-26 16:36:50 -07:00
parent 2feaa1084d
commit a6de2888d9
2 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
beautiful-racket/br/demo/hdl/expander.rkt
View File

@ -1,32 +1,32 @@
#lang br #lang br
(provide #%top-interaction #%module-begin (all-defined-out)) (provide #%top-interaction #%module-begin (all-defined-out))
(define-inverting #'(chip-program "CHIP" _arg ...) (define #'(chip-program "CHIP" _arg ...)
#'(chip _arg ...)) #'(chip _arg ...))
(define-inverting #'(pin-spec _label _pin-list ";") (define #'(pin-spec _label _pin-list ";")
#'_pin-list) #'_pin-list)
(define-inverting #'(pin-list _id _comma-id ...) (define-inverting #'(pin-list _id _another-id ...)
#'(_id _comma-id ...)) #'(_id _another-id ...))
(define-inverting #'(comma-id "," _id) (define #'(another-id "," _id)
#'_id) #'_id)
(define-inverting #'(part-spec "PARTS:" _part-list) (define #'(part-spec "PARTS:" _part-list)
#'_part-list) #'_part-list)
(define-inverting #'(part-list _part ...) (define #'(part-list _part ...)
#'(begin _part ...)) #'(begin _part ...))
(define-inverting #'(part _partname "(" _firstpin "=" _firstval _commaidpair ... (_lastpin _pinout) ")" ";") (define-inverting #'(part _partname "(" _firstpin "=" _firstval _another-id-pair ... (_lastpin _pinout) ")" ";")
#'(begin #'(begin
(define _pinout (call-part _partname [_firstpin _firstval] _commaidpair ...)))) (define _pinout (call-part _partname [_firstpin _firstval] _another-id-pair ...))))
(define #'(comma-id-pair "," _firstid "=" _secondid) (define #'(another-id-pair "," _firstid "=" _secondid)
#'(_firstid _secondid)) #'(_firstid _secondid))
(define-inverting #'(call-part _Part [_pin-in _val-id] ...) (define #'(call-part _Part [_pin-in _val-id] ...)
(with-syntax ([part-path (format "~a.hdl" (syntax->datum #'_Part))] (with-syntax ([part-path (format "~a.hdl" (syntax->datum #'_Part))]
[(kw ...) (map (λ(pi) (string->keyword (format "~a" (syntax->datum pi)))) (syntax->list #'(_pin-in ...)))]) [(kw ...) (map (λ(pi) (string->keyword (format "~a" (syntax->datum pi)))) (syntax->list #'(_pin-in ...)))])
#'(let () #'(let ()

8
beautiful-racket/br/demo/hdl/parser.rkt
View File

@ -4,14 +4,14 @@ chip-program : "CHIP" ID "{" pin-spec pin-spec part-spec "}"
pin-spec : ("IN" | "OUT") pin-list ";" pin-spec : ("IN" | "OUT") pin-list ";"
pin-list : ID comma-id* pin-list : ID another-id*
comma-id : "," ID another-id : "," ID
part-spec : "PARTS:" part-list part-spec : "PARTS:" part-list
part-list : part+ part-list : part+
part : ID "(" ID "=" ID comma-id-pair* ")" ";" part : ID "(" ID "=" ID another-id-pair* ")" ";"
comma-id-pair : "," ID "=" ID another-id-pair : "," ID "=" ID