From 40f033956a85859cc1c653da4a5d2dccc4740320 Mon Sep 17 00:00:00 2001 From: felix 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 - -(chicken-home) - -Returns a string which represents the installation directory (usually {{/usr/local/share/chicken}} on UNIX-like systems). - ==== chicken-version (chicken-version [FULL]) @@ -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 + +(include-path) + +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 repository-path 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