conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fixes bug 163681: Ikarus should have an IKARUS_LIBRARY_PATH

This commit is contained in:
Abdulaziz Ghuloum 2007-11-19 13:34:24 -05:00
parent 25555d7ff6
commit 9349c3a5cb
1 changed files with 33 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
scheme/ikarus.main.ss
View File

@ -18,16 +18,38 @@
;;; this is here to test that we can import things from other ;;; this is here to test that we can import things from other
;;; libraries within the compiler itself. ;;; libraries within the compiler itself.
(library (ikarus greeting) (library (ikarus startup)
(export print-greeting) (export print-greeting init-library-path)
(import (ikarus)) (import (ikarus))
(letrec-syntax ([compile-time-string
(lambda (x)
(include "ikarus.config.ss") (include "ikarus.config.ss")
ikarus-version)])
(define (print-greeting) (define (print-greeting)
(printf "Ikarus Scheme version ~a\n" (compile-time-string)) (printf "Ikarus Scheme version ~a\n" ikarus-version)
(display "Copyright (c) 2006-2007 Abdulaziz Ghuloum\n\n")))) (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. ;;; Finally, we're ready to evaluate the files and enter the cafe.
@ -35,12 +57,9 @@
(library (ikarus main) (library (ikarus main)
(export) (export)
(import (ikarus) (import (ikarus)
(ikarus greeting) (ikarus startup)
(only (ikarus load) load-r6rs-top-level)) (only (ikarus load) load-r6rs-top-level))
(library-path (init-library-path)
(let ()
(include "ikarus.config.ss")
(list "." ikarus-lib-dir)))
(let-values ([(files script script-type args) (let-values ([(files script script-type args)
(let f ([args (command-line-arguments)]) (let f ([args (command-line-arguments)])
(cond (cond