From 520c6d44dbe916555e3b8b3ad3d50d82b3ac2aec Mon Sep 17 00:00:00 2001
From: Jim Ursetto <jim@3e8.org>
Date: Sun, 1 Jan 2012 02:22:19 -0600
Subject: [PATCH 01/13] Add initial repository pathspec code

Add repository-pathspec list which splits CHICKEN_REPOSITORY on :,
and have repository-path return the car.  Empty path elements are
replaced with the default repository path (i.e. the path if
the env var is not set).  However, if a private repository is
active, the path is set to that exclusively.
---
 chicken.import.scm |  1 +
 eval.scm           | 43 +++++++++++++++++++++++++++++--------------
 2 files changed, 30 insertions(+), 14 deletions(-)

diff --git a/chicken.import.scm b/chicken.import.scm
index 9811d8f..58798a9 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -194,6 +194,7 @@
    repl
    repl-prompt
    repository-path
+   repository-pathspec
    require
    reset
    reset-handler
diff --git a/eval.scm b/eval.scm
index 6fdc3bf..bb81b8e 100644
--- a/eval.scm
+++ b/eval.scm
@@ -27,7 +27,7 @@
 
 (declare
   (unit eval)
-  (uses expand)
+  (uses expand data-structures)
   (hide ##sys#r4rs-environment ##sys#r5rs-environment 
 	##sys#interaction-environment pds pdss pxss d) 
   (not inline ##sys#repl-eval-hook ##sys#repl-read-hook ##sys#repl-print-hook 
@@ -1094,22 +1094,37 @@
 		   (check (##sys#substring p 0 (fx- n 1))) ]
 		  [else p] ) ) ) ) ) ) )
 
