Move features to a function in the base library.

This commit is contained in:
Justin Ethier 2015-07-30 22:36:13 -04:00
parent 22a563afba
commit a708a168dc
4 changed files with 6 additions and 7 deletions

View file

@ -78,8 +78,12 @@
newline newline
write-char write-char
flush-output-port flush-output-port
features
) )
(begin (begin
;; Features implemented by this Scheme
(define (features) '(cyclone))
;; TODO: The whitespace characters are space, tab, line feed, form feed (not in parser yet), and carriage return. ;; TODO: The whitespace characters are space, tab, line feed, form feed (not in parser yet), and carriage return.
(define call-with-current-continuation call/cc) (define call-with-current-continuation call/cc)
;; TODO: this is from r7rs, but is not really good enough by itself ;; TODO: this is from r7rs, but is not really good enough by itself

View file

@ -29,7 +29,3 @@
** **
**/ **/
")) "))
;; Features implemented by this Scheme
(define *features* '(cyclone))

View file

@ -3,8 +3,7 @@
*Cyc-version-banner* *Cyc-version-banner*
*version* *version*
*version-banner* *version-banner*
*c-file-header-comment* *c-file-header-comment*)
*features*)
(include "common.scm") (include "common.scm")
(begin (begin
(define *Cyc-version-banner* *version-banner*))) (define *Cyc-version-banner* *version-banner*)))

View file

@ -141,7 +141,7 @@
((not) (not (check (cadr x)))) ((not) (not (check (cadr x))))
;((library) (eval `(find-module ',(cadr x)) (%meta-env))) ;((library) (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)))
(cond ((null? ls)) ; (error "cond-expand: no expansions" expr) (cond ((null? ls)) ; (error "cond-expand: no expansions" expr)
((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls))) ((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls)))