~ chicken-r7rs (master) 316b1dd06e4adca3bd4e9e69cae68abad29b3831

commit 316b1dd06e4adca3bd4e9e69cae68abad29b3831
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Jun 5 14:05:48 2013 +0000
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Wed Jun 5 14:05:48 2013 +0000

    Added import

diff --git a/NOTES.org b/NOTES.org
index d2b636f..9c26b49 100644
--- a/NOTES.org
+++ b/NOTES.org
@@ -8,3 +8,8 @@ NOTES
 
 * "export" does not support "(rename ...)" specifier yet.
   - this needs extensions to the core module system.
+
+* "(import SYMBOL)" is currently allowed. Should it not?
+
+* Redefinition of "import" causes "re-importing" warnings.
+  - The warnings could be removed in core, it's usefulness is not completely clear.
diff --git a/r7rs-compile-time.scm b/r7rs-compile-time.scm
index 229a7be..71253b9 100644
--- a/r7rs-compile-time.scm
+++ b/r7rs-compile-time.scm
@@ -54,12 +54,13 @@
 	   (loop more)))
       (else (fail "invalid \"cond-expand\" form")))))
 
-(define (fixup-import/export-spec spec loc)
+(define (fixup-import/export-spec spec loc) ; expects spec to be stripped
   (match spec
     (((and head (or 'only 'except 'rename 'prefix)) name . more)
      (cons* head (fixup-import/export-spec name loc) more))
     ((name ...)
      (parse-library-name name loc))
+    ((? symbol? spec) spec)
     (_ (syntax-error loc "invalid import/export specifier" spec))))
 
 (define (current-source-filename)
diff --git a/r7rs.scm b/r7rs.scm
index 9d731bb..980f23b 100644
--- a/r7rs.scm
+++ b/r7rs.scm
@@ -10,26 +10,22 @@
    (require-library r7rs-compile-time numbers))
   (import-for-syntax r7rs-compile-time matchable)
 
-(use srfi-13)				;XXX get rid of this! (used for "string-downcase"?)
-
 (require-library scheme.base)
 
-(define (read-asserted-ci-symbol port valid-symbols error-message)
-  (let ((sym (##sys#read port ##sys#default-read-info-hook)))
-    (or (and (symbol? sym)
-             (memq (string->symbol (string-downcase (symbol->string sym))) valid-symbols))
-        (##sys#read-error port error-message sym))))
-
 (let ((old-hook ##sys#user-read-hook))
   (set! ##sys#user-read-hook
         (lambda (char port)
+	  (define (fail tok)
+	    (##sys#read-error port "invalid boolean literal syntax" tok))
           (case char
-            ((#\f #\F)
-             (read-asserted-ci-symbol port '(f false) "invalid `false' read syntax")
-             #f)
-            ((#\t #\T)
-             (read-asserted-ci-symbol port '(t true) "invalid `true' read syntax")
-             #t)
+            ((#\f #\F #\t #\T)
+	     (let ((sym (##sys#read port ##sys#default-read-info-hook)))
+	       (if (not (symbol? sym))
+		   (fail sym)
+		   (let ((str (symbol->string sym)))
+		     (cond ((or (string-ci=? "t" str) (string-ci=? "true" str)) #t)
+			   ((or (string-ci=? "f" str) (string-ci=? "false" str)) #f)
+			   (else (fail sym)))))))
             (else (old-hook char port))))))
 
 ;;;
diff --git a/scheme.base-interface.scm b/scheme.base-interface.scm
index 91c0c0b..c395ea0 100644
--- a/scheme.base-interface.scm
+++ b/scheme.base-interface.scm
@@ -72,7 +72,9 @@
   guard
   #|
   if
+  |#
   import
+  #|
   ;; import-for-syntax   XXX should we?
   include include-ci
   input-port-open? output-port-open?
diff --git a/scheme.base.scm b/scheme.base.scm
index 1e03416..8037b83 100644
--- a/scheme.base.scm
+++ b/scheme.base.scm
@@ -9,6 +9,19 @@
 (import-for-syntax r7rs-compile-time)
 
 
+(define-syntax import
+  (er-macro-transformer
+   (lambda (x r c)
+     (##sys#expand-import 
+      (cons (car x)
+	    (map (lambda (spec)
+		   (fixup-import/export-spec (strip-syntax spec) 'import))
+		 (cdr x)))
+      r c
+      ##sys#current-environment ##sys#macro-environment
+      #f #f 'import) ) ) )
+
+
 ;;;
 ;;; 4.2.1. Conditionals
 ;;;