From a708a168dc3028c6d34c9c447b641f1c80cc5ca2 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 30 Jul 2015 22:36:13 -0400
Subject: [PATCH] Move features to a function in the base library.

---
 scheme/base.sld               | 4 ++++
 scheme/cyclone/common.scm     | 4 ----
 scheme/cyclone/common.sld     | 3 +--
 scheme/cyclone/transforms.scm | 2 +-
 4 files changed, 6 insertions(+), 7 deletions(-)

diff --git a/scheme/base.sld b/scheme/base.sld
index 84733470..fde6b29e 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -78,8 +78,12 @@
     newline
     write-char
     flush-output-port
+    features
   )
   (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.
     (define call-with-current-continuation call/cc)
     ;; TODO: this is from r7rs, but is not really good enough by itself
diff --git a/scheme/cyclone/common.scm b/scheme/cyclone/common.scm
index 7ccdcbc7..bb85f9fe 100644
--- a/scheme/cyclone/common.scm
+++ b/scheme/cyclone/common.scm
@@ -29,7 +29,3 @@
  **
  **/
 "))
-
-;; Features implemented by this Scheme
-(define *features* '(cyclone))
-
diff --git a/scheme/cyclone/common.sld b/scheme/cyclone/common.sld
index 93731176..973ed018 100644
--- a/scheme/cyclone/common.sld
+++ b/scheme/cyclone/common.sld
@@ -3,8 +3,7 @@
     *Cyc-version-banner*
     *version*
     *version-banner*
-    *c-file-header-comment* 
-    *features*)
+    *c-file-header-comment*)
   (include "common.scm")
   (begin
     (define *Cyc-version-banner* *version-banner*)))
diff --git a/scheme/cyclone/transforms.scm b/scheme/cyclone/transforms.scm
index 5062142b..0a3df925 100644
--- a/scheme/cyclone/transforms.scm
+++ b/scheme/cyclone/transforms.scm
@@ -141,7 +141,7 @@
                 ((not) (not (check (cadr x))))
                 ;((library) (eval `(find-module ',(cadr x)) (%meta-env)))
                 (else (error "cond-expand: bad feature" x)))
-              (memq x *features*)))
+              (memq x (features))))
         (let expand ((ls (cdr expr)))
           (cond ((null? ls))  ; (error "cond-expand: no expansions" expr)
                 ((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls)))