From: Matt Birkholz Date: Fri, 22 Jun 2018 23:49:04 +0000 (-0700) Subject: devops: Fix pmodel/find-package. X-Git-Tag: mit-scheme-pucked-9.2.15 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a9bb59933a796782aa1f23c5d19d35d5db3a91f4;p=mit-scheme.git devops: Fix pmodel/find-package. --- diff --git a/src/devops/lint.scm b/src/devops/lint.scm index 900000ac8..dc3790a9c 100644 --- a/src/devops/lint.scm +++ b/src/devops/lint.scm @@ -72,8 +72,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. deffns)))) (define (pmodel/find-package pmodel package-name) - (filter (lambda (p) (equal? package-name (package/name p))) - (pmodel/packages pmodel))) + (let ((pkgs (filter (lambda (p) (equal? package-name (package/name p))) + (pmodel/packages pmodel)))) + (and (pair? pkgs) + (if (null? (cdr pkgs)) + (car pkgs) + (error "Multiple packages:" package-name))))) (define (pmodel/global-exports pmodel) (define (global-exports package) @@ -87,10 +91,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (append-map! global-exports (pmodel/packages pmodel))) (define (pmodel/package-bindings pmodel package-name) - (let ((package (pmodel/find-package pmodel package-name))) - (if package - (map binding/name (package/bindings package)) - (error "No such package:" package-name)))) + (map binding/name + (package/bindings (pmodel/find-package pmodel package-name)))) (define (duplicates listset) (let loop ((items listset) (duplicates '()))