Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-13 07:47:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP for cond-expand library form

Browse source
This commit is contained in:
Justin Ethier 2016-10-24 09:36:42 +00:00
parent 0feb1b1054
commit 3e134e939e
1 changed files with 42 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
scheme/base.sld
View file

@ -317,48 +317,54 @@
;; 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 ;; 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 "/" (lib:atom->string i))) (string-append
; import)) "/"
; file-ext)) (cond
; (filename ((symbol? i) (symbol->string i))
; (substring filename* 1 (string-length filename*)))) ((number? i) (number->string i))
; (if (or (tagged-list? 'scheme import) (else (error "Unexpected type in import set")))))
; (tagged-list? 'srfi import)) import))
; (string-append (Cyc-installation-dir 'sld) "/" filename) ;; Built-in library file-ext))
; filename))) (filename
;(define (lib:import->library-name import) (substring filename* 1 (string-length filename*))))
; (cond (if (or (equal? 'scheme (car import))
; ((or (tagged-list? 'only import) (equal? 'srfi (car import)))
; (tagged-list? 'except import) (string-append (Cyc-installation-dir 'sld) "/" filename) ;; Built-in library
; (tagged-list? 'prefix import) filename)))
; (tagged-list? 'rename import)) (define (_lib:import->library-name import)
; (lib:import->library-name (cond
; (cadr import))) ((and (pair? import)
; (else (or (equal? 'only (car import))
; import))) (equal? 'except (car import))
(equal? 'prefix (car import))
(equal? 'rename (car import))))
(_lib:import->library-name
(cadr import)))
(else
import)))
(define (check x) (define (check x)
(if (pair? x) (if (pair? x)
(case (car x) (case (car x)
((and) (every check (cdr x))) ((and) (every check (cdr x)))
((or) (any check (cdr x))) ((or) (any check (cdr x)))
((not) (not (check (cadr x)))) ((not) (not (check (cadr x))))
;((library) (eval `(find-module ',(cadr x)) (%meta-env))) ((library) (_library-exists? (cadr x))) ;(eval `(find-module ',(cadr x)) (%meta-env)))
(else (error "cond-expand: bad feature" x))) (else (error "cond-expand: bad feature" x)))
(memq x (features)))) (memq x (features))))
(let expand ((ls (cdr expr))) (let expand ((ls (cdr expr)))