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: 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 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 Bug Fixes

View file

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