~ chicken-core (chicken-5) df49ac575c7e41c1ee5655b7d33b6575925db718
commit df49ac575c7e41c1ee5655b7d33b6575925db718
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Mar 1 15:02:02 2017 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed Mar 1 15:02:02 2017 +0100
overhaul paths used to locate eggs, added new env. variables, updated docs
diff --git a/chicken-install.mdoc b/chicken-install.mdoc
index ffbdf1f8..d83f5dbb 100644
--- a/chicken-install.mdoc
+++ b/chicken-install.mdoc
@@ -93,7 +93,7 @@ Following environment variables change the behaviour of
.Bl -tag -width
.It Ev CHICKEN_EGG_CACHE
Location where eggs are retrieved and built.
-.It Ev CHICKEN_REPOSITORY
+.It Ev CHICKEN_REPOSITORY_PATH
The path where extension libraries are installed. Defaults to the package-library
path selected during configuration
.Pq usually $prefix/lib/chicken/<binary-version>
diff --git a/chicken-install.scm b/chicken-install.scm
index 04bf61fb..d21478c0 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -45,7 +45,7 @@
(define +defaults-version+ 2)
(define +module-db+ "modules.db")
(define +defaults-file+ "setup.defaults")
-(define +short-options+ '(#\r #\h))
+(define +short-options+ '(#\r #\h #\n #\k))
(define +one-hour+ (* 60 60))
(define +timestamp-file+ "TIMESTAMP")
(define +status-file+ "STATUS")
@@ -101,7 +101,6 @@
(get-environment-variable "LD_LIBRARY_PATH")
(get-environment-variable "DYLD_LIBRARY_PATH")
(get-environment-variable "CHICKEN_INCLUDE_PATH")
- (get-environment-variable "CHICKEN_REPOSITORY")
(get-environment-variable "DYLD_LIBRARY_PATH")))
(define (probe-dir dir)
@@ -117,10 +116,20 @@
".chicken-install.cache")))
(define (repo-path)
- (destination-repository
- (if (and cross-chicken (not host-extension))
- 'target
- 'host)))
+ (if (and cross-chicken (not host-extension))
+ (list (destination-repository 'target))
+ (##sys#split-path (repository-path))))
+
+(define (install-path)
+ (if (and cross-chicken (not host-extension))
+ (destination-repository 'target)
+ (destination-repository 'host)))
+
+(define (find-in-repo name)
+ (let loop ((dirs (repo-path)))
+ (cond ((null? dirs) #f)
+ ((file-exists? (make-pathname (car dirs) name)))
+ (else (loop (cdr dirs))))))
(define (build-script-extension mode platform)
(string-append "build"
@@ -327,13 +336,14 @@
;; apply egg->egg mappings loaded from defaults
-
+
+(define (canonical x)
+ (cond ((symbol? x) (cons (symbol->string x) #f))
+ ((string? x) (cons x #f))
+ ((pair? x) x)
+ (else (error "internal error - bad egg spec" x))))
+
(define (apply-mappings eggs)
- (define (canonical x)
- (cond ((symbol? x) (cons (symbol->string x) #f))
- ((string? x) (cons x #f))
- ((pair? x) x)
- (else (error "internal error - bad egg spec" x))))
(define (same? e1 e2)
(equal? (car (canonical e1)) (car (canonical e2))))
(let ((eggs2
@@ -347,7 +357,9 @@
eggs)
same?)))
(unless (and (= (length eggs) (length eggs2))
- (every (lambda (egg) (find (cut same? <> egg) eggs2)) eggs))
+ (every (lambda (egg)
+ (find (cut same? <> egg) eggs2))
+ eggs))
(d "mapped ~s to ~s~%" eggs eggs2))
eggs2))
@@ -509,7 +521,7 @@
;; check installed eggs for already installed files
(define (matching-installed-files egg fnames)
- (let ((eggs (glob (make-pathname (repo-path) "*.egg-info"))))
+ (let ((eggs (glob (make-pathname (install-path) "*.egg-info"))))
(let loop ((eggs eggs) (same '()))
(cond ((null? eggs) same)
((string=? egg (pathname-file (car eggs)))
@@ -615,7 +627,9 @@
(define (get-egg-dependencies info)
(append (get-egg-property* info 'dependencies '())
(get-egg-property* info 'build-dependencies '())
- (if run-tests (get-egg-property* info 'test-dependencies '()) '())))
+ (if run-tests
+ (get-egg-property* info 'test-dependencies '())
+ '())))
(define (check-dependency dep)
(cond ((or (symbol? dep) (string? dep))
@@ -665,7 +679,8 @@
(cond ((or (eq? x 'chicken) (equal? x "chicken"))
(chicken-version))
((let* ((ep (##sys#canonicalize-extension-path x 'ext-version))
- (sf (make-pathname (repo-path) ep +egg-info-extension+)))
+ (sf (find-in-repo
+ (make-pathname #f ep +egg-info-extension+))))
(and (file-exists? sf)
(load-egg-info sf))) =>
(lambda (info)
@@ -825,19 +840,22 @@
(version (caddr egg))
(testdir (make-pathname dir "tests"))
(tscript (make-pathname testdir "run.scm")))
- (when (and (file-exists? testdir)
- (directory? testdir)
- (file-exists? tscript))
- (let ((old (current-directory))
- (cmd (string-append default-csi " -s " tscript " " name " " (or version ""))))
- (change-directory testdir)
- (let ((r (system cmd)))
- (d "running: ~a~%" cmd)
- (flush-output (current-error-port))
- (unless (zero? r)
- (set! tests-failed #t)
- (print "test script failed with nonzero exit status")))
- (change-directory old)))))
+ (if (and (file-exists? testdir)
+ (directory? testdir)
+ (file-exists? tscript))
+ (let ((old (current-directory))
+ (cmd (string-append default-csi " -s " tscript " " name " " (or version ""))))
+ (change-directory testdir)
+ (let ((r (system cmd)))
+ (d "running: ~a~%" cmd)
+ (flush-output (current-error-port))
+ (cond ((zero? r)
+ (change-directory old)
+ #t)
+ (else
+ (print "test script failed with nonzero exit status")
+ #f))))
+ #t)))
(define (run-script dir script platform #!key sudo (stop #t))
(cond (do-not-build
@@ -871,8 +889,8 @@
;;; update module-db
(define (update-db)
- (let* ((files (glob (make-pathname (repo-path) "*.import.so")
- (make-pathname (repo-path) "*.import.scm")))
+ (let* ((files (glob (make-pathname (install-path) "*.import.so")
+ (make-pathname (install-path) "*.import.scm")))
(dbfile (create-temporary-file)))
(print "loading import libraries ...")
(fluid-let ((##sys#warnings-enabled #f))
@@ -906,7 +924,7 @@
(with-output-to-file dbfile
(lambda ()
(for-each (lambda (x) (write x) (newline)) db)))
- (file-copy dbfile (make-pathname (repo-path) +module-db+) #t))))
+ (file-copy dbfile (make-pathname (install-path) +module-db+) #t))))
;; purge cache for given (or all) eggs
@@ -932,7 +950,7 @@
(load-defaults)
(cond (update-module-db (update-db))
(purge-mode (purge-cache eggs))
- (print-repository (print (repo-path)))
+ (print-repository (print (install-path)))
((null? eggs)
(if list-versions-only
(print "no eggs specified")
@@ -971,7 +989,7 @@ usage: chicken-install [OPTION | EXTENSION[:VERSION]] ...
-r -retrieve only retrieve egg into current directory, don't install (giving -r
more than once implies `-recursive')
-recursive if `-retrieve' is given, retrieve also dependencies
- -d -dry-run do not build or install, just print the locations of the generated
+ -dry-run do not build or install, just print the locations of the generated
build + install scripts
-list-versions list available versions for given eggs
-n -no-install do not install, just build
diff --git a/chicken-status.mdoc b/chicken-status.mdoc
index 5d895698..750312cd 100644
--- a/chicken-status.mdoc
+++ b/chicken-status.mdoc
@@ -32,27 +32,28 @@
.Nd list installed extension libraries
.Sh SYNOPSIS
.Nm
-.Op Ar OPTION \(ba PATTERN ...
+.Op Ar OPTION \(ba NAME ...
.Sh DESCRIPTION
.Nm
-lists installed extensions for the CHICKEN Scheme system matching the regular
-.No expression Ns Pq s
-.Ar PATTERN
+lists installed extensions for the CHICKEN Scheme system matching the
+.No names Ns Pq s
+.Ar
or all, if no pattern has been given.
.Pp
The program accepts following arguments:
.Bl -tag -width Ds
.It Fl e, Fl eggs
list installed eggs
-.It Fl exact
+.It Fl match
treat
-.Ar PATTERN
-as exact match
-.Po not a pattern Pc
+.Ar NAME
+as a glob pattern Pc
.It Fl f Ns , Fl files
list installed files
.It Fl h, Fl help
show usage and exit
+.It Fl a, Fl all
+Scan all repositories in CHICKEN_REPOSITORY_PATH
.It Fl host
when cross-compiling, show status of host extensions only
.It Fl list
@@ -75,8 +76,11 @@ when configuring the system.
.It Ev CHICKEN_INSTALL_PREFIX
An alternative installation prefix that will be prepended to extension
installation paths if specified.
-.It Ev CHICKEN_REPOSITORY
-The path where extension libraries are installed. Defaults to the package-library
+.It Ev CHICKEN_REPOSITORY_PATH
+One or more directories holding extension libraries, defaults to the
+installation repository.
+.It Ev CHICKEN_INSTALL_REPOSITORY
+The path where extensionm libraries are installed. Defaults to the package-library
path selected during configuration
.Pq usually $prefix/lib/chicken/<binary-version>
.El
diff --git a/chicken-status.scm b/chicken-status.scm
index e014d258..021d4630 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -1,6 +1,6 @@
;;;; chicken-status.scm
;
-; Copyright (c) 2008-2016, The CHICKEN Team
+; Copyright (c) 2008-2017, The CHICKEN Team
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
@@ -43,27 +43,52 @@
(define host-extensions #t)
(define target-extensions #t)
+ (define all-repos #f)
(define (repo-path)
- (destination-repository
- (if (and cross-chicken (not host-extensions))
- 'target
- 'host)))
+ (cond ((and cross-chicken (not host-extensions))
+ (list (destination-repository 'target)))
+ (all-repos (##sys#split-path (repository-path)))
+ (else (list (destination-repository 'host)))))
+
+ (define (find-in-repo name)
+ (let loop ((dirs (repo-path)))
+ (cond ((null? dirs) #f)
+ ((file-exists? (make-pathname (car dirs) name)))
+ (else (loop (cdr dirs))))))
(define (grep rx lst)
(filter (cut irregex-search rx <>) lst))
(define (read-info egg)
- (load-egg-info (make-pathname (repo-path) egg +egg-info-extension+)))
+ (load-egg-info
+ (or (find-in-repo (make-pathname #f egg +egg-info-extension+))
+ (error "egg not found" egg))))
- (define (filter-eggs patterns)
+ (define (filter-eggs patterns mtch)
(let* ((eggs (gather-eggs))
- (pats (concatenate (map (cut grep <> eggs) patterns))))
- (delete-duplicates pats)))
+ (names (cond ((null? patterns) eggs)
+ (mtch
+ (concatenate
+ (map (lambda (pat)
+ (grep (irregex (##sys#glob->regexp pat))
+ eggs))
+ patterns)))
+ (else
+ (filter
+ (lambda (egg)
+ (any (cut string=? <> egg) patterns))
+ eggs)))))
+ (delete-duplicates names)))
(define (gather-eggs)
- (map pathname-file
- (glob (make-pathname (repo-path) "*" +egg-info-extension+))))
+ (delete-duplicates
+ (append-map
+ (lambda (dir)
+ (map pathname-file
+ (glob (make-pathname dir "*" +egg-info-extension+))))
+ (repo-path))
+ equal?))
(define (format-string str cols #!optional right (padc #\space))
(let* ((len (string-length str))
@@ -161,12 +186,13 @@
(define (usage code)
(print #<<EOF
-usage: chicken-status [OPTION | PATTERN] ...
+usage: chicken-status [OPTION | NAME] ...
-h -help show this message
-version show version and exit
+ -a -all scan all repositories in CHICKEN_REPOSITORY_PATH
-f -files list installed files
- -exact treat PATTERN as exact match (not a pattern)
+ -match treat NAME as glob pattern
-host when cross-compiling, show status of host extensions only
-target when cross-compiling, show status of target extensions only
-list dump installed extensions and their versions in "override" format
@@ -175,13 +201,13 @@ EOF
);|
(exit code))
- (define short-options '(#\h #\f #\c))
+ (define short-options '(#\h #\f #\c #\a))
(define (main args)
(let ((files #f)
(comps #f)
(dump #f)
- (exact #f))
+ (mtch #f))
(let loop ((args args) (pats '()))
(if (null? args)
(cond ((and comps (or dump files))
@@ -190,16 +216,7 @@ EOF
(exit 1))
(dump (dump-installed-versions))
(else
- (let* ((patterns
- (map irregex
- (cond ((null? pats) '(".*"))
- (exact (map (lambda (p)
- (string-append "^"
- (irregex-quote p)
- "$"))
- pats))
- (else (map ##sys#glob->regexp pats)))))
- (eggs (filter-eggs patterns)))
+ (let ((eggs (filter-eggs pats mtch)))
(if (null? eggs)
(display "(none)\n" (current-error-port))
((cond (comps list-installed-components)
@@ -215,9 +232,12 @@ EOF
((string=? arg "-target")
(set! host-extensions #f)
(loop (cdr args) pats))
- ((string=? arg "-exact")
- (set! exact #t)
- (loop (cdr args) pats))
+ ((string=? arg "-match")
+ (set! mtch #t)
+ (loop (cdr args) pats))
+ ((member arg '("-a" "-all"))
+ (set! all-repos #t)
+ (loop (cdr args) pats))
((string=? arg "-list")
(set! dump #t)
(loop (cdr args) pats))
diff --git a/chicken-uninstall.mdoc b/chicken-uninstall.mdoc
index f8814c17..40a8348e 100644
--- a/chicken-uninstall.mdoc
+++ b/chicken-uninstall.mdoc
@@ -32,7 +32,7 @@
.Nd uninstall extension library
.Sh SYNOPSIS
.Nm
-.Op Ar OPTION \(ba PATTERN ...
+.Op Ar OPTION \(ba NAME ...
.Sh DESCRIPTION
.Nm
removes one or more already installed extension
@@ -42,11 +42,10 @@ may be a regular expression naming multiple extensions or just an extension name
.Pp
The program accepts following arguments:
.Bl -tag -width Ds
-.It Fl exact
+.It Fl match
treat
-.Ar PATTERN
-as exact match
-.Po not a pattern Pc
+.Ar NAME
+as a glob pattern Pc
.It Fl force
don't ask, delete whatever matches
.It Fl h, Fl help
@@ -76,7 +75,7 @@ when configuring the system.
.It Ev CHICKEN_INSTALL_PREFIX
An alternative installation prefix that will be prepended to extension
installation paths if specified.
-.It Ev CHICKEN_REPOSITORY
+.It Ev CHICKEN_INSTAL_REPOSITORY
The path where extension libraries are installed. Defaults to the package-library
path selected during configuration
.Pq usually $prefix/lib/chicken/<binary-version>
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index 6f073e7a..f044e85f 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -1,6 +1,6 @@
;;;; chicken-uninstall.scm
;
-; Copyright (c) 2008-2016, The CHICKEN Team
+; Copyright (c) 2008-2017, The CHICKEN Team
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
@@ -56,10 +56,19 @@
(define (grep rx lst)
(filter (cut irregex-search rx <>) lst))
-(define (gather-eggs patterns)
+(define (gather-eggs patterns mtch)
(let* ((eggs (map pathname-file
(glob (make-pathname (repo-path) "*" +egg-info-extension+))))
- (pats (concatenate (map (cut grep <> eggs) patterns))))
+ (pats (if mtch
+ (concatenate
+ (map (lambda (pat)
+ (grep (irregex (##sys#glob->regexp pat))
+ eggs))
+ patterns))
+ (filter
+ (lambda (egg)
+ (any (cut string=? <> egg) patterns))
+ eggs))))
(delete-duplicates pats)))
(define (fini code)
@@ -86,15 +95,16 @@
(else (cons (car lst) (left (cdr lst))))))
(list->string (reverse (left (reverse (left (string->list str)))))))
-(define (remove-extension egg #!optional (repo (repo-path)))
- (and-let* ((ifile (make-pathname repo egg +egg-info-extension+))
- (files (get-egg-property* (load-egg-info ifile) 'installed-files)))
- (for-each
- (lambda (f)
- (let ((p (if (absolute-pathname? f) f (make-pathname repo f))))
- (when (file-exists? p) (delete-installed-file p))))
- files)
- (delete-installed-file ifile)))
+(define (remove-extension egg)
+ (and-let* ((ifile (file-exists?
+ (make-pathname (repo-path) egg +egg-info-extension+)))
+ (files (get-egg-property* (load-egg-info ifile)
+ 'installed-files)))
+ (for-each
+ (lambda (f)
+ (when (file-exists? f) (delete-installed-file f)))
+ files)
+ (delete-installed-file ifile)))
(define (delete-file-command platform)
(case platform
@@ -111,27 +121,25 @@
(warning "deleting file failed" fname))))
(else (delete-file fname))))
-(define (uninstall pats)
- (let ((eggs (gather-eggs pats)))
+(define (uninstall pats mtch)
+ (let ((eggs (gather-eggs pats mtch)))
(cond ((null? eggs)
(print "nothing to remove.") )
((or force-uninstall (ask eggs))
(for-each
(lambda (e)
(print "removing " e)
- (when host-extensions (remove-extension e))
- (when (and cross-chicken target-extensions)
- (remove-extension e (destination-repository 'target))))
+ (remove-extension e))
eggs)))))
(define (usage code)
(print #<<EOF
-usage: chicken-uninstall [OPTION | PATTERN] ...
+usage: chicken-uninstall [OPTION | NAME] ...
-h -help show this message and exit
-version show version and exit
-force don't ask, delete whatever matches
- -exact treat PATTERN as exact match (not a pattern)
+ -match treat NAME as a glob pattern
-s -sudo use external command to elevate privileges for deleting files
-host when cross-compiling, uninstall host extensions only
-target when cross-compiling, uninstall target extensions only
@@ -142,18 +150,11 @@ EOF
(define short-options '(#\h #\s #\p))
(define (main args)
- (let ((exact #f))
+ (let ((mtch #f))
(let loop ((args args) (pats '()))
(cond ((null? args)
(when (null? pats) (usage 1))
- (uninstall
- (reverse
- (map
- (lambda (p)
- (if exact
- (irregex (string-append "^" (irregex-quote p) "$"))
- (##sys#glob->regexp p)))
- pats))))
+ (uninstall (reverse pats) mtch))
(else
(let ((arg (car args)))
(cond ((or (string=? arg "-help")
@@ -172,8 +173,8 @@ EOF
((string=? arg "-force")
(set! force-uninstall #t)
(loop (cdr args) pats))
- ((string=? arg "-exact")
- (set! exact #t)
+ ((string=? arg "-match")
+ (set! mtch #t)
(loop (cdr args) pats))
((or (string=? arg "-s") (string=? arg "-sudo"))
(set! sudo-uninstall #t)
diff --git a/chicken.import.scm b/chicken.import.scm
index 3616ed61..92236396 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -1,6 +1,6 @@
;;;; chicken.import.scm - import library for "chicken" module
;
-; Copyright (c) 2008-2016, The CHICKEN Team
+; Copyright (c) 2008-2017, The CHICKEN Team
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
@@ -115,6 +115,7 @@
implicit-exit-handler
infinite?
input-port-open?
+ (installation-repository . chicken.eval#installation-repository)
(ir-macro-transformer . chicken.expand#ir-macro-transformer)
keyword-style
(load-library . chicken.eval#load-library)
diff --git a/csc.scm b/csc.scm
index 76fbaa8d..01089a70 100644
--- a/csc.scm
+++ b/csc.scm
@@ -299,7 +299,7 @@
(or (locate-object-file f #f)
(and (not ignore-repository)
(locate-object-file f #t))
- (stop "couldn't find linked extension: ~a" name))))
+ (stop "could not find linked extension: ~a" name))))
;;; Display usage information:
diff --git a/csi.scm b/csi.scm
index a6c12871..3b0cf813 100644
--- a/csi.scm
+++ b/csi.scm
@@ -1,6 +1,6 @@
;;;; csi.scm - Interpreter stub for CHICKEN
;
-; Copyright (c) 2008-2016, The CHICKEN Team
+; Copyright (c) 2008-2017, The CHICKEN Team
; Copyright (c) 2000-2007, Felix L. Winkelmann
; All rights reserved.
;
@@ -477,6 +477,7 @@ EOF
Software version:\t~A~%~
Build platform: \t~A~%~
Installation prefix:\t~A~%~
+ Extension installation location:\t~A~%~
Extension path: \t~A~%~
Include path: \t~A~%~
Keyword style: \t~A~%~
@@ -492,6 +493,7 @@ EOF
(software-version)
(build-platform)
prefix
+ (installation-repository)
(repository-path)
##sys#include-pathnames
(symbol->string (keyword-style))
diff --git a/egg-environment.scm b/egg-environment.scm
index 73b24132..c6e0cc83 100644
--- a/egg-environment.scm
+++ b/egg-environment.scm
@@ -90,7 +90,7 @@ EOF
(define +egg-info-extension+ ".egg-info")
(define (destination-repository mode)
- (or (get-environment-variable "CHICKEN_REPOSITORY")
- (case mode
- ((target) target-repo)
- ((host) host-repo))))
+ (if (eq? 'target mode)
+ target-repo
+ (or (get-environment-variable "CHICKEN_INSTALL_REPOSITORY")
+ host-repo)))
diff --git a/eval.scm b/eval.scm
index 93ff795c..2998393e 100644
--- a/eval.scm
+++ b/eval.scm
@@ -51,12 +51,14 @@
eval eval-handler extension-information
load load-library load-noisily load-relative load-verbose
interaction-environment null-environment scheme-report-environment
- load-extension provide provided? repository-path
+ load-extension provide provided? repository-path
+ installation-repository
require set-dynamic-load-mode!)
;; Exclude bindings defined within this module.
(import (except scheme eval load interaction-environment null-environment scheme-report-environment)
- (except chicken chicken-home provide provided? repository-path require))
+ (except chicken chicken-home provide provided? repository-path
+ installation-repository require))
(import chicken.expand
chicken.foreign
@@ -100,7 +102,6 @@
(define-constant environment-table-size 301)
(define-constant source-file-extension ".scm")
(define-constant setup-file-extension "egg-info")
-(define-constant repository-environment-variable "CHICKEN_REPOSITORY")
(define-constant prefix-environment-variable "CHICKEN_PREFIX")
(define-constant windows-object-file-extension ".obj")
(define-constant unix-object-file-extension ".o")
@@ -1185,17 +1186,51 @@
(define repository-path
(make-parameter
(or (foreign-value "C_private_repository_path()" c-string)
- (get-environment-variable repository-environment-variable)
+ (get-environment-variable "CHICKEN_REPOSITORY_PATH")
(chicken-prefix
(##sys#string-append
"lib/chicken/"
(##sys#number->string binary-version)))
install-egg-home)))
-(define ##sys#repository-path repository-path)
+(define installation-repository
+ (make-parameter
+ (or (foreign-value "C_private_repository_path()" c-string)
+ (get-environment-variable "CHICKEN_INSTALL_REPOSITORY")
+ (chicken-prefix
+ (##sys#string-append
+ "lib/chicken/"
+ (##sys#number->string binary-version)))
+ install-egg-home)))
+(define ##sys#repository-path repository-path)
+(define ##sys#installation-repository installation-repository)
(define ##sys#setup-mode #f)
+(define path-list-separator
+ (if ##sys#windows-platform #\; #\:))
+
+(define ##sys#split-path
+ (let ((cache '(#f)))
+ (lambda (path)
+ (if (equal? path (car cache))
+ (cdr cache)
+ (let* ((len (string-length path))
+ (lst (let loop ((start 0) (pos 0))
+ (cond ((fx>= pos len)
+ (if (fx= pos start)
+ '()
+ (list (substring path start pos))))
+ ((char=? (string-ref path pos)
+ path-list-separator)
+ (cons (substring path start pos)
+ (loop (fx+ pos 1)
+ (fx+ pos 1))))
+ (else
+ (loop start (fx+ pos 1)))))))
+ (set! cache (cons path lst))
+ lst)))))
+
(define ##sys#find-extension
(let ((file-exists? file-exists?)
(string-append string-append))
@@ -1211,7 +1246,7 @@
(file-exists? (##sys#string-append p0 source-file-extension)))))
(let loop ((paths (##sys#append
(if ##sys#setup-mode '(".") '())
- (if rp (list rp) '())
+ (if rp (##sys#split-path rp) '())
(if inc? ##sys#include-pathnames '())
(if ##sys#setup-mode '() '("."))) ))
(and (pair? paths)
@@ -1252,26 +1287,33 @@
(every ##sys#provided? ids))
(define extension-information/internal
- (let ([with-input-from-file with-input-from-file]
- [string-append string-append]
- [read read] )
+ (let ((with-input-from-file with-input-from-file)
+ (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)))
+ (let loop ((rp (##sys#split-path rp)))
+ (cond ((null? rp) #f)
+ ((file-exists? (string-append (car rp) "/" p "."
+ setup-file-extension))
+ => (cut with-input-from-file <> read) )
+ (else (loop (cdr rp))))))))))
(define (extension-information ext)
(extension-information/internal ext 'extension-information))
-(define (static-extension-available? id)
- (and-let* ((rp (##sys#repository-path)))
- (let* ((p (##sys#canonicalize-extension-path id #f))
- (rpath (string-append rp "/" p))
- (opath (string-append rpath object-file-extension)))
- (file-exists? opath))))
+(define static-extension-available?
+ (let ((string-append string-append))
+ (lambda (id)
+ (and-let* ((rp (##sys#repository-path)))
+ (let loop ((rp (##sys#split-path rp)))
+ (cond ((null? rp) #f)
+ ((file-exists?
+ (string-append (car rp) "/"
+ (##sys#canonicalize-extension-path id #f)
+ object-file-extension)))
+ (else (loop (cdr rp)))))))))
;;
@@ -1378,9 +1420,7 @@
;;; Find included file:
-(define ##sys#include-pathnames
- (let ((h (chicken-home)))
- (if h (list h) '())) )
+(define ##sys#include-pathnames (list (chicken-home)))
(define ##sys#resolve-include-filename
(let ((string-append string-append) )
@@ -1410,7 +1450,7 @@
##sys#include-pathnames
(let ((rp (##sys#repository-path)))
(if rp
- (list (##sys#repository-path))
+ (##sys#split-path rp)
'())))
##sys#include-pathnames) ) )
(cond ((eq? paths '()) #f)
diff --git a/manual/Extensions b/manual/Extensions
index 25c812ff..4e3b8962 100644
--- a/manual/Extensions
+++ b/manual/Extensions
@@ -589,17 +589,18 @@ Available options:
; {{-p -prefix PREFIX}} : change installation prefix to {{PREFIX}}
; {{-host}} : when cross-compiling, remove eggs for host system only
; {{-target}} : when cross-compiling, remove eggs for target system only
-; {{-exact}} : match egg-name exactly (do not match as pattern)
+; {{-match}} : treat egg-names as glob patterns
=== chicken-status reference
; {{-h -help}} : show usage information and exit
; {{-version}} : show version and exit
; {{-f -files}} : list installed files
+; {{-a -all}} : Scan all repositories in {{CHICKEN_REPOSITORY_PATH}}
; {{-host}} : when cross-compiling, show eggs for host system only
; {{-target}} : when cross-compiling, show eggs for target system only
; {{-p -prefix PREFIX}} : change installation prefix to {{PREFIX}}
-; {{-exact}} : match egg-name exactly (do not match as pattern)
+; {{-match}} : treat egg-names as glob patterns
; {{-list}} : list installed egg version in format suitable for {{chicken-install -override}}
@@ -637,7 +638,8 @@ configured at build-time by passing {{VARDIR=<directory>}} to {{make(3)}}
or by modifying the {{config.make}} configuration file. If you want to
override this location after chicken is installed, you can create a
repository directory, set the
-{{CHICKEN_REPOSITORY}} environment variable and copy all files
+{{CHICKEN_INSTALL_REPOSITORY}} and/or {{CHICKEN_REPOSITORY_PATH}}
+environment variables and copy all files
from the default repository into the new one.
Note that your binary version can differ from the one given in
@@ -645,9 +647,11 @@ the examples here, if your
chicken version is older or newer than the one used in these examples.
Check your default location for the correct binary-version number.
-{{CHICKEN_REPOSITORY}} is the place where eggs are to be
-loaded from for all chicken-based programs (which includes all
-the tools).
+{{CHICKEN_REPOSITORY_PATH}} is the place where eggs are to be
+loaded from for all chicken-based programs. {{CHICKEN_INSTALL_REPOSITORY}}
+is the place where eggs will be installed and which the egg-related
+tools like {{chicken-install}}, {{chicken-uninstall}} and
+{{chicken-status}} consult and update.
=== Static linking
diff --git a/manual/Unit eval b/manual/Unit eval
index 053cb3ce..42eca4e5 100644
--- a/manual/Unit eval
+++ b/manual/Unit eval
@@ -121,10 +121,21 @@ following locations:
<parameter>repository-path</parameter>
-Contains a string naming the path to the extension repository, which defaults to
-either the value of the environment variable {{CHICKEN_REPOSITORY}}
+Contains a string naming the paths to the extension repository, which
+defaults to
+either the value of the environment variable {{CHICKEN_REPOSITORY_PATH}}
or the default library path
-(usually {{/usr/local/lib/chicken}} on UNIX systems).
+(usually {{/usr/local/lib/chicken}} on UNIX systems). If multiple
+directories are given, then they should be separated by {{:}}
+(or {{;}} on Windows.)
+
+==== installation-repository
+
+<paramater>installation-repository</parameter>
+
+Contains the name of the directory where extensions are installed
+(as opposed to the possible locations where they can be loaded or
+linked at runtime.)
==== extension-information
diff --git a/manual/faq b/manual/faq
index 3f809896..f88de23b 100644
--- a/manual/faq
+++ b/manual/faq
@@ -831,14 +831,16 @@ See the [[Extensions]] chapter for more information.
==== How can I install CHICKEN eggs to a non-default location?
-You can just set the {{CHICKEN_REPOSITORY}} environment variable.
-It should contain the path where you want eggs to be installed:
+You can just set the {{CHICKEN_INSTALL_REPOSITORY}} and {{CHICKEN_REPOSITORY_PATH}}
+environment variables.
+They should contain the path where you want eggs to be installed:
- $ export CHICKEN_REPOSITORY=~/eggs/lib/chicken/5
+ $ export CHICKEN_INSTALL_REPOSITORY=~/eggs/lib/chicken/5
+ $ export CHICKEN_REPOSITORY_PATH=~/eggs/lib/chicken/5
$ chicken-install -init ~/eggs/lib/chicken/5
$ chicken-install -p ~/eggs/ extensionname
-In order to make programs (including csi) see these eggs, you should set this variable when you run them. See the [[Extensions#Changing repository location|Extensions/Changing repository location]] section of the manual for more information on that.
+In order to make programs (including csi) see these eggs, you should set {{CHICKEN_REPOSITORY_PATH}} when you run them. See the [[Extensions#Changing repository location|Extensions/Changing repository location]] section of the manual for more information on that.
Alternatively, you can call the {{repository-path}} Scheme procedure before loading the eggs, as in:
@@ -854,7 +856,7 @@ to {{chicken-install}}, in [[Extensions]].
==== Can I install chicken eggs as a non-root user?
-Yes, just install them in a directory you can write to by using {{CHICKEN_REPOSITORY}} (see above).
+Yes, just install them in a directory you can write to by using {{CHICKEN_INSTALL_REPOSITORY}} (see above).
==== Why does downloading an extension via {{chicken-install}} fail on Windows Vista?
diff --git a/scripts/mini-salmonella.scm b/scripts/mini-salmonella.scm
index 7761789a..593dbcac 100644
--- a/scripts/mini-salmonella.scm
+++ b/scripts/mini-salmonella.scm
@@ -16,8 +16,7 @@
(define *download* #f)
(define *trunk* #f)
-(define *prefix*
- (pathname-directory (pathname-directory (pathname-directory (repository-path)))))
+(define *prefix* (getenv "CHICKEN_PREFIX"))
(let loop ((args (command-line-arguments)))
(when (pair? args)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 10750542..bc824ab2 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1697,12 +1697,18 @@
;;; type-db processing
-(define (load-type-database name specialize #!optional (path (##sys#repository-path)))
+(define (load-type-database name specialize #!optional
+ (path (##sys#repository-path)))
(define (clean! name)
(when specialize (mark-variable name '##compiler#clean #t)))
(define (pure! name)
(when specialize (mark-variable name '##compiler#pure #t)))
- (and-let* ((dbfile (file-exists? (make-pathname path name))))
+ (define (locate)
+ (let loop ((dirs (##sys#split-path path)))
+ (cond ((null? dirs) #f)
+ ((file-exists? (make-pathname (car dirs) name)))
+ (else (loop (cdr dirs))))))
+ (and-let* ((dbfile (locate)))
(debugging 'p (sprintf "loading type database `~a' ...~%" dbfile))
(fluid-let ((scrutiny-debug #f))
(for-each
diff --git a/support.scm b/support.scm
index 020f335e..10b5cca6 100644
--- a/support.scm
+++ b/support.scm
@@ -1627,8 +1627,12 @@
;;; Load support files
(define (load-identifier-database name) ; Used only in batch-driver.scm
- (and-let* ((rp (##sys#repository-path))
- (dbfile (file-exists? (make-pathname rp name))))
+ (define (locate)
+ (let loop ((dirs (##sys#split-path (##sys#repository-path))))
+ (cond ((null? dirs) #f)
+ ((file-exists? (make-pathname (car dirs) name)))
+ (else (loop (cdr dirs))))))
+ (and-let* ((dbfile (locate)))
(debugging 'p (sprintf "loading identifier database ~a ...~%" dbfile))
(for-each
(lambda (e)
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 469003ab..356f1546 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -8,7 +8,8 @@ set OS_NAME=WindowsNT
set CHICKEN=..\chicken
set CHICKEN_PROFILE=..\chicken-profile
-set CHICKEN_REPOSITORY=
+set CHICKEN_INSTALL_REPOSITORY=
+set CHICKEN_REPOSITORY_PATH=
set ASMFLAGS=-Wa,-w
set FAST_OPTIONS=-O5 -d0 -b -disable-interrupts
set PATH=%cd%\..;%PATH%
@@ -575,10 +576,11 @@ if errorlevel 1 exit /b 1
if errorlevel 1 exit /b 1
linking-tests
if errorlevel 1 exit /b 1
-set CHICKEN_REPOSITORY=test-repository
-mkdir %CHICKEN_REPOSITORY%
-move reverser.o %CHICKEN_REPOSITORY%
-move reverser.import.scm %CHICKEN_REPOSITORY%
+set CHICKEN_INSTALL_REPOSITORY=test-repository
+set CHICKEN_REPOSITORY_PATH=test-repository
+mkdir %CHICKEN_INSTALL_REPOSITORY%
+move reverser.o %CHICKEN_INSTALL_REPOSITORY%
+move reverser.import.scm %CHICKEN_INSTALL_REPOSITORY%
%compile2% -link reverser linking-tests.scm
if errorlevel 1 exit /b 1
linking-tests
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 383bbe2e..d39360df 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -33,42 +33,8 @@ esac
rm -fr test-repository
mkdir -p test-repository
-# copy files into test-repository (by hand to avoid calling `chicken-install'):
-
-for x in \
- chicken.import.so types.db \
- srfi-4.import.so \
- chicken.bitwise.import.so \
- chicken.continuation.import.so \
- chicken.csi.import.so \
- chicken.data-structures.import.so \
- chicken.files.import.so \
- chicken.flonum.import.so \
- chicken.foreign.import.so \
- chicken.format.import.so \
- chicken.gc.import.so \
- chicken.internal.import.so \
- chicken.io.import.so \
- chicken.irregex.import.so \
- chicken.keyword.import.so \
- chicken.locative.import.so \
- chicken.lolevel.import.so \
- chicken.memory.import.so \
- chicken.pathname.import.so \
- chicken.ports.import.so \
- chicken.posix.import.so \
- chicken.pretty-print.import.so \
- chicken.random.import.so \
- chicken.repl.import.so \
- chicken.read-syntax.import.so \
- chicken.tcp.import.so \
- chicken.time.import.so \
- chicken.utils.import.so
-do
- cp ../$x test-repository
-done
-
-CHICKEN_REPOSITORY=${TEST_DIR}/test-repository
+CHICKEN_INSTALL_REPOSITORY=${TEST_DIR}/test-repository
+CHICKEN_REPOSITORY_PATH=${TEST_DIR}..:$CHICKEN_REPOSITORY
CHICKEN=${TEST_DIR}/../chicken
CHICKEN_PROFILE=${TEST_DIR}/../chicken-profile
CHICKEN_INSTALL=${TEST_DIR}/../chicken-install
@@ -481,10 +447,10 @@ $compile2 -link reverser linking-tests.scm
./linking-tests
$compile2 -link reverser linking-tests.scm -static
./linking-tests
-mv reverser.o reverser.import.scm "$CHICKEN_REPOSITORY"
-CHICKEN_REPOSITORY=$CHICKEN_REPOSITORY $compile2 -link reverser linking-tests.scm
+mv reverser.o reverser.import.scm "$CHICKEN_INSTALL_REPOSITORY"
+CHICKEN_INSTALL_REPOSITORY=$CHICKEN_INSTALL_REPOSITORY CHICKEN_REPOSITORY_PATH=$CHICKEN_REPOSITORY_PATH $compile2 -link reverser linking-tests.scm
./linking-tests
-CHICKEN_REPOSITORY=$CHICKEN_REPOSITORY $compile2 -link reverser linking-tests.scm -static
+CHICKEN_INSTALL_REPOSITORY=$CHICKEN_INSTALL_REPOSITORY CHICKEN_REPOSITORY_PATH=$CHICKEN_REPOSITORY_PATH $compile2 -link reverser linking-tests.scm -static
./linking-tests
echo "======================================== private repository test ..."
diff --git a/types.db b/types.db
index 17250e91..4a1c84bc 100644
--- a/types.db
+++ b/types.db
@@ -862,6 +862,7 @@
(chicken.eval#provide (#(procedure #:clean #:enforce) chicken.eval#provide (#!rest symbol) undefined))
(chicken.eval#provided? (#(procedure #:clean #:enforce) chicken.eval#provided? (#!rest symbol) boolean))
(chicken.eval#repository-path (#(procedure #:clean) chicken.eval#repository-path (#!optional *) *))
+(chicken.eval#installation-repository (#(procedure #:clean) chicken.eval#installation-repository (#!optional *) *))
(chicken.eval#require (#(procedure #:clean) chicken.eval#require (#!rest symbol) undefined))
(chicken.eval#scheme-report-environment
Trap