Adding assoc-get-list analog of conf-get-list.

Making assoc-get[-list] permissively ignore of non-pair entries.
Updating conf-specialize with the new record type.
This commit is contained in:
Alex Shinn 2014-05-27 06:25:17 +09:00
parent c558f19743
commit 24d22644d0
2 changed files with 30 additions and 17 deletions

View file

@ -122,12 +122,26 @@
;;> unspecified.
(define (assoc-get alist key . o)
(let ((equal (or (and (pair? o) (car o)) equal?)))
(let lp ((ls alist))
(cond
((assoc key alist (or (and (pair? o) (car o)) equal?))
=> (lambda (x)
(if (and (pair? (cdr x)) (null? (cddr x))) (cadr x) (cdr x))))
(else
(and (pair? o) (pair? (cdr o)) (cadr o)))))
((not (pair? ls)) (and (pair? o) (pair? (cdr o)) (cadr o)))
((and (pair? (car ls)) (equal key (caar ls)))
(if (and (pair? (cdar ls)) (null? (cdr (cdar ls))))
(car (cdar ls))
(cdar ls)))
(else (lp (cdr ls)))))))
;;> \procedure{(assoc-get-list alist key [default])}
;;> Equivalent to \scheme{assoc-get} but coerces its result to a list
;;> as described in the syntax section.
(define (assoc-get-list alist key . o)
(let ((res (assoc-get alist key)))
(if res
(if (or (pair? res) (null? res)) res (list res))
(if (pair? o) (car o) '()))))
;;> Returns just the base of \var{config} without any parent.
@ -325,16 +339,15 @@
;;> Lift specialized sections to the top-level of a config.
(define (conf-specialize config key name)
(let lp ((ls config) (res '()))
(cond
((null? ls) (reverse res))
((assq key (car ls))
=> (lambda (specialized)
(let ((named (assq name (cdr specialized))))
(let lp ((cfg config) (res '()))
(if (not cfg)
(make-conf (reverse res) config #f (current-second))
(let* ((specialized (assq key (conf-alist cfg)))
(named (and specialized (assq name (cdr specialized))))
(next (conf-parent cfg)))
(if named
(lp (cdr ls) (cons (car ls) (cons (cdr named) res)))
(lp (cdr ls) (cons (car ls) res))))))
(else (lp (cdr ls) (cons (car ls) res))))))
(lp next (cons (cdr named) res))
(lp next res))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View file

@ -4,7 +4,7 @@
conf-verify conf-extend conf-append conf-set conf-unfold-key
conf-get conf-get-list conf-get-cdr conf-get-multi
conf-specialize read-from-file conf-source conf-head conf-parent
assoc-get)
assoc-get assoc-get-list)
(import (scheme base) (scheme read) (scheme write) (scheme file)
(scheme time) (srfi 1))
;; This is only used for config verification, it's acceptable to