Issue #127 - Allow cond-expand to check for libs

This commit is contained in:
Justin Ethier 2016-10-25 17:09:33 -04:00
parent 3e134e939e
commit 46a4fa2d37
2 changed files with 43 additions and 43 deletions

View file

@ -5,8 +5,9 @@ TODO: SRFI 113
Features:
- Thanks to ecraven, added `exact-integer-sqrt`.
- Thanks to ecraven, added R7RS function `exact-integer-sqrt` to `(scheme base)`.
- Allow the reader to recognize `+inf.0`, `-inf.0`, `+nan.0`, and `-nan.0`.
- Allow `cond-expand` to test for whether a library exists using the form `(library {library name})`.
Bug Fixes

View file

@ -316,48 +316,47 @@
(er-macro-transformer
;; Based on the cond-expand macro from Chibi scheme
(lambda (expr rename compare)
;; TODO: port to this macro, so we can use below for library form
(define (_library-exists? import . ext)
(file-exists?
(_lib:import->filename
(_lib:import->library-name import)
(if (null? ext) ".sld" (car ext)))))
(define (_lib:import->filename import . ext)
(let* ((file-ext
(if (null? ext)
".sld"
(car ext)))
(filename*
(string-append
(apply
string-append
(map
(lambda (i)
(string-append
"/"
(cond
((symbol? i) (symbol->string i))
((number? i) (number->string i))
(else (error "Unexpected type in import set")))))
import))
file-ext))
(filename
(substring filename* 1 (string-length filename*))))
(if (or (equal? 'scheme (car import))
(equal? 'srfi (car import)))
(string-append (Cyc-installation-dir 'sld) "/" filename) ;; Built-in library
filename)))
(define (_lib:import->library-name import)
(cond
((and (pair? import)
(or (equal? 'only (car import))
(equal? 'except (car import))
(equal? 'prefix (car import))
(equal? 'rename (car import))))
(_lib:import->library-name
(cadr import)))
(else
import)))
(define (_library-exists? import . ext)
(file-exists?
(_lib:import->filename
(_lib:import->library-name import)
(if (null? ext) ".sld" (car ext)))))
(define (_lib:import->filename import . ext)
(let* ((file-ext
(if (null? ext)
".sld"
(car ext)))
(filename*
(string-append
(apply
string-append
(map
(lambda (i)
(string-append
"/"
(cond
((symbol? i) (symbol->string i))
((number? i) (number->string i))
(else (error "Unexpected type in import set")))))
import))
file-ext))
(filename
(substring filename* 1 (string-length filename*))))
(if (or (equal? 'scheme (car import))
(equal? 'srfi (car import)))
(string-append (Cyc-installation-dir 'sld) "/" filename) ;; Built-in library
filename)))
(define (_lib:import->library-name import)
(cond
((and (pair? import)
(or (equal? 'only (car import))
(equal? 'except (car import))
(equal? 'prefix (car import))
(equal? 'rename (car import))))
(_lib:import->library-name
(cadr import)))
(else
import)))
(define (check x)
(if (pair? x)
(case (car x)