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

46
src/brmember.scm
View file

@ -35,13 +35,13 @@
brmember-file-path
brmember-input-file
member-record-set
member-record-add-highlight
member-record-sub-ref
member-record-sub-set
member-record-sub-prepend
member-record-sub-has-key?
member-record-sub-ensure
brmember-set
brmember-add-highlight
brmember-sub-ref
brmember-sub-set
brmember-sub-prepend
brmember-sub-has-key?
brmember-sub-ensure
member-source
member-record-info
@ -143,58 +143,58 @@
(ldict-ref mr 'file-path)))
;; Sets pairs of keys/values for given member record.
(define (member-record-set mr . args)
(define (brmember-set mr . args)
(let loop ((args args)
(mr mr))
(if (null? args)
mr
(if (not (keyword? (car args)))
(error 'member-record-set "Needs argument keyword" (car args))
(error 'brmember-set "Needs argument keyword" (car args))
(if (null? (cdr args))
(error 'member-record-set "Argument needs value" (car args))
(error 'brmember-set "Argument needs value" (car args))
(loop (cddr args)
(ldict-set mr (string->symbol (keyword->string (car args)))
(cadr args))))))))
;; Adds highlight identified by line number, message, pass number and
;; type (error, warning, info).
(define (member-record-add-highlight mr line-number message pass type)
(define (brmember-add-highlight mr line-number message pass type)
(ldict-set mr 'highlights
(cons (list line-number message pass type)
(ldict-ref mr 'highlights '()))))
;; Returns a key from particular section
(define (member-record-sub-ref mr sec key . defaults)
(define (brmember-sub-ref mr sec key . defaults)
(let ((sec-dict (ldict-ref mr sec)))
(if (null? defaults)
(ldict-ref sec-dict key)
(ldict-ref sec-dict key (car defaults)))))
;; Sets a key in particular section
(define (member-record-sub-set mr sec key val)
(define (brmember-sub-set mr sec key val)
(let ((sec-dict (ldict-ref mr sec)))
(ldict-set mr sec
(ldict-set sec-dict key val))))
;; Prepends value to given subkey
(define (member-record-sub-prepend mr sec key val)
(member-record-sub-set mr sec key
(define (brmember-sub-prepend mr sec key val)
(brmember-sub-set mr sec key
(cons val
(member-record-sub-ref mr sec key '()))))
(brmember-sub-ref mr sec key '()))))
;; Returns true if given section contains given key
(define (member-record-sub-has-key? mr sec key)
(define (brmember-sub-has-key? mr sec key)
(ldict-contains? (ldict-ref mr sec) key))
;; Returns new member record with section updated by defaults, the
;; section must already exist.
(define (member-record-sub-ensure mr sec . kvs)
(define (brmember-sub-ensure mr sec . kvs)
(let loop ((kvs kvs)
(sd (ldict-ref mr sec)))
(if (null? kvs)
(ldict-set mr sec sd)
(if (null? (cdr kvs))
(error 'member-record-sub-ensure "Needs pairs of keys and values" kvs)
(error 'brmember-sub-ensure "Needs pairs of keys and values" kvs)
(let ((key (car kvs))
(val (cadr kvs)))
(loop (cddr kvs)
@ -369,14 +369,14 @@
(file-path . "members/1234")
(symlinks |member|)
(id . 1234)))))
(test-true member-record-set
(test-true brmember-set
(ldict-equal?
(member-record-set (make-ldict) #:id 1234)
(brmember-set (make-ldict) #:id 1234)
(make-ldict
'((id . 1234)))))
(test-true member-record-add-highlight
(test-true brmember-add-highlight
(ldict-equal?
(member-record-add-highlight (make-ldict) 123 "Interesting..." 0 'info)
(brmember-add-highlight (make-ldict) 123 "Interesting..." 0 'info)
(make-ldict
'((highlights . ((123 "Interesting..." 0 info)))))))
(test-true member-destroyed?