sort of works

dev-elider-3
Matthew Butterick 9 years ago
parent f126d7f70e
commit da34097807

@ -1,8 +1,9 @@
#lang br/demo/hdl
CHIP Not {
IN x, y, z;
}
IN a, b, c, d;
OUT x, y, z;
}

@ -1,9 +1,47 @@
#lang br
(provide (all-from-out br) (all-defined-out))
(require "expander0.rkt")
;; todo: extract identifiers from _pin-spec
;; and introduce them
(define #'(chip-program "CHIP" _id "{" _pin-spec "}")
#'(begin
(define _id 0)
))
#|
Be your own binding procedure.
Part parser should generate inner `define`.
input-pin-spec parser should generate kw procedure.
chip-name parser should generate outer define/provide form.
(chip Not
(x)
(y))
|#
(define-for-syntax (remove-commas stx-expr)
(filter (λ(i)
(not (equal? "," (syntax->datum i)))) (syntax->list stx-expr)))
(define #'(pin-spec-out "OUT" _pin-or-comma ... ";")
(with-syntax ([(_pinid ...) (remove-commas #'(_pin-or-comma ...))])
#'(begin
(define _pinid '(1 2 3 4)) ...
(list _pinid ...))))
(define #'(make-kw-procedure (pin-spec-in "IN" _pin-or-comma ... ";") _pin-spec-out)
(with-syntax ([(_pinid ...) (remove-commas #'(_pin-or-comma ...))])
#'(make-keyword-procedure
(λ (kws kw-args . rest)
(define kw-pairs (map cons kws kw-args))
(let ([_pinid (cdr (assq (string->keyword (format "~a" '_pinid)) kw-pairs))] ...)
_pin-spec-out)))))
(define #'(chip-program "CHIP" _topid "{" _pin-spec-in _pin-spec-out "}")
#`(begin
(provide _topid)
(define _topid
(make-kw-procedure _pin-spec-in _pin-spec-out)
)
(require rackunit)
(check-equal? (_topid #:a 1 #:b 2 #:c 3 #:d 4) '((1 2 3 4)(1 2 3 4)(1 2 3 4)))))

@ -1,9 +1,10 @@
#lang br
(provide (all-from-out br) chip)
(define #'(chip _Chip
(_input-pin ...)
(_output-pin)
(_output-pin ...)
((_Part [_pin-in _val-id] ... [out _pin-out]) ...))
#'(begin
(provide _Chip)
@ -13,7 +14,7 @@
(define kw-pairs (map cons kws kw-args))
(let ([_input-pin (cdr (assq (string->keyword (format "~a" '_input-pin)) kw-pairs))] ...)
(define _pin-out (call-part _Part [_pin-in _val-id] ...)) ...
_output-pin))))))
(values _output-pin ...)))))))
(define #'(call-part _Part [_pin-in _val-id] ...)
(with-syntax ([part-path (format "~a.hdl" (syntax->datum #'_Part))]

@ -1,13 +1,10 @@
#lang ragg
chip-program : "CHIP" ID "{" pin-spec "}"
chip-program : "CHIP" ID "{" pin-spec-in pin-spec-out "}"
pin-spec : ("IN" | "OUT") pin-list ";"
pin-spec-in : "IN" ID ["," ID]* ";"
pin-list : ID ["," pin-list]
pin-spec-out : "OUT" ID ["," ID]* ";"
part-spec : "PARTS:" part+
part : ID "(" part-arg-list ")" ";"
part-arg-list : ID "=" ID ["," part-arg-list]
part-spec : "PARTS:" [ID "(" [ID "=" ID]+ ")" ";"]+

Loading…
Cancel
Save