~ chicken-core (chicken-5) cbb5a37ca55b1928352c1fba01cd2ba455aae8d5
commit cbb5a37ca55b1928352c1fba01cd2ba455aae8d5
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Feb 9 07:37:58 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:35 2016 +1300
Restore the warning for missing extensions
Also, pull `##sys#canonicalize-extension-path` into
`##sys#find-extension` to simplify calling code.
diff --git a/batch-driver.scm b/batch-driver.scm
index 12f591e4..c8906788 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -597,12 +597,17 @@
(map (lambda (il) (->string (car il)))
import-libraries) ", ")))
- (when (null? (lset-intersection/eq? '(eval repl) used-units))
- (and-let* ((reqs (##sys#hash-table-ref file-requirements 'dynamic)))
+ (and-let* ((reqs (##sys#hash-table-ref file-requirements 'dynamic))
+ (missing (remove (cut ##sys#find-extension <> #f) reqs)))
+ (when (null? (lset-intersection/eq? '(eval repl) used-units))
(notice ; XXX only issued when "-verbose" is used
(sprintf "~A has dynamic requirements but doesn't load (chicken eval): ~A"
(cond (unit-name "unit") (dynamic "library") (else "program"))
- (string-intersperse (map ->string reqs) ", ")))))
+ (string-intersperse (map ->string reqs) ", "))))
+ (when (pair? missing)
+ (warning
+ (sprintf "the following extensions are not currently installed: ~A"
+ (string-intersperse (map ->string missing) ", ")))))
(when (pair? compiler-syntax-statistics)
(with-debugging-output
diff --git a/eval.scm b/eval.scm
index 8a4f0aef..a86ccf9e 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1197,8 +1197,9 @@
(define ##sys#find-extension
(let ((file-exists? file-exists?)
(string-append string-append))
- (lambda (p inc?)
- (let ((rp (##sys#repository-path)))
+ (lambda (path inc?)
+ (let ((p (##sys#canonicalize-extension-path path #f))
+ (rp (##sys#repository-path)))
(define (check path)
(let ((p0 (string-append path "/" p)))
(or (and rp
@@ -1221,15 +1222,13 @@
((any ##sys#provided? alternates))
((memq id core-units)
(or (load-library-0 id #f)
- (fail "cannot load core library")))
+ (##sys#error loc "cannot load core library" id)))
+ ((##sys#find-extension id #f) =>
+ (lambda (ext)
+ (load/internal ext #f #f #f #f id)
+ (##sys#provide id)))
(else
- (let* ((path (##sys#canonicalize-extension-path id loc))
- (ext (##sys#find-extension path #f)))
- (cond (ext
- (load/internal ext #f #f #f #f id)
- (##sys#provide id))
- (else
- (fail "cannot load extension")))))))
+ (##sys#error loc "cannot load extension" id))))
(define (load-extension id)
(##sys#check-symbol id 'load-extension)
diff --git a/mini-srfi-1.scm b/mini-srfi-1.scm
index df1ea289..e3823ee3 100644
--- a/mini-srfi-1.scm
+++ b/mini-srfi-1.scm
@@ -27,12 +27,12 @@
(declare
(unused take span drop partition split-at append-map every any cons* concatenate delete
- first second third fourth alist-cons delete-duplicates fifth
+ first second third fourth alist-cons delete-duplicates fifth remove
filter filter-map unzip1 last list-index lset-adjoin/eq? lset-difference/eq?
lset-union/eq? lset-intersection/eq? list-tabulate lset<=/eq? lset=/eq? length+
find find-tail iota make-list posq posv)
(hide take span drop partition split-at append-map every any cons* concatenate delete
- first second third fourth alist-cons delete-duplicates fifth
+ first second third fourth alist-cons delete-duplicates fifth remove
filter filter-map unzip1 last list-index lset-adjoin/eq? lset-difference/eq?
lset-union/eq? lset-intersection/eq? list-tabulate lset<=/eq? lset=/eq? length+
find find-tail iota make-list posq posv))
@@ -137,6 +137,9 @@
'()
lst))
+(define (remove pred lst)
+ (filter (lambda (x) (not (pred x))) lst))
+
(define (unzip1 lst) (map (lambda (x) (car x)) lst))
(define (last lst)
Trap