~ chicken-core (chicken-5) 9b6954edd159a6b4613b3a4e379b7c17f364a617


commit 9b6954edd159a6b4613b3a4e379b7c17f364a617
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Wed Jan 27 22:43:38 2016 +1300
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300

    Add modules for some built-in SRFIs
    
    Define modules for built-in SRFIs (either as aliases or as primitive
    modules with only a few exports) for so that "(import (srfi n))" always
    has the desired effect.

diff --git a/eval.scm b/eval.scm
index 5b55338f..42b14d75 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1289,10 +1289,10 @@
 ;;
 (define (##sys#expand-require lib #!optional compiling? (static-units '()))
   (let ((id (library-id lib)))
+  (let loop ((id (library-id lib)))
     (cond
       ((assq id core-chicken-modules) =>
-       (lambda (mod)
-	 (##sys#expand-require (cdr mod) compiling? static-units)))
+       (lambda (mod) (loop (cdr mod))))
       ((or (memq id builtin-features)
 	   (and compiling? (memq id builtin-features/compiled)))
        (values '(##core#undefined) id #f))
diff --git a/modules.scm b/modules.scm
index d850756f..1271fb74 100644
--- a/modules.scm
+++ b/modules.scm
@@ -51,6 +51,9 @@
 	 (cons (car a) (if (symbol? (cdr a)) (cdr a) '<macro>)))
        se))
 
+(define-inline (se-subset names env)
+  (map (cut assq <> env) names))
+
 (define-inline (getp sym prop)
   (##core#inline "C_i_getprop" sym prop #f))
 
@@ -396,10 +399,10 @@
     (putp palias '##core#primitive sym)
     palias))
 
-(define (##sys#register-primitive-module name vexports #!optional (sexports '()))
+(define (##sys#register-core-module name lib vexports #!optional (sexports '()))
   (let* ((me (##sys#macro-environment))
 	 (mod (make-module
-	       name name '()
+	       name lib '()
 	       (map (lambda (ve)
 		      (if (symbol? ve)
 			  (cons ve (##sys#primitive-alias ve))
@@ -423,6 +426,10 @@
     (set! ##sys#module-table (cons (cons name mod) ##sys#module-table)) 
     mod))
 
+;; same as register-builtin, but uses module's name as its library
+(define (##sys#register-primitive-module name vexports #!optional (sexports '()))
+  (##sys#register-core-module name name vexports sexports))
+
 (define (find-export sym mod indirect)
   (let ((exports (module-export-list mod)))
     (let loop ((xl (if (eq? #t exports) (module-exist-list mod) exports)))
@@ -933,6 +940,7 @@
   (##sys#register-primitive-module 'r5rs-null '() r4rs-syntax))
 
 (##sys#register-module-alias 'r5rs 'scheme)
+(##sys#register-module-alias 'srfi-88 'chicken.keyword)
 
 ;; NOTE these are just here for shorthand and can be dropped whenever
 (##sys#register-module-alias 'bitwise 'chicken.bitwise)
@@ -959,6 +967,30 @@
 (##sys#register-module-alias 'time 'chicken.time)
 (##sys#register-module-alias 'utils 'chicken.utils)
 
+;; built-in SRFIs
+;; todo 2 8 9 11 12 15 16 28 39 8 9 11 15 16 17 26 31
+;; noop 46 61 62
+
+(##sys#register-primitive-module
+ 'srfi-0 '() (se-subset '(cond-expand) ##sys#default-macro-environment))
+
+(##sys#register-primitive-module
+ 'srfi-6 '(open-input-string open-output-string get-output-string))
+
+(##sys#register-primitive-module
+ 'srfi-10 '((define-reader-ctor . chicken.read-syntax#define-reader-ctor)))
+
+(##sys#register-primitive-module
+ 'srfi-23 '(error))
+
+(##sys#register-primitive-module
+ 'srfi-55 '() (se-subset '(require-extension) ##sys#default-macro-environment))
+
+(##sys#register-core-module
+ 'srfi-98 'posix
+ '(get-environment-variable
+   (get-environment-variables . chicken.posix#get-environment-variables)))
+
 (register-feature! 'module-environments)
 
 (define (module-environment mname #!optional (ename mname))
Trap