~ 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