Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-20 06:09:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add dir options to (lib:import->filename)

Browse source
This commit is contained in:
Justin Ethier 2017-01-31 17:51:37 -05:00
parent 7b927d8b35
commit bda80e8856
1 changed files with 33 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
scheme/cyclone/libraries.sld
View file

@ -187,12 +187,23 @@
(error "Unexpected type in import set")))) (error "Unexpected type in import set"))))
;; Resolve library filename given an import. ;; Resolve library filename given an import.
;; Assumes ".sld" file extension if one is not specified. ;; Options:
(define (lib:import->filename import . ext) ;; - Extension, assumes ".sld" file extension if one is not specified.
;; - Append path, list of strings
;; - Prepend path, list of strings
(define (lib:import->filename import . opts)
(let* ((file-ext (let* ((file-ext
(if (null? ext) (if (null? opts)
".sld" ".sld"
(car ext))) (car opts)))
(append-dirs
(if (or (null? opts) (null? (cdr opts)))
'()
(cadr opts)))
(prepend-dirs
(if (or (null? opts) (null? (cdr opts)) (null? (cddr opts)))
'()
(caddr opts)))
(filename* (filename*
(string-append (string-append
(apply (apply
@ -203,11 +214,24 @@
import)) import))
file-ext)) file-ext))
(filename (filename
(substring filename* 1 (string-length filename*)))) (substring filename* 1 (string-length filename*)))
(if (or (tagged-list? 'scheme import) (dir (if (or (tagged-list? 'scheme import)
(tagged-list? 'srfi import)) (tagged-list? 'srfi import))
(string-append (Cyc-installation-dir 'sld) "/" filename) ;; Built-in library (Cyc-installation-dir 'sld)
filename))) "")))
(call/cc
(lambda (return)
(for-each
(lambda (path)
(let ((f (string-append path "/" filename)))
(if (file-exists? f)
(return f))))
(append prepend-dirs (list dir) append-dirs))
;; Not found, just return base name
(if (> (string-length dir) 0)
(string-append dir "/" filename)
filename)))
))
;; Get path to directory that contains the library ;; Get path to directory that contains the library
(define (lib:import->path import) (define (lib:import->path import)