~ 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