sort of works
parent
f126d7f70e
commit
da34097807
@ -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 "}")
|
||||
|
||||
#|
|
||||
|
||||
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 _id 0)
|
||||
))
|
||||
(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,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…
Reference in New Issue