brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Rename primitive accessors.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-11 22:05:29 +02:00
parent 5afdd8fb44
commit fb98eb6a78
2 changed files with 40 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/member-parser.scm
View file

@ -84,13 +84,13 @@
(month (string->month (car mspec)))
(comment (cdr mspec)))
(if month
(member-record-sub-prepend
(brmember-sub-prepend
mr output kind
(list marker month (cdr value) comment))
(member-record-add-highlight
(brmember-add-highlight
mr (cdr value) "Invalid month specification" 3 'error))))
mr value))
(member-record-sub-set mr output key value))))
(brmember-sub-set mr output key value))))
(info
,(lambda (mr output key value)
(case key
@ -100,18 +100,18 @@
(periods (cadr res))
(msg (caddr res))
(line-number (cadddr res))
(mr1 (member-record-sub-set mr output key periods)))
(mr1 (brmember-sub-set mr output key periods)))
(if ok?
mr1
(member-record-add-highlight mr1 line-number msg 3 'error))))
(brmember-add-highlight mr1 line-number msg 3 'error))))
((card desfire)
(member-record-sub-set mr output key
(brmember-sub-set mr output key
(map
(lambda (rec)
(string-first+rest (car rec)))
value)))
((credit)
(member-record-sub-set mr output key
(brmember-sub-set mr output key
(map
(lambda (rec)
(let* ((fr (string-first+rest (car rec)))
@ -120,35 +120,35 @@
(cons amt msg)))
value)))
((nick)
(let ((mr0 (member-record-sub-set mr output key (car value))))
(let ((mr0 (brmember-sub-set mr output key (car value))))
(if (irregex-search (irregex "[ \\t]" 'u) (car value))
(member-record-add-highlight
(brmember-add-highlight
mr0 (cdr value) "Whitespace not allowed in nick" 3 'error)
mr0)))
(else
(member-record-sub-set mr output key (car value))))))))
(brmember-sub-set mr output key (car value))))))))
;; Pass 4: Final checks - add defaults
(define (member-schema-finalize mr)
(apply
member-record-sub-ensure
brmember-sub-ensure
mr 'info
(join (map (lambda (mk) (list mk #f)) mandatory-keys))))
;; Passes 0 and 1: Adds parsed lines to member record.
(define (parse-member-lines mr source)
(let loop ((lines source)
(mr (member-record-set mr #:source source))
(mr (brmember-set mr #:source source))
(result '())
(line-number 1))
(if (null? lines)
(member-record-set mr #:parsed (reverse result))
(brmember-set mr #:parsed (reverse result))
(let ((parsed-line (parser-parse-line
(parser-preprocess-line
(car lines)))))
(loop (cdr lines)
(if (symbol? parsed-line)
(member-record-add-highlight mr line-number "Got only key" 1 'error)
(brmember-add-highlight mr line-number "Got only key" 1 'error)
mr)
(if (pair? parsed-line)
(cons (list (car parsed-line)
@ -167,7 +167,7 @@
(mr mr)
(processed (make-ldict)))
(if (null? parsed)
(member-record-set mr #:processed processed)
(brmember-set mr #:processed processed)
(let* ((line (car parsed))
(key (car line))
(value (cadr line))
@ -175,7 +175,7 @@
(if (member key known-keys)
(if (ldict-contains? processed key)
(loop (cdr parsed)
(member-record-add-highlight mr number "Duplicate key" 2 'error)
(brmember-add-highlight mr number "Duplicate key" 2 'error)
processed)
(loop (cdr parsed)
mr
@ -188,7 +188,7 @@
(loop (cdr parsed)
(if (member key ignored-keys)
mr
(member-record-add-highlight mr number "Unknown key" 2 'warning))
(brmember-add-highlight mr number "Unknown key" 2 'warning))
processed)))))))
;; Pass 3+: Single interpreter pass - input must be