Add optional signal filter predicate

This commit is contained in:
Nikolay Puzanov 2022-12-07 12:51:17 +03:00
parent 7a88f6a05f
commit f9f22f4f31

View File

@ -123,8 +123,9 @@
;;; ;;;
;;; Parse VCD header ;;; Parse VCD header
;;; Returns values of timescale and association list (tag . (<signal> ...)) ;;; Returns values of timescale and association list (tag . (<signal> ...))
;;; Predicate: (need-signal? <signal>)
;;; ;;;
(define (read-header port) (define* (read-header port need-signal?)
(let next-cmd ((timescale #f) (let next-cmd ((timescale #f)
(scope '()) (scope '())
(tags+signals '())) (tags+signals '()))
@ -149,18 +150,20 @@
(else 'bits))) (else 'bits)))
(width (string->number (third cmd))) (width (string->number (third cmd)))
(tag (fourth cmd)) (tag (fourth cmd))
(vname (string-concatenate (name (string-concatenate
(insert-between (insert-between
(cddddr cmd) " ")))) (cddddr cmd) " "))))
(next-cmd timescale scope (next-cmd timescale scope
(let ((tag+sig (assoc tag tags+signals)) (let ((sig (signal-new (reverse scope)
(sig (signal-new (reverse scope) name type width '())))
vname type width '()))) (if (need-signal? sig)
(if tag+sig (let ((tag+sig (assoc tag tags+signals)))
(begin (if tag+sig
(set-cdr! tag+sig (cons sig (cdr tag+sig))) (begin
tags+signals) (set-cdr! tag+sig (cons sig (cdr tag+sig)))
(cons (cons tag `(,sig)) tags+signals)))))) tags+signals)
(cons (cons tag `(,sig)) tags+signals)))
tags+signals)))))
((string-ci= "$upscope" (first cmd)) ((string-ci= "$upscope" (first cmd))
(next-cmd timescale (cdr scope) tags+signals)) (next-cmd timescale (cdr scope) tags+signals))
@ -299,9 +302,9 @@
;;; Parse whole VCD ;;; Parse whole VCD
;;; Returns list of time stamps and list of lists (<signal> valuse ...) ;;; Returns list of time stamps and list of lists (<signal> valuse ...)
;;; ;;;
(define (vcd-parse port) (define* (vcd-parse port #:optional (need-signal? (lambda (s) #t)))
(call-with-values (call-with-values
(lambda () (read-header port)) (lambda () (read-header port need-signal?))
(cut read-data port <...>))) (cut read-data port <...>)))
;;; ;;;