~ 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.scmTrap