~ 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