~ chicken-core (chicken-5) f597fa17480a0ea5b57fa7c9707ced1f704ba487
commit f597fa17480a0ea5b57fa7c9707ced1f704ba487
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Jan 22 21:46:21 2024 +0100
Commit: Mario Domenech Goulart <mario@parenteses.org>
CommitDate: Sun Jan 28 16:32:14 2024 +0100
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.
Signed-off-by: Mario Domenech Goulart <mario@parenteses.org>
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))
Trap