~ 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