Currently "chicken-home" can be used to obtain the location for
sundry "data" files installed by eggs and usually required at runtime.
This location may need to be changed when installing eggs into
custom locations or when a CHICKEN installation via package
manager uses a non-writable directory.
The attached patch deprecates "chicken-home" in favor of using
the include-path, which is already changable (via environment
variable) and also can hold several locations which makes it possible
to have a set of possible locations, probably in addition to the
default system directory (usually $PREFIX/share/chicken),
quite similar to the repository-path.
This patch addes "include-path" as a quasi-replacement for
"chicken-home" (also chicken.platform module). Eggs that want to
operate on installed data files at run-time should use "include-path"
from now on to locate any files, or, if they wish to be backwards
compatible, can access the variable "##sys#include-pathnames"
as a temporary workaround.
felix
From 40f033956a85859cc1c653da4a5d2dccc4740320 Mon Sep 17 00:00:00 2001
From: felix <fe...@call-with-current-continuation.org>
Date: Mon, 22 Jan 2024 21:46:21 +0100
Subject: [PATCH] Deprecate chicken-home, add include-path
init ##sys#include-pathnames in library.scm and populate with contents
of CHICKEN_INCLUDE_PATH directly, instead of doing this in csi/chicken.
Also move chop-separator from support.scm to batch-driver since it is only
used there.
---
DEPRECATED | 4 ++++
NEWS | 2 ++
batch-driver.scm | 21 ++++++++++++---------
csi.scm | 12 ++++--------
eval.scm | 2 --
library.scm | 20 +++++++++++++++++++-
manual/Module (chicken platform) | 16 ++++++++++------
support.scm | 13 ++-----------
types.db | 3 ++-
9 files changed, 55 insertions(+), 38 deletions(-)
diff --git a/DEPRECATED b/DEPRECATED
index c8d19bd1..716a148b 100644
--- a/DEPRECATED
+++ b/DEPRECATED
@@ -8,6 +8,10 @@ Deprecated functions and variables
- "set-signal-handler!" and "signal-handler" have been deprecated
in favor of "make-signal-handler" and "ignore-signal" which are
better suited in a multithreaded environment.
+- "chicken-home" is deprecated as it is not possible to override
+ when installing eggs into a custom location. Use "include-path" instead
+ (or "##sys#include-pathnames" for code that is intended to be
+ backwards compatible) when accessing the data location.
5.2.1
- current-milliseconds and its C implementations C_milliseconds and
diff --git a/NEWS b/NEWS
index 46c5d423..6b09db47 100644
--- a/NEWS
+++ b/NEWS
@@ -35,6 +35,8 @@
longer memoized (fixes #1830).
- Condition objects produced by procedures that change errno now have
an `errno' property.
+ - Deprecated "chicken-home" and added "include-path" in the
+ chicken.platform module.
- Tools
- The -R option for csi and csc now accepts list-notation like
diff --git a/batch-driver.scm b/batch-driver.scm
index 8f0a4f35..b9cbe674 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -219,7 +219,7 @@
'()
`((import-syntax ,@default-imports)))))
(cleanup-forms '(((chicken.base#implicit-exit-handler))))
- (outfile (cond ((memq 'output-file options)
+ (outfile (cond ((memq 'output-file options)
=> (lambda (node)
(let ((oname (option-arg node)))
(if (symbol? oname)
@@ -227,18 +227,15 @@
oname) ) ) )
((memq 'to-stdout options) #f)
(else (make-pathname #f (if filename (pathname-file
filename) "out") "c")) ) )
- (ipath (map chop-separator
- (##sys#split-path
- (or (get-environment-variable "CHICKEN_INCLUDE_PATH")
""))))
(opasses (default-optimization-passes))
(time0 #f)
(time-breakdown #f)
(forms '())
(inline-output-file #f)
(profile (or (memq 'profile options)
- (memq 'accumulate-profile options)
+ (memq 'accumulate-profile options)
(memq 'profile-name options)))
- (profile-name
+ (profile-name
(and-let* ((pn (memq 'profile-name options))) (cadr pn)))
(hsize (memq 'heap-size options))
(kwstyle (memq 'keyword-style options))
@@ -339,6 +336,13 @@
no contf) )
db) ) )
+ (define (chop-separator str)
+ (let ((len (sub1 (string-length str))))
+ (if (and (> len 0)
+ (memq (string-ref str len) '(#\\ #\/)))
+ (substring str 0 len)
+ str) ) )
+
(when unit
(set! unit-name (string->symbol (option-arg unit))))
(when (or unit-name dynamic)
@@ -347,7 +351,7 @@
(set! ##sys#dload-disabled #t)
(repository-path #f))
(set! enable-specialization (memq 'specialize options))
- (set! debugging-chicken
+ (set! debugging-chicken
(append-map
(lambda (do)
(map (lambda (c) (string->symbol (string c)))
@@ -452,8 +456,7 @@
(set! ##sys#read-error-with-line-number #t)
(set! ##sys#include-pathnames
(append (map chop-separator (collect-options 'include-path))
- ##sys#include-pathnames
- ipath) )
+ ##sys#include-pathnames) )
(when (and outfile filename (string=? outfile filename))
(quit-compiling "source- and output-filename are the same") )
(when (memq 'keep-shadowed-macros options)
diff --git a/csi.scm b/csi.scm
index 63ff4221..7523bbcf 100644
--- a/csi.scm
+++ b/csi.scm
@@ -1022,13 +1022,10 @@ EOF
(let* ([eval? (member* '("-e" "-p" "-P" "-eval" "-print" "-pretty-print")
args)]
[batch (or script (member* '("-b" "-batch") args) eval?)]
[quietflag (member* '("-q" "-quiet") args)]
- [quiet (or script quietflag eval?)]
- [ipath (map chop-separator
- (##sys#split-path
- (or (get-environment-variable "CHICKEN_INCLUDE_PATH")
"")))])
+ [quiet (or script quietflag eval?)])
(define (collect-options opt)
(let loop ([opts args])
- (cond [(member opt opts)
+ (cond [(member opt opts)
=> (lambda (p)
(if (null? (cdr p))
(##sys#error "missing argument to command-line
option" opt)
@@ -1072,12 +1069,11 @@ EOF
(for-each register-feature! (collect-options "-feature"))
(for-each register-feature! (collect-options "-D"))
(for-each unregister-feature! (collect-options "-no-feature"))
- (set! ##sys#include-pathnames
+ (set! ##sys#include-pathnames
(delete-duplicates
(append (map chop-separator (collect-options "-include-path"))
(map chop-separator (collect-options "-I"))
- ##sys#include-pathnames
- ipath)
+ ##sys#include-pathnames)
string=?) )
(when kwstyle
(cond [(not (pair? (cdr kwstyle)))
diff --git a/eval.scm b/eval.scm
index e760aad0..6d01e0f8 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1283,8 +1283,6 @@
;;; Find included file:
-(define ##sys#include-pathnames (list (chicken-home)))
-
(define ##sys#resolve-include-filename
(let ((string-append string-append) )
(lambda (fname exts repo source)
diff --git a/library.scm b/library.scm
index 3ec87a74..4a8a2d33 100644
--- a/library.scm
+++ b/library.scm
@@ -6555,7 +6555,9 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
;;; Platform configuration inquiry:
(module chicken.platform
- (build-platform chicken-version chicken-home
+ (build-platform chicken-version
+ chicken-home ;; DEPRECATED
+ include-path
feature? features machine-byte-order machine-type
repository-path installation-repository
register-feature! unregister-feature!
@@ -6628,6 +6630,7 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
(define-foreign-variable installation-home c-string "C_INSTALL_SHARE_HOME")
(define-foreign-variable install-egg-home c-string "C_INSTALL_EGG_HOME")
+;; DEPRECATED
(define (chicken-home) installation-home)
(define path-list-separator
@@ -6678,6 +6681,21 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
(get-environment-variable "CHICKEN_INSTALL_REPOSITORY")
install-egg-home)))
+(define (chop-separator str)
+ (let ((len (fx- (string-length str) 1)))
+ (if (and (> len 0)
+ (memq (string-ref str len) '(#\\ #\/)))
+ (substring str 0 len)
+ str) ) )
+
+(define ##sys#include-pathnames
+ (cond ((get-environment-variable "CHICKEN_INCLUDE_PATH")
+ => (lambda (p)
+ (map chop-separator (##sys#split-path p))))
+ (else (list installation-home))))
+
+(define (include-path) ##sys#include-pathnames)
+
;;; Feature identifiers:
diff --git a/manual/Module (chicken platform) b/manual/Module (chicken platform)
index 7453195c..2d513034 100644
--- a/manual/Module (chicken platform)
+++ b/manual/Module (chicken platform)
@@ -26,12 +26,6 @@ building the executing system, which is one of the following:
sun
unknown
-==== chicken-home
-
-<procedure>(chicken-home)</procedure>
-
-Returns a string which represents the installation directory (usually
{{/usr/local/share/chicken}} on UNIX-like systems).
-
==== chicken-version
<procedure>(chicken-version [FULL])</procedure>
@@ -40,6 +34,16 @@ Returns a string containing the version number of the
CHICKEN runtime
system. If the optional argument {{FULL}} is given and true, then
a full version string is returned.
+==== include-path
+
+<procedure>(include-path)</procedure>
+
+Returns a list of strings representing directory names where included files
are located,
+which defaults to the value of the environment variable
+{{CHICKEN_INCLUDE_PATH}}, split on {{:}} (or {{;}} on Windows).
+If the variable is not set, the list is initialized to contain the
installation directory
+(usually {{/usr/local/share/chicken}} on UNIX-like systems).
+
==== repository-path
<parameter>repository-path</parameter>
diff --git a/support.scm b/support.scm
index 1e74239a..a11c26ed 100644
--- a/support.scm
+++ b/support.scm
@@ -56,7 +56,7 @@
register-foreign-type! lookup-foreign-type clear-foreign-type-table!
estimate-foreign-result-size estimate-foreign-result-location-size
finish-foreign-result foreign-type->scrutiny-type scan-used-variables
- scan-free-variables chop-separator
+ scan-free-variables
make-block-variable-literal block-variable-literal?
block-variable-literal-name make-random-name
clear-real-name-table! get-real-name set-real-name!
@@ -1459,18 +1459,9 @@
(values vars hvars) ) ) ; => freevars hiddenvars
-;;; Some pathname operations:
-
-(define (chop-separator str) ; Used only in batch-driver.scm
- (let ([len (sub1 (string-length str))])
- (if (and (> len 0)
- (memq (string-ref str len) '(#\\ #\/)))
- (substring str 0 len)
- str) ) )
-
;;; Special block-variable literal type:
-(define-record-type block-variable-literal
+(define-record-type block-variable-literal
(make-block-variable-literal name)
block-variable-literal?
(name block-variable-literal-name)) ; symbol
diff --git a/types.db b/types.db
index ad4f547f..c7c6e2b2 100644
--- a/types.db
+++ b/types.db
@@ -1356,7 +1356,8 @@
(chicken.platform#build-platform (#(procedure #:pure)
chicken.platform#build-platform () symbol))
(chicken.platform#chicken-version (#(procedure #:pure)
chicken.platform#chicken-version (#!optional *) string))
-(chicken.platform#chicken-home (#(procedure #:clean)
chicken.platform#chicken-home () string))
+(chicken.platform#chicken-home deprecated)
+(chicken.platform#include-path (#(procedure #:clean)
chicken.platform#include-path () string))
(chicken.platform#feature? (#(procedure #:clean) chicken.platform#feature?
(#!rest (or keyword symbol string)) boolean))
(chicken.platform#features (#(procedure #:clean) chicken.platform#features ()
(list-of keyword)))
(chicken.platform#software-type (#(procedure #:pure)
chicken.platform#software-type () symbol))
--
2.40.0
