Hi all, The attached set of patches will finish up the (chicken eval) module, as defined by http://wiki.call-cc.org/core-libraries-reorganization It was missing the "module-environment" definition, which lives in modules.scm.
To untangle the hidden dependencies a bit, I decided to make modules.scm into a module. For lack of a better name, I chose chicken.internal.module but we can decide to rename it if necessary. It is emphatically _not_ named chicken.module, because that will contain the user-visible stuff like "import", "export", "use", "functor" etc (though it's still marked as "undecided"), while this stuff is all very much internal and should never be relied on to be stable. Simply wrapping modules.scm in a module declaration already found one small bug: In "iface" in "##sys#validate-exports", "x" is undefined. This shows the usefulness of using modules for core; this error went undetected for many years. Aside from all that, I also tried to reduce the chumminess between expand.scm/chicken-syntax.scm and modules.scm; it turns out that there is no need for those to refer to ##sys#current-module, which is again very much an internal detail, and it's much clearer to see which module an expansion refers to rather than just "##sys#something". This patch set is not 100% complete, but we can finish up later. core.scm, eval.scm, csi.scm and chicken-install.scm still contain several ##sys# references to things from modules.scm. Some may be hidden, some may be moved around, but this will cause too many swooping changes. I think the current patch set is quite a big win in clarity already. Cheers, Peter
From 287890dce70b3b851352cda1272383f5f461d6d0 Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Sun, 2 Apr 2017 18:47:44 +0200 Subject: [PATCH 1/4] Add chicken.internal.module, move module-environment to chicken.eval This contains the stuff from the "modules" unit. The "internal" namespace is used to declare that these _really_ shouldn't be used in user programs, much like the stuff in the "chicken.internal" module. This allows us to move "module-environment" from modules.scm to eval.scm, finalizing the chicken.eval module as defined by the CHICKEN 5 reorganisation roadmap. This also removes a few bogus (declare (not inline ...)) entries from eval.scm, those were undefined or defined elsewhere. Maybe later, the definitions from modules.scm could be moved elsewhere, for example some parts could go into eval.scm and others into internal.scm --- README | 1 + chicken-install.scm | 1 + chicken.import.scm | 2 +- defaults.make | 7 +++--- distribution/manifest | 2 ++ eval.scm | 22 ++++++++++++++----- modules.scm | 61 ++++++++++++++++++++------------------------------- rules.make | 4 +++- tests/runtests.sh | 1 + types.db | 2 +- 10 files changed, 55 insertions(+), 48 deletions(-) diff --git a/README b/README index 9d1c137..a6be478 100644 --- a/README +++ b/README @@ -291,6 +291,7 @@ | | |-- chicken.format.import.so | | |-- chicken.gc.import.so | | |-- chicken.internal.import.so + | | |-- chicken.internal.module.import.so | | |-- chicken.io.import.so | | |-- chicken.irregex.import.so | | |-- chicken.keyword.import.so diff --git a/chicken-install.scm b/chicken-install.scm index cad0b00..93aea83 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -61,6 +61,7 @@ "chicken.gc.import.so" "chicken.import.so" "chicken.internal.import.so" + "chicken.internal.module.import.so" "chicken.io.import.so" "chicken.irregex.import.so" "chicken.keyword.import.so" diff --git a/chicken.import.scm b/chicken.import.scm index befdca7..ca439fc 100644 --- a/chicken.import.scm +++ b/chicken.import.scm @@ -129,7 +129,7 @@ make-parameter make-promise make-property-condition - module-environment + (module-environment . chicken.eval#module-environment) (most-negative-fixnum . chicken.fixnum#most-negative-fixnum) (most-positive-fixnum . chicken.fixnum#most-positive-fixnum) nan? diff --git a/defaults.make b/defaults.make index 37f69a3..519c0f9 100644 --- a/defaults.make +++ b/defaults.make @@ -265,9 +265,10 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile) PRIMITIVE_IMPORT_LIBRARIES = chicken chicken.csi chicken.foreign DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4 -DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise errno file.posix fixnum flonum \ - format gc io keyword locative memory posix pretty-print process \ - process.signal process-context random time time.posix +DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise errno file.posix fixnum \ + flonum format gc internal.module io keyword locative memory \ + posix pretty-print process process.signal process-context \ + random time time.posix DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \ eval expand file files internal irregex lolevel pathname port \ diff --git a/distribution/manifest b/distribution/manifest index 43d058a..1db9e71 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -296,6 +296,8 @@ chicken.gc.import.scm chicken.gc.import.c chicken.internal.import.scm chicken.internal.import.c +chicken.internal.module.import.scm +chicken.internal.module.import.c chicken.io.import.scm chicken.io.import.c chicken.irregex.import.scm diff --git a/eval.scm b/eval.scm index 72977a8..215afef 100644 --- a/eval.scm +++ b/eval.scm @@ -27,8 +27,7 @@ (declare (unit eval) - (uses chicken-syntax expand internal modules) - (not inline ##sys#alias-global-hook ##sys#user-read-hook ##sys#syntax-error-hook)) + (uses chicken-syntax expand internal modules)) #> #ifndef C_INSTALL_EGG_HOME @@ -50,17 +49,22 @@ (chicken-home dynamic-load-libraries eval eval-handler extension-information load load-library load-noisily load-relative load-verbose - interaction-environment null-environment scheme-report-environment load-extension provide provided? repository-path - require set-dynamic-load-mode!) + require set-dynamic-load-mode! + + ;; environments + interaction-environment module-environment null-environment + scheme-report-environment) ;; Exclude bindings defined within this module. (import (except scheme eval load interaction-environment null-environment scheme-report-environment) - (except chicken chicken-home provide provided? repository-path require)) + (except chicken chicken-home provide provided? repository-path + require module-environment)) (import chicken.expand chicken.foreign chicken.internal + chicken.internal.module chicken.keyword) (include "common-declarations.scm") @@ -1326,6 +1330,14 @@ ;;; Environments: +(define (module-environment mname #!optional (ename mname)) + (let ((mod (find-module/import-library mname 'module-environment))) + (if (not mod) + (##sys#syntax-error-hook + 'module-environment "undefined module" mname) + (##sys#make-structure + 'environment ename (car (module-saved-environments mod)) #t)))) + (define interaction-environment (let ((e (##sys#make-structure 'environment 'interaction-environment #f #f))) (lambda () e))) diff --git a/modules.scm b/modules.scm index 91099db..ff30e93 100644 --- a/modules.scm +++ b/modules.scm @@ -24,25 +24,35 @@ ; POSSIBILITY OF SUCH DAMAGE. +;; this unit needs the "eval" unit, but must be initialized first (as +;; eval uses modules quite extensively), so it doesn't declare "eval" +;; as used - if you use "-explicit-use", take care of this. + (declare (unit modules) - (uses eval expand internal) + (uses expand internal) (disable-interrupts) (fixnum) - (not inline ##sys#alias-global-hook) - (hide check-for-redef find-export find-module/import-library - mark-imported-symbols match-functor-argument merge-se - module-indirect-exports module-rename register-undefined)) - + (not inline ##sys#alias-global-hook)) + +(module chicken.internal.module + (find-module/import-library module-saved-environments) + +(import scheme + (only chicken + cut declare define-inline define-record-type error include + parameterize make-parameter when unless and-let* void + let-values fluid-let get-output-string open-output-string) + chicken.fixnum + chicken.expand + chicken.internal + chicken.keyword) + (include "common-declarations.scm") (include "mini-srfi-1.scm") (define-syntax d (syntax-rules () ((_ . _) (void)))) -(import chicken.expand - chicken.internal - chicken.keyword) - (define-alias dd d) (define-alias dm d) (define-alias dx d) @@ -67,21 +77,6 @@ (define ##sys#current-module (make-parameter #f)) (define ##sys#module-alias-environment (make-parameter '())) -(declare - (hide make-module module? %make-module - module-name module-library - module-vexports module-sexports - set-module-vexports! set-module-sexports! - module-export-list set-module-export-list! - module-defined-list set-module-defined-list! - module-import-forms set-module-import-forms! - module-meta-import-forms set-module-meta-import-forms! - module-exist-list set-module-exist-list! - module-meta-expressions set-module-meta-expressions! - module-defined-syntax-list set-module-defined-syntax-list! - module-saved-environments set-module-saved-environments! - module-iexports set-module-iexports!)) - (define-record-type module (%make-module name library export-list defined-list exist-list defined-syntax-list undefined-list import-forms meta-import-forms meta-expressions @@ -418,7 +413,7 @@ (set! ##sys#module-table (cons (cons name mod) ##sys#module-table)) mod)) -;; same as register-builtin, but uses module's name as its library +;; same as register-core-module, 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)) @@ -568,7 +563,7 @@ (##sys#macro-environment (##sys#meta-macro-environment))) (fluid-let ((##sys#notices-enabled #f)) ; to avoid re-import warnings - (chicken.eval#load il) + (chicken.eval#load il) ; TODO: This is a cyclic dependency (set! mod (##sys#find-module mname 'import)))))) mod)) @@ -791,7 +786,7 @@ (apply ##sys#syntax-error-hook loc args)) (define (iface name) (or (getp name '##core#interface) - (err "unknown interface" x exps))) + (err "unknown interface" name exps))) (cond ((eq? '* exps) exps) ((symbol? exps) (iface exps)) ((not (list? exps)) @@ -1036,12 +1031,4 @@ '(get-environment-variable (get-environment-variables . chicken.posix#get-environment-variables))) -(register-feature! 'module-environments) - -(define (module-environment mname #!optional (ename mname)) - (let ((mod (find-module/import-library mname 'module-environment))) - (if (not mod) - (##sys#syntax-error-hook - 'module-environment "undefined module" mname) - (##sys#make-structure - 'environment ename (car (module-saved-environments mod)) #t)))) +) diff --git a/rules.make b/rules.make index acd8bf3..61d7b2f 100644 --- a/rules.make +++ b/rules.make @@ -536,6 +536,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.pretty-print,extras) $(eval $(call declare-emitted-import-lib-dependency,chicken.random,extras)) $(eval $(call declare-emitted-import-lib-dependency,chicken.locative,lolevel)) $(eval $(call declare-emitted-import-lib-dependency,chicken.memory,lolevel)) +$(eval $(call declare-emitted-import-lib-dependency,chicken.internal.module,modules)) chicken.c: chicken.scm mini-srfi-1.scm \ chicken.compiler.batch-driver.import.scm \ @@ -742,6 +743,7 @@ eval.c: eval.scm \ chicken.expand.import.scm \ chicken.foreign.import.scm \ chicken.internal.import.scm \ + chicken.internal.module.import.scm \ chicken.keyword.import.scm repl.c: repl.scm \ chicken.eval.import.scm @@ -791,7 +793,7 @@ repl.c: $(SRCDIR)repl.scm $(SRCDIR)common-declarations.scm 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 - $(bootstrap-lib) + $(bootstrap-lib) -emit-import-library chicken.internal.module extras.c: $(SRCDIR)extras.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) \ -emit-import-library chicken.format \ diff --git a/tests/runtests.sh b/tests/runtests.sh index 74e7ecf..f09bc6c 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -49,6 +49,7 @@ for x in \ chicken.format.import.so \ chicken.gc.import.so \ chicken.internal.import.so \ + chicken.internal.module.import.so \ chicken.io.import.so \ chicken.irregex.import.so \ chicken.keyword.import.so \ diff --git a/types.db b/types.db index ea181e9..b53bdc2 100644 --- a/types.db +++ b/types.db @@ -859,6 +859,7 @@ (chicken.eval#load-library (#(procedure #:enforce) chicken.eval#load-library (symbol #!optional string) undefined)) (chicken.eval#load-relative (#(procedure #:enforce) chicken.eval#load-relative (string #!optional (procedure (*) . *)) undefined)) (chicken.eval#load-verbose (#(procedure #:clean) chicken.eval#load-verbose (#!optional *) *)) +(chicken.eval#module-environment (#(procedure #:clean #:enforce) module-environment ((or symbol (list-of (or symbol fixnum))) #!optional *) (struct environment))) (chicken.eval#provide (#(procedure #:clean #:enforce) chicken.eval#provide (#!rest symbol) undefined)) (chicken.eval#provided? (#(procedure #:clean #:enforce) chicken.eval#provided? (#!rest symbol) boolean)) (chicken.eval#repository-path (#(procedure #:clean) chicken.eval#repository-path (#!optional *) *)) @@ -1248,7 +1249,6 @@ (chicken.flonum#minimum-flonum float) (chicken.fixnum#most-negative-fixnum fixnum) (chicken.fixnum#most-positive-fixnum fixnum) -(module-environment (#(procedure #:clean #:enforce) module-environment ((or symbol (list-of (or symbol fixnum))) #!optional *) (struct environment))) (on-exit (#(procedure #:clean #:enforce) on-exit ((procedure () . *)) undefined)) (open-input-string (#(procedure #:clean #:enforce) open-input-string (string #!rest) input-port)) (open-output-string (#(procedure #:clean) open-output-string (#!rest) output-port)) -- 2.1.4
From 2842c51aff6a909c14484a8f50c892c2586f8c78 Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Sun, 2 Apr 2017 20:15:08 +0200 Subject: [PATCH 2/4] Don't use ##sys# prefix for compiled module registration procedures. Instead, explicitly export them, and make generated module definitions refer to the chicken.internal.module namespace directly. We still define ##sys#-prefixed aliases to avoid bootstrapping problems. Once we have a snapshot release, we can get rid of these. --- chicken.csi.import.scm | 2 + chicken.foreign.import.scm | 2 + chicken.import.scm | 2 + modules.scm | 132 ++++++++++++++++++++++++--------------------- tests/module-tests.scm | 4 +- 5 files changed, 79 insertions(+), 63 deletions(-) diff --git a/chicken.csi.import.scm b/chicken.csi.import.scm index a5b727a..2e1c26f 100644 --- a/chicken.csi.import.scm +++ b/chicken.csi.import.scm @@ -24,6 +24,8 @@ ; POSSIBILITY OF SUCH DAMAGE. +;; TODO: After a snapshot release is made, replace this with: +;; chicken.internal.module#register-primitive-module (##sys#register-primitive-module 'chicken.csi '((editor-command . chicken.csi#editor-command) diff --git a/chicken.foreign.import.scm b/chicken.foreign.import.scm index cab548f..4653088 100644 --- a/chicken.foreign.import.scm +++ b/chicken.foreign.import.scm @@ -24,6 +24,8 @@ ; POSSIBILITY OF SUCH DAMAGE. +;; TODO: After a snapshot release is made, replace this with: +;; chicken.internal.module#register-primitive-module (##sys#register-primitive-module 'chicken.foreign '() diff --git a/chicken.import.scm b/chicken.import.scm index ca439fc..0b45503 100644 --- a/chicken.import.scm +++ b/chicken.import.scm @@ -24,6 +24,8 @@ ; POSSIBILITY OF SUCH DAMAGE. +;; TODO: After a snapshot release is made, replace this with: +;; chicken.internal.module#register-primitive-module (##sys#register-primitive-module 'chicken '(abort diff --git a/modules.scm b/modules.scm index ff30e93..ae04ab1 100644 --- a/modules.scm +++ b/modules.scm @@ -36,7 +36,10 @@ (not inline ##sys#alias-global-hook)) (module chicken.internal.module - (find-module/import-library module-saved-environments) + (find-module/import-library module-saved-environments + register-compiled-module register-primitive-module + ;; TODO: Expose this properly to the user in chicken.module? + register-module-alias) (import scheme (only chicken @@ -109,7 +112,7 @@ (define (make-module name lib explist vexports sexports iexports) (%make-module name lib explist '() '() '() '() '() '() '() vexports sexports iexports #f)) -(define (##sys#register-module-alias alias name) +(define (register-module-alias alias name) (##sys#module-alias-environment (cons (cons alias name) (##sys#module-alias-environment)))) @@ -304,7 +307,7 @@ `(,@(if (pair? ifs) `((chicken.eval#eval '(import-syntax ,@(strip-syntax ifs)))) '()) ,@(if (pair? mifs) `((import-syntax ,@(strip-syntax mifs))) '()) ,@(##sys#fast-reverse (strip-syntax (module-meta-expressions mod))) - (##sys#register-compiled-module + (chicken.internal.module#register-compiled-module ',(module-name mod) ',(module-library mod) (list @@ -335,7 +338,7 @@ (cons `(cons ',(caar sd) ,(strip-syntax (cdar sd))) (loop (cdr sd))))))))))))) -(define (##sys#register-compiled-module name lib iexports vexports sexports #!optional +(define (register-compiled-module name lib iexports vexports sexports #!optional (sdefs '())) (define (find-reexport name) (let ((a (assq name (##sys#macro-environment)))) @@ -386,7 +389,7 @@ (set! ##sys#module-table (cons (cons name mod) ##sys#module-table)) mod)) -(define (##sys#register-core-module name lib vexports #!optional (sexports '())) +(define (register-core-module name lib vexports #!optional (sexports '())) (let* ((me (##sys#macro-environment)) (mod (make-module name lib '() @@ -414,8 +417,8 @@ mod)) ;; same as register-core-module, 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 (register-primitive-module name vexports #!optional (sexports '())) + (register-core-module name name vexports sexports)) (define (find-export sym mod indirect) (let ((exports (module-export-list mod))) @@ -925,110 +928,117 @@ ;; ##sys#initial-macro-environment and thus always available inside ;; modules. ##sys#default-macro-environment)) - (##sys#register-primitive-module 'r4rs r4rs-values r4rs-syntax) - (##sys#register-primitive-module + (register-primitive-module 'r4rs r4rs-values r4rs-syntax) + (register-primitive-module 'scheme (append '(dynamic-wind values call-with-values) r4rs-values) r4rs-syntax) - (##sys#register-primitive-module 'r4rs-null '() r4rs-syntax) - (##sys#register-primitive-module 'r5rs-null '() r4rs-syntax)) + (register-primitive-module 'r4rs-null '() r4rs-syntax) + (register-primitive-module 'r5rs-null '() r4rs-syntax)) -(##sys#register-module-alias 'r5rs 'scheme) -(##sys#register-module-alias 'srfi-88 'chicken.keyword) +(register-module-alias 'r5rs 'scheme) +(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) -(##sys#register-module-alias 'continuation 'chicken.continuation) -(##sys#register-module-alias 'csi 'chicken.csi) -(##sys#register-module-alias 'data-structures 'chicken.data-structures) -(##sys#register-module-alias 'errno 'chicken.errno) -(##sys#register-module-alias 'eval 'chicken.eval) -(##sys#register-module-alias 'expand 'chicken.expand) -(##sys#register-module-alias 'file 'chicken.file) -(##sys#register-module-alias 'files 'chicken.files) -(##sys#register-module-alias 'fixnum 'chicken.fixnum) -(##sys#register-module-alias 'flonum 'chicken.flonum) -(##sys#register-module-alias 'foreign 'chicken.foreign) -(##sys#register-module-alias 'format 'chicken.format) -(##sys#register-module-alias 'gc 'chicken.gc) -(##sys#register-module-alias 'internal 'chicken.internal) -(##sys#register-module-alias 'io 'chicken.io) -(##sys#register-module-alias 'irregex 'chicken.irregex) -(##sys#register-module-alias 'keyword 'chicken.keyword) -(##sys#register-module-alias 'locative 'chicken.locative) -(##sys#register-module-alias 'lolevel 'chicken.lolevel) -(##sys#register-module-alias 'memory 'chicken.memory) -(##sys#register-module-alias 'pathname 'chicken.pathname) -(##sys#register-module-alias 'port 'chicken.port) -(##sys#register-module-alias 'posix 'chicken.posix) -(##sys#register-module-alias 'pretty-print 'chicken.pretty-print) -(##sys#register-module-alias 'random 'chicken.random) -(##sys#register-module-alias 'read-syntax 'chicken.read-syntax) -(##sys#register-module-alias 'repl 'chicken.repl) -(##sys#register-module-alias 'tcp 'chicken.tcp) -(##sys#register-module-alias 'time 'chicken.time) +(register-module-alias 'bitwise 'chicken.bitwise) +(register-module-alias 'continuation 'chicken.continuation) +(register-module-alias 'csi 'chicken.csi) +(register-module-alias 'data-structures 'chicken.data-structures) +(register-module-alias 'errno 'chicken.errno) +(register-module-alias 'eval 'chicken.eval) +(register-module-alias 'expand 'chicken.expand) +(register-module-alias 'file 'chicken.file) +(register-module-alias 'files 'chicken.files) +(register-module-alias 'fixnum 'chicken.fixnum) +(register-module-alias 'flonum 'chicken.flonum) +(register-module-alias 'foreign 'chicken.foreign) +(register-module-alias 'format 'chicken.format) +(register-module-alias 'gc 'chicken.gc) +(register-module-alias 'internal 'chicken.internal) +(register-module-alias 'io 'chicken.io) +(register-module-alias 'irregex 'chicken.irregex) +(register-module-alias 'keyword 'chicken.keyword) +(register-module-alias 'locative 'chicken.locative) +(register-module-alias 'lolevel 'chicken.lolevel) +(register-module-alias 'memory 'chicken.memory) +(register-module-alias 'pathname 'chicken.pathname) +(register-module-alias 'port 'chicken.port) +(register-module-alias 'posix 'chicken.posix) +(register-module-alias 'pretty-print 'chicken.pretty-print) +(register-module-alias 'random 'chicken.random) +(register-module-alias 'read-syntax 'chicken.read-syntax) +(register-module-alias 'repl 'chicken.repl) +(register-module-alias 'tcp 'chicken.tcp) +(register-module-alias 'time 'chicken.time) (define-inline (se-subset names env) (map (cut assq <> env) names)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-0 '() (se-subset '(cond-expand) ##sys#default-macro-environment)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-2 '() (se-subset '(and-let*) ##sys#chicken-macro-environment)) -(##sys#register-core-module +(register-core-module 'srfi-6 'library '(open-input-string open-output-string get-output-string)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-8 '() (se-subset '(receive) ##sys#chicken-macro-environment)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-9 '() (se-subset '(define-record-type) ##sys#chicken-macro-environment)) -(##sys#register-core-module +(register-core-module 'srfi-10 'read-syntax '((define-reader-ctor . chicken.read-syntax#define-reader-ctor))) -(##sys#register-primitive-module +(register-primitive-module 'srfi-11 '() (se-subset '(let-values let*-values) ##sys#chicken-macro-environment)) -(##sys#register-core-module +(register-core-module 'srfi-12 'library '(abort condition? condition-predicate condition-property-accessor current-exception-handler make-composite-condition make-property-condition signal with-exception-handler) (se-subset '(handle-exceptions) ##sys#chicken-macro-environment)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-15 '() (se-subset '(fluid-let) ##sys#chicken-macro-environment)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-16 '() (se-subset '(case-lambda) ##sys#chicken-macro-environment)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-17 '() (se-subset '(set!) ##sys#default-macro-environment)) -(##sys#register-core-module +(register-core-module 'srfi-23 'library '(error)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-26 '() (se-subset '(cut cute) ##sys#chicken-macro-environment)) -(##sys#register-core-module +(register-core-module 'srfi-28 'extras '((format . chicken.format#format))) -(##sys#register-primitive-module +(register-primitive-module 'srfi-31 '() (se-subset '(rec) ##sys#chicken-macro-environment)) -(##sys#register-core-module +(register-core-module 'srfi-39 'library '(make-parameter) (se-subset '(parameterize) ##sys#chicken-macro-environment)) -(##sys#register-primitive-module +(register-primitive-module 'srfi-55 '() (se-subset '(require-extension) ##sys#default-macro-environment)) -(##sys#register-core-module +(register-core-module 'srfi-98 'posix '(get-environment-variable (get-environment-variables . chicken.posix#get-environment-variables))) ) + +;; OBSOLETE; can be removed after a snapshot release is made. +;; But don't forget to also replace this in the hardcoded import files! +(define ##sys#register-compiled-module + chicken.internal.module#register-compiled-module) +(define ##sys#register-primitive-module + chicken.internal.module#register-primitive-module) diff --git a/tests/module-tests.scm b/tests/module-tests.scm index 421560e..a8f31af 100644 --- a/tests/module-tests.scm +++ b/tests/module-tests.scm @@ -198,7 +198,7 @@ (module m17 (a) (import scheme) (define a 1)) (begin-for-syntax ; XXX workaround for missing module alias functionality - (##sys#register-module-alias 'm18 'm17)) + (chicken.internal.module#register-module-alias 'm18 'm17)) (module m19 (a) (import scheme) (define a 2)) (test-equal @@ -214,7 +214,7 @@ (module m21 () (import scheme) (begin-for-syntax ; XXX s.a. - (##sys#register-module-alias 'm18 'm19)) + (chicken.internal.module#register-module-alias 'm18 'm19)) (import m18) a) 2) -- 2.1.4
From f0c2bf34f9a93ad0c4d293ee809dcb6867df9994 Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Sun, 2 Apr 2017 21:02:26 +0200 Subject: [PATCH 3/4] Un-##sys# a few module procedures used in macros. These are decompose-import, expand-import, register-import and validate-exports. --- chicken-syntax.scm | 8 +++++--- expand.scm | 18 ++++++++++-------- modules.scm | 13 +++++++------ 3 files changed, 22 insertions(+), 17 deletions(-) diff --git a/chicken-syntax.scm b/chicken-syntax.scm index b97e733..7923b6e 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -1156,7 +1156,8 @@ (cond ((eq? '* exps) '*) ((symbol? exps) `(#:interface ,exps)) ((list? exps) - (##sys#validate-exports exps 'define-interface)) + (chicken.internal.module#validate-exports + exps 'define-interface)) (else (syntax-error-hook 'define-interface "invalid exports" (caddr x)))))))))))) @@ -1180,7 +1181,8 @@ ',(chicken.internal#library-id name) ',(map (lambda (arg) (let ((argname (car arg)) - (exps (##sys#validate-exports (cadr arg) 'functor))) + (exps (chicken.internal.module#validate-exports + (cadr arg) 'functor))) (unless (or (symbol? argname) (and (list? argname) (= 2 (length argname)) @@ -1189,7 +1191,7 @@ (##sys#syntax-error-hook "invalid functor argument" name arg)) (cons argname exps))) args) - ',(##sys#validate-exports exps 'functor) + ',(chicken.internal.module#validate-exports exps 'functor) ',body))) `(##core#module ,(chicken.internal#library-id name) diff --git a/expand.scm b/expand.scm index d1d8ee3..0e6b14f 100644 --- a/expand.scm +++ b/expand.scm @@ -966,21 +966,21 @@ (##sys#extend-macro-environment 'import-syntax '() (##sys#er-transformer - (cut ##sys#expand-import <> <> <> + (cut chicken.internal.module#expand-import <> <> <> ##sys#current-environment ##sys#macro-environment #f #f 'import-syntax))) (##sys#extend-macro-environment 'import-syntax-for-syntax '() (##sys#er-transformer - (cut ##sys#expand-import <> <> <> + (cut chicken.internal.module#expand-import <> <> <> ##sys#current-meta-environment ##sys#meta-macro-environment #t #f 'import-syntax-for-syntax))) (##sys#extend-macro-environment 'reexport '() (##sys#er-transformer - (cut ##sys#expand-import <> <> <> + (cut chicken.internal.module#expand-import <> <> <> ##sys#current-environment ##sys#macro-environment #f #t 'reexport))) @@ -991,11 +991,11 @@ (lambda (x r c) `(##core#begin ,@(map (lambda (x) - (let-values (((name lib spec v s i) (##sys#decompose-import x r c 'import))) + (let-values (((name lib spec v s i) (chicken.internal.module#decompose-import x r c 'import))) (if (not spec) (##sys#syntax-error-hook 'import "cannot import from undefined module" name) - (##sys#import + (chicken.internal.module#register-import spec v s i ##sys#current-environment ##sys#macro-environment #f #f 'import)) (if (not lib) @@ -1483,7 +1483,7 @@ (lambda (x r c) `(##core#begin ,@(map (lambda (x) - (let-values (((name lib _ _ _ _) (##sys#decompose-import x r c 'import))) + (let-values (((name lib _ _ _ _) (chicken.internal.module#decompose-import x r c 'import))) (if (not lib) '(##core#undefined) `(##core#require ,lib ,(module-requirement name))))) @@ -1546,7 +1546,8 @@ (else ;;XXX use module name in "loc" argument? (let ((exports - (##sys#validate-exports (strip-syntax (caddr x)) 'module))) + (chicken.internal.module#validate-exports + (strip-syntax (caddr x)) 'module))) `(##core#module ,name ,(if (eq? '* exports) @@ -1564,7 +1565,8 @@ '() (##sys#er-transformer (lambda (x r c) - (let ((exps (##sys#validate-exports (strip-syntax (cdr x)) 'export)) + (let ((exps (chicken.internal.module#validate-exports + (strip-syntax (cdr x)) 'export)) (mod (##sys#current-module))) (when mod (##sys#add-to-export-list mod exps)) diff --git a/modules.scm b/modules.scm index ae04ab1..6b07e9d 100644 --- a/modules.scm +++ b/modules.scm @@ -38,6 +38,7 @@ (module chicken.internal.module (find-module/import-library module-saved-environments register-compiled-module register-primitive-module + decompose-import expand-import register-import validate-exports ;; TODO: Expose this properly to the user in chicken.module? register-module-alias) @@ -570,7 +571,7 @@ (set! mod (##sys#find-module mname 'import)))))) mod)) -(define (##sys#decompose-import x r c loc) +(define (decompose-import x r c loc) (let ((%only (r 'only)) (%rename (r 'rename)) (%except (r 'except)) @@ -685,18 +686,18 @@ (else (module-imports (strip-syntax x)))))))))))) -(define (##sys#expand-import x r c import-env macro-env meta? reexp? loc) +(define (expand-import x r c import-env macro-env meta? reexp? loc) (##sys#check-syntax loc x '(_ . #(_ 1))) (for-each (lambda (x) - (let-values (((name _ spec v s i) (##sys#decompose-import x r c loc))) + (let-values (((name _ spec v s i) (decompose-import x r c loc))) (if (not spec) (##sys#syntax-error-hook loc "cannot import from undefined module" name x) - (##sys#import spec v s i import-env macro-env meta? reexp? loc)))) + (register-import spec v s i import-env macro-env meta? reexp? loc)))) (cdr x)) '(##core#undefined)) -(define (##sys#import spec vsv vss vsi import-env macro-env meta? reexp? loc) +(define (register-import spec vsv vss vsi import-env macro-env meta? reexp? loc) (let ((cm (##sys#current-module))) (when cm ; save import form (if meta? @@ -783,7 +784,7 @@ (or (getp sym2 '##core#primitive) sym2))))) (else (mrename sym)))) -(define (##sys#validate-exports exps loc) +(define (validate-exports exps loc) ;; expects "exps" to be stripped (define (err . args) (apply ##sys#syntax-error-hook loc args)) -- 2.1.4
From d8793e83491119eb06c71b027b48a1294e45155d Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Sun, 2 Apr 2017 21:31:47 +0200 Subject: [PATCH 4/4] Remove ##sys# prefix from export registration stuff. We rename ##sys#register-export to register-exportable-definition, because it doesn't really directly register an export, only registers a definition that _can_ potentially be exported. The ##sys##add-to-export-list procedure is renamed to register-exports to more clearly indicate that it accepts multiple exports and to match the other "register-" procedures' naming conventions. Both procedures no longer accept a first-class module object, which means we can remove all (##sys#current-module) references from our macros, reducing coupling between expanded macros and the internal details of how the current module is tracked. --- chicken-syntax.scm | 2 +- expand.scm | 10 ++++------ modules.scm | 10 ++++++---- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/chicken-syntax.scm b/chicken-syntax.scm index 7923b6e..a1988c1 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -371,7 +371,7 @@ (lambda (vars argc rest) (for-each (lambda (nm) (let ((name (##sys#get nm '##core#macro-alias nm))) - (##sys#register-export name (##sys#current-module)))) + (chicken.internal.module#register-exportable-definition name))) vars))) `(,(r 'set!-values) ,@(cdr form)))))) diff --git a/expand.scm b/expand.scm index 0e6b14f..8a94037 100644 --- a/expand.scm +++ b/expand.scm @@ -1073,7 +1073,7 @@ (cond ((not (pair? head)) (##sys#check-syntax 'define form '(_ symbol . #(_ 0 1))) (let ((name (or (getp head '##core#macro-alias) head))) - (##sys#register-export name (##sys#current-module))) + (chicken.internal.module#register-exportable-definition name)) (when (c (r 'define) head) (chicken.expand#defjam-error x)) `(##core#define-toplevel @@ -1096,7 +1096,7 @@ (let ((head (cadr form)) (body (caddr form))) (let ((name (or (getp head '##core#macro-alias) head))) - (##sys#register-export name (##sys#current-module))) + (chicken.internal.module#register-exportable-definition name)) (when (c (r 'define-syntax) head) (chicken.expand#defjam-error form)) `(##core#define-syntax ,head ,body)))))) @@ -1566,10 +1566,8 @@ (##sys#er-transformer (lambda (x r c) (let ((exps (chicken.internal.module#validate-exports - (strip-syntax (cdr x)) 'export)) - (mod (##sys#current-module))) - (when mod - (##sys#add-to-export-list mod exps)) + (strip-syntax (cdr x)) 'export))) + (chicken.internal.module#register-exports exps) '(##core#undefined))))) diff --git a/modules.scm b/modules.scm index 6b07e9d..38bee49 100644 --- a/modules.scm +++ b/modules.scm @@ -39,6 +39,7 @@ (find-module/import-library module-saved-environments register-compiled-module register-primitive-module decompose-import expand-import register-import validate-exports + register-exports register-exportable-definition ;; TODO: Expose this properly to the user in chicken.module? register-module-alias) @@ -154,8 +155,9 @@ (##sys#macro-environment (cdr saved))) (##sys#current-module mod)))))) -(define (##sys#add-to-export-list mod exps) - (let ((xl (module-export-list mod))) +(define (register-exports exps) + (and-let* ((mod (##sys#current-module)) + (xl (module-export-list mod))) (if (eq? xl #t) (let ((el (module-exist-list mod)) (me (##sys#macro-environment)) @@ -182,8 +184,8 @@ (and-let* ((a (assq sym senv))) (##sys#warn "redefinition of imported syntax binding" sym))) -(define (##sys#register-export sym mod) - (when mod +(define (register-exportable-definition sym) + (and-let* ((mod (##sys#current-module))) (let ((exp (or (eq? #t (module-export-list mod)) (find-export sym mod #t))) (ulist (module-undefined-list mod))) -- 2.1.4
signature.asc
Description: Digital signature
_______________________________________________ Chicken-hackers mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-hackers