-(define ##sys#repository-path
-  (let ((rpath
-	 (if (##sys#fudge 22)		; private repository?
-	     (foreign-value "C_private_repository_path()" c-string)
-	     (or (get-environment-variable repository-environment-variable)
-		 (##sys#chicken-prefix 
-		  (##sys#string-append 
+(define ##sys#repository-path)
+(define ##sys#repository-pathspec)
+
+(let ((dpath (or (##sys#chicken-prefix
+		  (##sys#string-append
 		   "lib/chicken/"
-		   (##sys#number->string (##sys#fudge 42))) )
-		 install-egg-home))))
-    (lambda (#!optional val)
-      (if val
-	  (set! rpath val)
-	  rpath))))
+		   (##sys#number->string (##sys#fudge 42))))
+		 install-egg-home))
+      (split-pathspec (lambda (p)
+			(if p
+			    (string-split p ":" #t)        ;; FIXME: use ; on Windows
+			    '("")))))
+  (let ((rspec (if (##sys#fudge 22) ; private repository?  currently overrides repo path, shall we place in : instead?
+		   (list (foreign-value "C_private_repository_path()" c-string))
+		   (map (lambda (x)
+			  (if (string=? x "") dpath x))
+			(split-pathspec
+			 (get-environment-variable repository-environment-variable))))))
+    (set! ##sys#repository-pathspec
+	  (lambda (#!optional val)
+	    (if val
+		(set! rspec val)     ;; like original, won't #f arg not perform set! ?
+		rspec)))
+    (set! ##sys#repository-path
+	  (lambda (#!optional val)
+	    (if val
+		(set! rspec (list val))   ;; should we be able to zero this?
+		(and (pair? rspec) (car rspec)))))))
 
 (define repository-path ##sys#repository-path)
+(define repository-pathspec ##sys#repository-pathspec)
 
 (define ##sys#setup-mode #f)
 
-- 
2.2.1


From a80847ffa4b259547c0b6b3e1c8999bc4e38aed8 Mon Sep 17 00:00:00 2001
From: Jim Ursetto <jim@3e8.org>
Date: Sun, 1 Jan 2012 02:55:14 -0600
Subject: [PATCH 02/13] Use ; instead of : for repository pathspec separator,
 as in CHICKEN_INCLUDE_PATH

---
 eval.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/eval.scm b/eval.scm
index bb81b8e..902b8f3 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1104,7 +1104,7 @@
 		 install-egg-home))
       (split-pathspec (lambda (p)
 			(if p
-			    (string-split p ":" #t)        ;; FIXME: use ; on Windows
+			    (string-split p ";" #t)
 			    '("")))))
   (let ((rspec (if (##sys#fudge 22) ; private repository?  currently overrides repo path, shall we place in : instead?
 		   (list (foreign-value "C_private_repository_path()" c-string))
-- 
2.2.1


From e7eb8d318cc49ae5843456b847e2fb008cbfbf50 Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Mon, 2 Jan 2012 00:41:14 -0600
Subject: [PATCH 03/13] Modify chicken-status to follow repository pathspec,
 preferring eggs earlier in path.

---
 chicken-status.scm | 58 ++++++++++++++++++++++++++++++------------------------
 1 file changed, 32 insertions(+), 26 deletions(-)

diff --git a/chicken-status.scm b/chicken-status.scm
index 9f56cd1..69e4ce0 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -42,18 +42,22 @@
 
   (define (repo-path)
     (if (and *cross-chicken* (not *host-extensions*))
-	(make-pathname C_TARGET_LIB_HOME (sprintf "chicken/~a" C_BINARY_VERSION))
-	(repository-path)))
-
-  (define (grep rx lst)
-    (filter (cut irregex-search rx <>) lst))
-
-  (define (gather-eggs patterns)
-    (let ((eggs (map pathname-file 
-		     (glob (make-pathname (repo-path) "*" "setup-info")))))
+	(list (make-pathname C_TARGET_LIB_HOME (sprintf "chicken/~a" C_BINARY_VERSION)))
+	(repository-pathspec)))
+  (define (pretty-repo-path)
+    (string-intersperse (repo-path) ";"))
+
+  (define (gather-eggs patterns)  ; returns (("eggname" . "/path/to/repo") ...), preferring earliest path
+    (define (grep-car rx lst)
+      (filter (lambda (x) (irregex-search rx (car x))) lst))
+    (let ((eggs (append-map (lambda (path)
+			      (map (lambda (f)
+				     (cons (pathname-file f) path))
+				   (glob (make-pathname path "*" "setup-info"))))
+			    (repo-path))))
       (delete-duplicates
-       (concatenate (map (cut grep <> eggs) patterns))
-       string=?)))
+       (concatenate (map (cut grep-car <> eggs) patterns))
+       (lambda (x y) (string=? (car x) (car y))))))
 
   (define (format-string str cols #!optional right (padc #\space))
     (let* ((len (string-length str))
@@ -77,15 +81,16 @@
     (let ((w (quotient (- (get-terminal-width) 2) 2)))
       (for-each
        (lambda (egg)
-	 (let ((version (assq 'version (read-info egg (repo-path)))))
-	   (if version
-	       (print
-		(format-string (string-append egg " ") w #f #\.)
-		(format-string 
-		 (string-append " version: " (->string (cadr version)))
-		 w #t #\.))
-	       (print egg))))
-       (sort eggs string<?))))
+	 (let ((name (car egg)) (path (cdr egg)))
+	   (let ((version (assq 'version (read-info name path))))
+	     (if version
+		 (print
+		  (format-string (string-append name " ") w #f #\.)
+		  (format-string
+		   (string-append " version: " (->string (cadr version)))
+		   w #t #\.))
+		 (print name)))))
+       (sort eggs (lambda (x y) (string<? (car x) (car y)))))))
 
   (define (list-installed-files eggs)
     (for-each
@@ -93,10 +98,11 @@
      (sort
       (append-map
        (lambda (egg)
-	 (let ((files (assq 'files (read-info egg (repo-path)))))
-	   (if files
-	       (cdr files)
-	       '())))
+	 (let ((name (car egg)) (path (cdr egg)))
+	   (let ((files (assq 'files (read-info name path))))
+	     (if files
+		 (cdr files)
+		 '()))))
        eggs)
       string<?)))
 
@@ -137,10 +143,10 @@ EOF
 			   ((if files list-installed-files list-installed-eggs)
 			    eggs))))))
 	      (cond ((and *host-extensions* *target-extensions*)
-		     (print "host at " (repo-path) ":\n")
+		     (print "host at " (pretty-repo-path) ":\n")
 		     (status)
 		     (fluid-let ((*host-extensions* #f))
-		       (print "\ntarget at " (repo-path) ":\n")
+		       (print "\ntarget at " (pretty-repo-path) ":\n")
 		       (status)))
 		    (else (status))))
 	    (let ((arg (car args)))
-- 
2.2.1


From 9dfae2f7d7b803e0bcc83c8dda75f3b0ff556c4b Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Mon, 2 Jan 2012 01:22:56 -0600
Subject: [PATCH 04/13] Update extension-information to search
 repository-pathspec

---
 eval.scm | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/eval.scm b/eval.scm
index 902b8f3..190589b 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1201,12 +1201,14 @@
 	[string-append string-append]
 	[read read] )
     (lambda (id loc)
-      (and-let* ((rp (##sys#repository-path)))
-	(let* ((p (##sys#canonicalize-extension-path id loc))
-	       (rpath (string-append rp "/" p ".")) )
-	  (cond ((file-exists? (string-append rpath setup-file-extension))
-		 => (cut with-input-from-file <> read) )
-		(else #f) ) ) ) ) ))
+      (let* ((p (##sys#canonicalize-extension-path id loc))
+	     (rfn (string-append "/" p "." setup-file-extension)))
+	(let loop ((rps (##sys#repository-pathspec)))
+	  (if (null? rps)
+	      #f
+	      (cond ((file-exists? (string-append (car rps) rfn))
+		     => (cut with-input-from-file <> read) )
+		    (else (loop (cdr rps))) )))) ) ))
 
 (define (extension-information ext)
   (##sys#extension-information ext 'extension-information) )
-- 
2.2.1


From 71d904f7e1f5adfa08488865a394459398f6829e Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Mon, 2 Jan 2012 01:37:45 -0600
Subject: [PATCH 05/13] Update ##sys#find-extension to search
 repository-pathspec.

We retain the current behavior of searching . at the end (or beginning, if
-setup-mode) of the search path.  It may make sense to remove the end . search
when CHICKEN_REPOSITORY is explicitly set and require the user to add it to
the path, but that may also break things.
---
 eval.scm | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/eval.scm b/eval.scm
index 190589b..784a193 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1131,10 +1131,10 @@
 (define ##sys#find-extension
   (let ((string-append string-append) )
     (lambda (p inc?)
-      (let ((rp (##sys#repository-path)))
+      (let ((rps (##sys#repository-pathspec)))
 	(define (check path)
 	  (let ((p0 (string-append path "/" p)))
-	    (and (or (and rp
+	    (and (or (and (pair? rps)
 			  (not ##sys#dload-disabled)
 			  (##sys#fudge 24) ; dload?
 			  (file-exists? (##sys#string-append p0 ##sys#load-dynamic-extension)))
@@ -1142,7 +1142,7 @@
 		 p0) ) )
 	  (let loop ((paths (##sys#append
 			     (if ##sys#setup-mode '(".") '())
-			     (if rp (list rp) '())
+			     rps
 			     (if inc? ##sys#include-pathnames '())
 			     (if ##sys#setup-mode '() '("."))) ))
 	    (and (pair? paths)
-- 
2.2.1


From c8b69f40088f7b9db8843e9a02b9dde269308f3f Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Mon, 2 Jan 2012 17:40:32 -0600
Subject: [PATCH 06/13] Update resolve-include-filename to follow repository
 pathspec (when searching repository)

Retains the current behavior of always searching CWD first.  Only relevant
when doing a repo search, so this change affects only -extend and
-inline-global (.inline files).
---
 eval.scm | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/eval.scm b/eval.scm
index 784a193..3b4a69a 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1489,11 +1489,8 @@
       (or (test fname)
 	  (let loop ((paths (if repo
 				(##sys#append 
-				 ##sys#include-pathnames 
-				 (let ((rp (##sys#repository-path)))
-				   (if rp
-				       (list (##sys#repository-path))
-				       '())))
+				 ##sys#include-pathnames
+				 (##sys#repository-pathspec))
 				##sys#include-pathnames) ) )
 	    (cond ((eq? paths '()) fname)
 		  ((test (string-append (##sys#slot paths 0)
-- 
2.2.1


From 3b1dcad69662021b78e79111e2d4ef7da6e13737 Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Mon, 2 Jan 2012 17:48:54 -0600
Subject: [PATCH 07/13] Show full repository pathspec in csi ,r

---
 csi.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/csi.scm b/csi.scm
index 7552df8..41e00e5 100644
--- a/csi.scm
+++ b/csi.scm
@@ -516,7 +516,7 @@ EOF
 		    (software-version)
 		    (build-platform)
 		    prefix
-		    (repository-path)
+		    (repository-pathspec)
 		    ##sys#include-pathnames
 		    (shorten (vector-ref sinfo 0))
 		    (shorten (vector-ref sinfo 1))
-- 
2.2.1


From 0ddd9371d566bbebe564d21f29ae4bfd667fb34b Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Tue, 3 Jan 2012 01:17:35 -0600
Subject: [PATCH 08/13] Update load-identifier-database to load the database
 from all repository paths

Paths are traversed in order and all identifiers from shadowed modules are
ignored.  Here, a shadowed module is simply one whose name appears in an
earlier identifier database; the installed module files are not considered.
---
 support.scm | 37 ++++++++++++++++++++++++++-----------
 1 file changed, 26 insertions(+), 11 deletions(-)

diff --git a/support.scm b/support.scm
index 1b7bd31..304cef4 100644
--- a/support.scm
+++ b/support.scm
@@ -1425,19 +1425,34 @@
 
 ;;; Load support files
 
+;; Load the specified identifier database from all repositories in order,
+;; skipping any identifiers from shadowed modules (seen in an earlier database).
 (define (load-identifier-database name)
-  (and-let* ((rp (repository-path))
-	     (dbfile (file-exists? (make-pathname rp name))))
-    (when verbose-mode
-      (printf "loading identifier database ~a ...~%" dbfile))
+  (let* ((seen (make-vector 301 '()))
+	 (was-seen (make-vector (##sys#size seen)))
+	 (seen? (cut ##sys#hash-table-ref was-seen <>))
+	 (seen! (cut ##sys#hash-table-set! seen <> #t)))
     (for-each
-     (lambda (e)
-       (let ((id (car e)))
-	 (##sys#put! 
-	  id '##core#db
-	  (append (or (##sys#get id '##core#db) '()) (list (cdr e))) )))
-     (read-file dbfile))))
-
+     (lambda (rp)
+       (and-let* ((dbfile (file-exists? (make-pathname rp name))))
+	 (when verbose-mode
+	   (printf "loading identifier database ~a ...~%" dbfile))
+	 (vector-copy! seen was-seen)  ; safe b/c values are not mutated or deleted
+	 (for-each
+	  (lambda (e)
+	    (let ((id (car e)) (mname (caddr e)))
+	      (cond ((not (seen? mname))
+		     (when verbose-mode
+		       (printf "  adding identifier ~a from ~a~%" id mname))
+		     (##sys#put!
+		      id '##core#db
+		      (append (or (##sys#get id '##core#db) '()) (list (cdr e))))
+		     (seen! mname))
+		    (else
+		     (when verbose-mode
+		       (printf "  skipped identifier ~a from ~a~%" id mname))))))
+	  (read-file dbfile))))
+     (repository-pathspec))))
 
 ;;; Print version/usage information:
 
-- 
2.2.1


From c041bc25d68255fbba7e37338996226c1ed67ab2 Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Tue, 3 Jan 2012 01:38:31 -0600
Subject: [PATCH 09/13] Remove per-id debugging from load-identifier-database

---
 support.scm | 15 +++++----------
 1 file changed, 5 insertions(+), 10 deletions(-)

diff --git a/support.scm b/support.scm
index 304cef4..5d91b19 100644
--- a/support.scm
+++ b/support.scm
@@ -1441,16 +1441,11 @@
 	 (for-each
 	  (lambda (e)
 	    (let ((id (car e)) (mname (caddr e)))
-	      (cond ((not (seen? mname))
-		     (when verbose-mode
-		       (printf "  adding identifier ~a from ~a~%" id mname))
-		     (##sys#put!
-		      id '##core#db
-		      (append (or (##sys#get id '##core#db) '()) (list (cdr e))))
-		     (seen! mname))
-		    (else
-		     (when verbose-mode
-		       (printf "  skipped identifier ~a from ~a~%" id mname))))))
+	      (unless (seen? mname)
+		(##sys#put!
+		 id '##core#db
+		 (append (or (##sys#get id '##core#db) '()) (list (cdr e))))
+		(seen! mname))))
 	  (read-file dbfile))))
      (repository-pathspec))))
 
-- 
2.2.1


From 81f3f79bb80124134f868813cc3c35243cb4339c Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Fri, 6 Jan 2012 23:06:45 -0600
Subject: [PATCH 10/13] Add path field to module record, representing
 current-load-path

---
 expand.scm | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/expand.scm b/expand.scm
index 12af83a..3e86a58 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1610,7 +1610,7 @@
 (define-record-type module
   (%make-module name export-list defined-list exist-list defined-syntax-list
 		undefined-list import-forms meta-import-forms meta-expressions 
-		vexports sexports) 
+		vexports sexports path)
   module?
   (name module-name)			; SYMBOL
   (export-list module-export-list set-module-export-list!) ; (SYMBOL | (SYMBOL ...) ...)
@@ -1622,9 +1622,12 @@
   (meta-import-forms module-meta-import-forms set-module-meta-import-forms!)	    ; (SPEC ...)
   (meta-expressions module-meta-expressions set-module-meta-expressions!) ; (EXP ...)
   (vexports module-vexports set-module-vexports!)	      ; ((SYMBOL . SYMBOL) ...)
-  (sexports module-sexports set-module-sexports!) )	      ; ((SYMBOL SE TRANSFORMER) ...)
+  (sexports module-sexports set-module-sexports!)	      ; ((SYMBOL SE TRANSFORMER) ...)
+  (path module-path)					      ; STRING or #f (from current-load-path)
+  )
 
 (define ##sys#module-name module-name)
+(define ##sys#module-path module-path)
 
 (define (##sys#module-exports m)
   (values 
@@ -1633,7 +1636,7 @@
    (module-sexports m)))
 
 (define (make-module name explist vexports sexports)
-  (%make-module name explist '() '() '() '() '() '() '() vexports sexports))
+  (%make-module name explist '() '() '() '() '() '() '() vexports sexports ##sys#current-load-path))
 
 (define (##sys#find-module name #!optional (err #t))
   (cond ((assq name ##sys#module-table) => cdr)
-- 
2.2.1


From 263b8249bf3374ab3bb9692b23587c43f5931098 Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Fri, 6 Jan 2012 23:07:17 -0600
Subject: [PATCH 11/13] Update current-load-path and current-source-filename
 when dloading as well as reading source

---
 eval.scm | 93 ++++++++++++++++++++++++++++++++--------------------------------
 1 file changed, 47 insertions(+), 46 deletions(-)

diff --git a/eval.scm b/eval.scm
index 3b4a69a..ea5ca01 100644
--- a/eval.scm
+++ b/eval.scm
@@ -919,52 +919,53 @@
 	       (display fname)
 	       (display " ...\n") 
 	       (flush-output)] )
-	(or (and fname
-		 (or (##sys#dload (##sys#make-c-string fname 'load) topentry #t) 
-		     (and (not (has-sep? fname))
-			  (##sys#dload 
-			   (##sys#make-c-string
-			    (##sys#string-append "./" fname) 
-			    'load) 
-			   topentry #t) ) ) )
-	    (call-with-current-continuation
-	     (lambda (abrt)
-	       (fluid-let ((##sys#read-error-with-line-number #t)
-			   (##sys#current-source-filename fname)
-			   (##sys#current-load-path
-			    (and fname
-				 (let ((i (has-sep? fname)))
-				   (if i (##sys#substring fname 0 (fx+ i 1)) "") ) ) )
-			   (##sys#abort-load (lambda () (abrt #f))) )
-		 (let ((in (if fname (open-input-file fname) input)))
-		   (##sys#dynamic-wind
-		    (lambda () #f)
-		    (lambda ()
-		      (let ((c1 (peek-char in)))
-			(when (char=? c1 (integer->char 127))
-			  (##sys#error 
-			   'load 
-			   (##sys#string-append 
-			    "unable to load compiled module - " 
-			    (or _dlerror "unknown reason"))
-			   fname)))
-		      (let ((x1 (read in)))
-			(do ((x x1 (read in)))
-			    ((eof-object? x))
-			  (when printer (printer x))
-			  (##sys#call-with-values
-			   (lambda () 
-			     (if timer
-				 (time (evproc x)) 
-				 (evproc x) ) )
-			   (lambda results
-			     (when pf
-			       (for-each
-				(lambda (r) 
-				  (write r)
-				  (newline) )
-				results) ) ) ) ) ) )
-		    (lambda () (close-input-port in)) ) ) ) ) ) )
+	(fluid-let ((##sys#current-source-filename fname)
+		    (##sys#current-load-path
+		     (and fname
+			  (let ((i (has-sep? fname)))
+			    (if i (##sys#substring fname 0 (fx+ i 1)) "")))))
+	  (or (and fname
+		   (or (##sys#dload (##sys#make-c-string fname 'load) topentry #t) 
+		       (and (not (has-sep? fname))
+			    (let ((fname (##sys#string-append "./" fname)))
+			      (fluid-let ((##sys#current-source-filename fname)
+					  (##sys#current-load-path "./"))
+				(##sys#dload
+				 (##sys#make-c-string fname 'load)
+				 topentry #t))) ) ) )
+	      (call-with-current-continuation
+	       (lambda (abrt)
+		 (fluid-let ((##sys#read-error-with-line-number #t)
+			     (##sys#abort-load (lambda () (abrt #f))) )
+		   (let ((in (if fname (open-input-file fname) input)))
+		     (##sys#dynamic-wind
+		      (lambda () #f)
+		      (lambda ()
+			(let ((c1 (peek-char in)))
+			  (when (char=? c1 (integer->char 127))
+			    (##sys#error 
+			     'load 
+			     (##sys#string-append 
+			      "unable to load compiled module - " 
+			      (or _dlerror "unknown reason"))
+			     fname)))
+			(let ((x1 (read in)))
+			  (do ((x x1 (read in)))
+			      ((eof-object? x))
+			    (when printer (printer x))
+			    (##sys#call-with-values
+			     (lambda () 
+			       (if timer
+				   (time (evproc x)) 
+				   (evproc x) ) )
+			     (lambda results
+			       (when pf
+				 (for-each
+				  (lambda (r) 
+				    (write r)
+				    (newline) )
+				 results) ) ) ) ) ) )
+		     (lambda () (close-input-port in)) ) ) ) ) ) ))
 	(##core#undefined) ) ) )
   (set! load
     (lambda (filename . evaluator)
-- 
2.2.1


From b0f10e8bbe195ba46f749d152211ef7f5ace431f Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Sat, 7 Jan 2012 00:32:06 -0600
Subject: [PATCH 12/13] chicken-install: Update modules.db in all repos;  uses
 ##sys#module-path to filter out modules from other repos.

---
 chicken-install.scm | 71 +++++++++++++++++++++++++++++++----------------------
 1 file changed, 41 insertions(+), 30 deletions(-)

diff --git a/chicken-install.scm b/chicken-install.scm
index 90ab801..a8d0861 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -519,43 +519,54 @@
       (and-let* ((tmpdir (temporary-directory)))
         (remove-directory tmpdir))))
 
-  (define (update-db)
-    (let* ((files (glob (make-pathname (repository-path) "*.import.*")))
-           (tmpdir (create-temporary-directory))
-           (dbfile (make-pathname tmpdir +module-db+))
-           (rx (irregex ".*/([^/]+)\\.import\\.(scm|so)")))
+  ;; Create the +module-db+ file in repository PATH by loading all .import.* files
+  ;; in that directory and then walking the module table.  Import files can import other
+  ;; modules recursively; since those may reside in another repository, we filter out
+  ;; any modules in the table not loaded directly from PATH.
+  (define (update-db path)
+    (let* ((path (make-pathname path #f))  ;; match ##sys#module-path's trailing forward slash
+	   (files (glob (make-pathname path "*.import.*")))
+	   (tmpdir (create-temporary-directory))
+	   (dbfile (make-pathname tmpdir +module-db+))
+	   (rx (irregex ".*/([^/]+)\\.import\\.(scm|so)")))
       (print "loading import libraries ...")
       (fluid-let ((##sys#warnings-enabled #f))
-        (for-each
-         (lambda (f)
-           (let ((m (irregex-match rx f)))
+	(for-each
+	 (lambda (f)
+	   (let ((m (irregex-match rx f)))
 	     (handle-exceptions ex
 		 (print-error-message 
 		  ex (current-error-port) 
 		  (sprintf "Failed to import from `~a'" f))
 	       (eval `(import ,(string->symbol (irregex-match-substring m 1)))))))
-         files))
-      (print "generating database")
+	 files))
+      (print "generating database for " path)
       (let ((db
-             (sort
-              (append-map
-               (lambda (m)
-                 (let* ((mod (cdr m))
-                        (mname (##sys#module-name mod)))
-                   (print* " " mname)
-                   (let-values (((_ ve se) (##sys#module-exports mod)))
-                     (append
-                      (map (lambda (se) (list (car se) 'syntax mname)) se)
-                      (map (lambda (ve) (list (car ve) 'value mname)) ve)))))
-               ##sys#module-table)
-              (lambda (e1 e2)
-                (string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
-        (newline)
-        (with-output-to-file dbfile
-          (lambda ()
-            (for-each (lambda (x) (write x) (newline)) db)))
-        (copy-file dbfile (make-pathname (repository-path) +module-db+))
-        (remove-directory tmpdir))))
+	     (sort
+	      (append-map
+	       (lambda (m)
+		 (let* ((mod (cdr m))
+			(mname (##sys#module-name mod))
+			(mpath (##sys#module-path mod)))
+		   (cond ((string=? mpath path)
+			  (print* " " mname)
+			  (let-values (((_ ve se) (##sys#module-exports mod)))
+			    (append
+			     (map (lambda (se) (list (car se) 'syntax mname)) se)
+			     (map (lambda (ve) (list (car ve) 'value mname)) ve))))
+			 (else '()))))
+	       ##sys#module-table)
+	      (lambda (e1 e2)
+		(string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
+	(newline)
+	(with-output-to-file dbfile
+	  (lambda ()
+	    (for-each (lambda (x) (write x) (newline)) db)))
+	(copy-file dbfile (make-pathname path +module-db+) #t ".") ;; repos are relative to CWD
+	(remove-directory tmpdir))))
+
+  (define (update-db-all)
+    (for-each update-db (repository-pathspec)))
 
   (define (apply-mappings eggs)
     (define (canonical x)
@@ -647,7 +658,7 @@ EOF
                (cond ((and *deploy* (not *prefix*))
 		      (error 
 		       "`-deploy' only makes sense in combination with `-prefix DIRECTORY`"))
-		     (update (update-db))
+		     (update (update-db-all))
                      (else
 		      (let ((defaults (load-defaults)))
 			(when (null? eggs)
-- 
2.2.1


From b281bc3fe0c543c1358d29398647709e00f6c0ec Mon Sep 17 00:00:00 2001
From: Jim Ursetto <zbigniewsz@gmail.com>
Date: Wed, 24 Jul 2013 11:03:39 -0500
Subject: [PATCH 13/13] chicken-install: Print every entry in repository
 pathspec

---
 chicken-install.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/chicken-install.scm b/chicken-install.scm
index a8d0861..6250d0f 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -688,7 +688,7 @@ EOF
                             (string=? arg "--help"))
                         (usage 0))
                        ((string=? arg "-repository")
-                        (print (repository-path))
+                        (print (string-intersperse (repository-pathspec) ";"))
                         (exit 0))
                        ((string=? arg "-force")
                         (set! *force* #t)
-- 
2.2.1

