~ 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