~ chicken-core (chicken-5) 3a4c31fa51d83469c0791e65f157a9f720fe4d03
commit 3a4c31fa51d83469c0791e65f157a9f720fe4d03
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Thu Oct 1 12:25:50 2015 +1300
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Mon Nov 2 21:29:01 2015 +0100
Move library list-related utilities into new chicken.core module
diff --git a/eval.scm b/eval.scm
index 3d2742a6..bf3c5d2a 100644
--- a/eval.scm
+++ b/eval.scm
@@ -48,6 +48,32 @@
#define C_rnd_fix() (C_fix(rand()))
<#
+;;; Runtime support module
+
+(module chicken.core (srfi-id library-id)
+
+(import scheme chicken)
+
+;; 1 => srfi-1
+(define (srfi-id n)
+ (if (fixnum? n)
+ (##sys#intern-symbol
+ (##sys#string-append "srfi-" (##sys#number->string n)))
+ (##sys#syntax-error-hook 'require-extension "invalid SRFI number" n)))
+
+;; (foo bar baz) => foo.bar.baz
+(define (library-id lib)
+ (define (library-part->string id)
+ (cond ((symbol? id) (##sys#symbol->string id))
+ ((number? id) (##sys#number->string id))
+ (else (##sys#error "invalid extension specifier" lib))))
+ (do ((lib (cdr lib) (cdr lib))
+ (str (library-part->string (car lib))
+ (string-append str "." (library-part->string (car lib)))))
+ ((null? lib) (##sys#intern-symbol str))))
+
+) ; chicken.core
+
(module chicken.eval
(chicken-home define-reader-ctor dynamic-load-libraries
eval eval-handler extension-information
@@ -60,7 +86,8 @@
(import (except scheme eval load interaction-environment null-environment scheme-report-environment))
(import chicken)
-(import chicken.expand
+(import chicken.core
+ chicken.expand
chicken.foreign)
(include "common-declarations.scm")
@@ -1294,24 +1321,6 @@
'() )
(loop1 (cdr ids)) ) ) ) ) ) )
-;; 1 => srfi-1
-(define (##sys#srfi-id n)
- (if (fixnum? n)
- (##sys#intern-symbol
- (##sys#string-append "srfi-" (##sys#number->string n)))
- (##sys#syntax-error-hook 'require-extension "invalid SRFI number" n)))
-
-;; (foo bar baz) => foo.bar.baz
-(define (##sys#library-id lib)
- (define (library-part->string id)
- (cond ((symbol? id) (##sys#symbol->string id))
- ((number? id) (##sys#number->string id))
- ((##sys#error "invalid extension specifier" lib))))
- (do ((lib (cdr lib) (cdr lib))
- (str (library-part->string (car lib))
- (string-append str "." (library-part->string (car lib)))))
- ((null? lib) (##sys#intern-symbol str))))
-
(define ##sys#do-the-right-thing
(let ((vector->list vector->list))
(lambda (id comp? imp? #!optional (add-req void))
@@ -1393,7 +1402,7 @@
(exp
`(##core#begin
,@(map (lambda (n)
- (let ((rid (##sys#srfi-id n)))
+ (let ((rid (srfi-id n)))
(let-values (((exp f2 _) (doit rid)))
(set! f (or f f2))
exp)))
@@ -1403,15 +1412,15 @@
(let follow ((id2 id))
(if (and (pair? id2) (pair? (cdr id2)))
(if (and (eq? 'srfi (car id2)) (null? (cddr id2))) ; only allow one number
- (doit (##sys#srfi-id (cadr id2)) id)
+ (doit (srfi-id (cadr id2)) id)
(follow (cadr id2)))
(doit id2 id))))
((chicken)
(if (memq (cadr id) ##sys#core-chicken-modules)
- (doit (cadr id) (##sys#library-id id))
- (doit (##sys#library-id id))))
+ (doit (cadr id) (library-id id))
+ (doit (library-id id))))
(else
- (doit (##sys#library-id id)))))
+ (doit (library-id id)))))
((symbol? id)
(doit id))
(else
diff --git a/modules.scm b/modules.scm
index 9b5cdaf9..9e662f5a 100644
--- a/modules.scm
+++ b/modules.scm
@@ -604,7 +604,7 @@
(cond ((symbol? spec) (import-name spec))
((null? (cdr spec)) (import-name (car spec))) ; single library component
((and (c %srfi (car spec)) (fixnum? (cadr spec)) (null? (cddr spec))) ; only one number
- (import-name (##sys#srfi-id (cadr spec))))
+ (import-name (chicken.core#srfi-id (cadr spec))))
(else
(let ((head (car spec))
(imports (cddr spec)))
@@ -684,7 +684,7 @@
(cdr imp) ) )
(values name `(,head ,form ,pref) (map ren impv) (map ren imps) impi)))
(else
- (import-name (##sys#library-id spec)))))))))
+ (import-name (chicken.core#library-id spec)))))))))
(##sys#check-syntax loc x '(_ . #(_ 1)))
(let ((cm (##sys#current-module)))
(for-each
diff --git a/rules.make b/rules.make
index 5d36a538..ffd3bfe6 100644
--- a/rules.make
+++ b/rules.make
@@ -692,7 +692,7 @@ bootstrap-lib = $(CHICKEN) $(call profile-flags, $@) $< $(CHICKEN_LIBRARY_OPTION
library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib)
eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm
- $(bootstrap-lib) -emit-import-library chicken.eval
+ $(bootstrap-lib) -emit-import-library chicken.eval -emit-import-library chicken.core
expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.expand
modules.c: $(SRCDIR)modules.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm
Trap