From 9349c3a5cbcf1c7feb45efcbb498e67899a9643b Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Mon, 19 Nov 2007 13:34:24 -0500 Subject: [PATCH] Fixes bug 163681: Ikarus should have an IKARUS_LIBRARY_PATH --- scheme/ikarus.main.ss | 47 ++++++++++++++++++++++++++++++------------- 1 file changed, 33 insertions(+), 14 deletions(-) diff --git a/scheme/ikarus.main.ss b/scheme/ikarus.main.ss index 7de8da9..d98146a 100644 --- a/scheme/ikarus.main.ss +++ b/scheme/ikarus.main.ss @@ -18,16 +18,38 @@ ;;; this is here to test that we can import things from other ;;; libraries within the compiler itself. -(library (ikarus greeting) - (export print-greeting) +(library (ikarus startup) + (export print-greeting init-library-path) (import (ikarus)) - (letrec-syntax ([compile-time-string - (lambda (x) - (include "ikarus.config.ss") - ikarus-version)]) - (define (print-greeting) - (printf "Ikarus Scheme version ~a\n" (compile-time-string)) - (display "Copyright (c) 2006-2007 Abdulaziz Ghuloum\n\n")))) + (include "ikarus.config.ss") + + (define (print-greeting) + (printf "Ikarus Scheme version ~a\n" ikarus-version) + (display "Copyright (c) 2006-2007 Abdulaziz Ghuloum\n\n")) + + (define (init-library-path) + (define (split s) + (define (nodata i s ls) + (cond + [(= i (string-length s)) ls] + [(char=? (string-ref s i) #\:) (nodata (+ i 1) s ls)] + [else (data (+ i 1) s ls (list (string-ref s i)))])) + (define (data i s ls ac) + (cond + [(= i (string-length s)) + (cons (list->string (reverse ac)) ls)] + [(char=? (string-ref s i) #\:) + (nodata (+ i 1) s + (cons (list->string (reverse ac)) ls))] + [else (data (+ i 1) s ls (cons (string-ref s i) ac))])) + (reverse (nodata 0 s '()))) + (library-path + (cons "." + (append + (split (getenv "IKARUS_LIBRARY_PATH")) + (list ikarus-lib-dir))))) + + ) ;;; Finally, we're ready to evaluate the files and enter the cafe. @@ -35,12 +57,9 @@ (library (ikarus main) (export) (import (ikarus) - (ikarus greeting) + (ikarus startup) (only (ikarus load) load-r6rs-top-level)) - (library-path - (let () - (include "ikarus.config.ss") - (list "." ikarus-lib-dir))) + (init-library-path) (let-values ([(files script script-type args) (let f ([args (command-line-arguments)]) (cond