Allow importing (cyclone ...) libraries from a relative path

This commit is contained in:
Justin Ethier 2017-12-26 18:08:31 -05:00
parent 9c9bc42236
commit 5e3244fa9d

View file

@ -15,6 +15,7 @@
;;;; ;;;;
(define-library (scheme cyclone libraries) (define-library (scheme cyclone libraries)
(import (scheme base) (import (scheme base)
;; Debugging: (scheme write)
(scheme read) (scheme read)
(scheme process-context) (scheme process-context)
(scheme cyclone util) (scheme cyclone util)
@ -273,8 +274,8 @@
(dir (if (or (tagged-list? 'scheme import) (dir (if (or (tagged-list? 'scheme import)
(tagged-list? 'srfi import) (tagged-list? 'srfi import)
(tagged-list? 'cyclone import)) (tagged-list? 'cyclone import))
(Cyc-installation-dir 'sld) (list (Cyc-installation-dir 'sld) "./")
"./"))) (list "./"))))
(call/cc (call/cc
(lambda (return) (lambda (return)
(for-each (for-each
@ -282,11 +283,11 @@
(let ((f (string-append path "/" filename))) (let ((f (string-append path "/" filename)))
(if (file-exists? f) (if (file-exists? f)
(return f)))) (return f))))
(append prepend-dirs (list dir) append-dirs)) (append prepend-dirs dir append-dirs))
;; Not found, just return base name ;; Not found, just return base name
(lib:check-system-path (lib:check-system-path
(if (> (string-length dir) 0) (if (> (length dir) 0)
(string-append dir "/" filename) (string-append (car dir) "/" filename)
filename)))) filename))))
)) ))
@ -306,20 +307,22 @@
;(tagged-list? 'srfi import) ;(tagged-list? 'srfi import)
(tagged-list? 'cyclone import) (tagged-list? 'cyclone import)
) )
(Cyc-installation-dir 'sld) (list (Cyc-installation-dir 'sld) "./")
""))) (list "./"))))
(call/cc (call/cc
(lambda (return) (lambda (return)
(for-each (for-each
(lambda (path) (lambda (path)
(let ((f (string-append path "/" filename))) (let ((f (string-append path "/" filename)))
;(write `(DEBUG ,path ,f ,(file-exists? f)))
;(newline)
(if (file-exists? f) (if (file-exists? f)
(return f)))) (return f))))
(append prepend-dirs (list dir) append-dirs)) (append prepend-dirs dir append-dirs))
;; Not found, just return base name ;; Not found, just return base name
(lib:check-system-path (lib:check-system-path
(if (> (string-length dir) 0) (if (> (string-length (car dir)) 0)
(string-append dir "/" filename) (string-append (car dir) "/" filename)
filename)))) filename))))
;(if (tagged-list? 'scheme import) ;(if (tagged-list? 'scheme import)
; (string-append (Cyc-installation-dir 'sld) "/" path) ;; Built-in library ; (string-append (Cyc-installation-dir 'sld) "/" path) ;; Built-in library