Prepare sub-key setting.

This commit is contained in:
Dominik Pantůček 2023-03-25 18:54:19 +01:00
parent a6043c0fc2
commit 92b8ff0c78
2 changed files with 36 additions and 6 deletions

View file

@ -47,10 +47,17 @@
;; Pass 3: Interpreter passes ;; Pass 3: Interpreter passes
(define member-schema-interpreters (define member-schema-interpreters
`((pass-markers `((pass-markers
,(lambda (mr acc key value) ,(lambda (mr output key value)
mr)) (case key
((studentstart studentstop suspendstart suspendstop)
(let ((marker (if (member key '(studentstart suspendstart))
'start
'stop)))
mr))
(else
mr))))
(info (info
,(lambda (mr acc key value) ,(lambda (mr output key value)
mr)))) mr))))
;; Pass 0: Removes any comments and removes any leading and trailing ;; Pass 0: Removes any comments and removes any leading and trailing
@ -133,9 +140,17 @@
(member-record-add-highlight mr number "Unknown key" 2 'warning) (member-record-add-highlight mr number "Unknown key" 2 'warning)
processed))))))) processed)))))))
;; Pass 3+: Single interpreter pass ;; Pass 3+: Single interpreter pass - input must be
(define (interpreter-pass mr output-name input pass-proc) ;; dictionary. Output is top-level key of member record.
(dict-set mr output-name '())) (define (interpreter-pass mr output input pass-proc)
(let loop ((keys (dict-keys input))
(mr (dict-set mr output (make-dict))))
(if (null? keys)
mr
(let ((key (car keys)))
(loop (cdr keys)
(pass-proc mr output key
(dict-ref input key)))))))
;; Pass 3+: Interpreter passes ;; Pass 3+: Interpreter passes
(define (interpret-member-file mr . starts) (define (interpret-member-file mr . starts)

View file

@ -33,6 +33,8 @@
member-record-input-file member-record-input-file
member-record-set member-record-set
member-record-add-highlight member-record-add-highlight
member-record-sub-ref
member-record-sub-set
member-record-tests! member-record-tests!
) )
@ -87,6 +89,19 @@
(cons (list line-number message pass type) (cons (list line-number message pass type)
(dict-ref mr 'highlights '())))) (dict-ref mr 'highlights '()))))
;; Returns a key from particular section
(define (member-record-sub-ref mr sec key . defaults)
(let ((sec-dict (dict-ref mr sec)))
(if (null? defaults)
(dict-ref sec-dict key)
(dict-ref sec-dict key (car defaults)))))
;; Sets a key in particular section
(define (member-record-sub-set mr sec key val)
(let ((sec-dict (dict-ref mr sec)))
(dict-set mr sec
(dict-set sec-dict key val))))
;; Self-tests ;; Self-tests
(define (member-record-tests!) (define (member-record-tests!)
(run-tests (run-tests