~ chicken-core (chicken-5) 731429d315d462628f4c817b5abafc45a75e665e
commit 731429d315d462628f4c817b5abafc45a75e665e
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue May 2 19:33:24 2017 +1200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Thu May 4 21:21:58 2017 +0200
Split eval.scm into chicken.eval and chicken.load modules
This reorganises things in eval.scm so that two sets of procedures,
those supporting `eval` and those dealing with code loading, can be
logically grouped, allowing us to create a new, self-contained
"chicken.load" module dedicated to the latter.
Most of this patch is just swapping two large hunks around: the code
relating to environments moves up the file into the existing chicken.eval
module, while the foreign variables and constants that relate to dynamic
code loading move down the file into a new chicken.load module.
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/README b/README
index 633d364a..27db7bb6 100644
--- a/README
+++ b/README
@@ -304,6 +304,7 @@ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/
| | |-- chicken.io.import.so
| | |-- chicken.irregex.import.so
| | |-- chicken.keyword.import.so
+ | | |-- chicken.load.import.so
| | |-- chicken.locative.import.so
| | |-- chicken.lolevel.import.so
| | |-- chicken.memory.import.so
diff --git a/batch-driver.scm b/batch-driver.scm
index be86ab10..85307c4f 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -40,6 +40,7 @@
chicken.format
chicken.gc
chicken.internal
+ chicken.load
chicken.pathname
chicken.platform
chicken.pretty-print
diff --git a/chicken.import.scm b/chicken.import.scm
index 359f5b4f..b19e72b5 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -52,7 +52,7 @@
current-read-table
delete-file
directory-exists?
- (dynamic-load-libraries . chicken.eval#dynamic-load-libraries)
+ (dynamic-load-libraries . chicken.load#dynamic-load-libraries)
enable-warnings
equal=?
(er-macro-transformer . chicken.expand#er-macro-transformer)
@@ -118,10 +118,11 @@
(installation-repository . chicken.platform#installation-repository)
(ir-macro-transformer . chicken.expand#ir-macro-transformer)
keyword-style
- (load-library . chicken.eval#load-library)
- (load-noisily . chicken.eval#load-noisily)
- (load-relative . chicken.eval#load-relative)
- (load-verbose . chicken.eval#load-verbose)
+ (load-extension . chicken.load#load-extension)
+ (load-library . chicken.load#load-library)
+ (load-noisily . chicken.load#load-noisily)
+ (load-relative . chicken.load#load-relative)
+ (load-verbose . chicken.load#load-verbose)
(machine-byte-order . chicken.platform#machine-byte-order)
(machine-type . chicken.platform#machine-type)
make-blob
@@ -143,8 +144,8 @@
port-name
port-position
port?
- (provide . chicken.eval#provide)
- (provided? . chicken.eval#provided?)
+ (provide . chicken.load#provide)
+ (provided? . chicken.load#provided?)
print
print-call-chain
print-error-message
@@ -161,7 +162,7 @@
remprop!
rename-file
(repository-path . chicken.platform#repository-path)
- (require . chicken.eval#require)
+ (require . chicken.load#require)
reset
reset-handler
return-to-host
diff --git a/core.scm b/core.scm
index c3432a89..a46f281e 100644
--- a/core.scm
+++ b/core.scm
@@ -328,12 +328,13 @@
chicken.eval
chicken.expand
chicken.foreign
- chicken.pathname
chicken.format
chicken.internal
chicken.io
chicken.keyword
- chicken.pretty-print)
+ chicken.load
+ chicken.pretty-print
+ chicken.pathname)
(define (d arg1 . more)
(when (##sys#debug-mode?)
diff --git a/csi.scm b/csi.scm
index b4d7d778..72defb80 100644
--- a/csi.scm
+++ b/csi.scm
@@ -52,6 +52,7 @@ EOF
chicken.internal
chicken.io
chicken.keyword
+ chicken.load
chicken.platform
chicken.port
chicken.pretty-print
diff --git a/defaults.make b/defaults.make
index 51af1cd2..6bf867c4 100644
--- a/defaults.make
+++ b/defaults.make
@@ -266,7 +266,7 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
PRIMITIVE_IMPORT_LIBRARIES = chicken chicken.csi chicken.foreign
DYNAMIC_IMPORT_LIBRARIES = srfi-4
DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise errno file.posix fixnum flonum \
- format gc io keyword locative memory platform posix \
+ format gc io keyword load locative memory platform posix \
pretty-print process process.signal process-context random \
time time.posix
DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
diff --git a/distribution/manifest b/distribution/manifest
index 834a7b83..97f41d79 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -302,6 +302,8 @@ chicken.irregex.import.scm
chicken.irregex.import.c
chicken.keyword.import.scm
chicken.keyword.import.c
+chicken.load.import.scm
+chicken.load.import.c
chicken.locative.import.scm
chicken.locative.import.c
chicken.lolevel.import.scm
diff --git a/eval.scm b/eval.scm
index 87670a1c..2f3e64d1 100644
--- a/eval.scm
+++ b/eval.scm
@@ -45,96 +45,22 @@
<#
(module chicken.eval
- (dynamic-load-libraries
- eval eval-handler
- load load-library load-noisily load-relative load-verbose
- interaction-environment null-environment scheme-report-environment
- load-extension provide provided?
- require set-dynamic-load-mode!)
+ (eval eval-handler
+ interaction-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 provide provided? require))
-
-(import chicken.expand
- chicken.foreign
+(import (except scheme eval interaction-environment null-environment scheme-report-environment)
+ (except chicken eval-handler)
+ chicken.expand
chicken.internal
- chicken.keyword
- chicken.platform)
+ chicken.keyword)
(include "common-declarations.scm")
-(include "mini-srfi-1.scm")
-(include "egg-information.scm")
(define-syntax d (syntax-rules () ((_ . _) (void))))
(provide* eval) ; TODO remove after a snapshot release
-(define-foreign-variable binary-version int "C_BINARY_VERSION")
-(define-foreign-variable uses-soname? bool "C_USES_SONAME")
-(define-foreign-variable install-lib-name c-string "C_INSTALL_LIB_NAME")
-
-(define-constant core-unit-requirements
- '((scheme ; XXX not totally correct, also needs eval
- . (##core#require library))
- (chicken.foreign
- . (##core#require-for-syntax chicken-ffi-syntax))
- (chicken
- . (##core#begin
- (##core#require-for-syntax chicken-syntax)
- (##core#require library)))))
-
-(define-constant core-units
- '(chicken-syntax chicken-ffi-syntax continuation data-structures eval
- expand extras file files internal irregex library lolevel pathname
- port posix srfi-4 tcp repl read-syntax))
-
-(define-constant cygwin-default-dynamic-load-libraries '("cygchicken-0"))
-(define-constant macosx-load-library-extension ".dylib")
-(define-constant windows-load-library-extension ".dll")
-(define-constant hppa-load-library-extension ".sl")
-(define-constant default-load-library-extension ".so")
-(define-constant environment-table-size 301)
-(define-constant source-file-extension ".scm")
-(define-constant windows-object-file-extension ".obj")
-(define-constant unix-object-file-extension ".o")
-(define-constant loadable-file-extension ".so")
-
-(define object-file-extension
- (cond ((eq? (software-type) 'windows) windows-object-file-extension)
- (else unix-object-file-extension)))
-
-(define load-library-extension
- (cond ((eq? (software-type) 'windows) windows-load-library-extension)
- ((eq? (software-version) 'macosx) macosx-load-library-extension)
- ((and (eq? (software-version) 'hpux)
- (eq? (machine-type) 'hppa)) hppa-load-library-extension)
- (else default-load-library-extension) ) )
-
-(define ##sys#load-dynamic-extension default-load-library-extension)
-
-
-; these are actually in unit extras, but that is used by default
-
-(define-constant builtin-features
- '(srfi-30 srfi-46 srfi-61 srfi-62 ; runtime
- srfi-0 srfi-2 srfi-8 srfi-9 srfi-11 srfi-15 ; syntax
- srfi-16 srfi-17 srfi-26 srfi-31 srfi-55 srfi-88)) ; syntax cont
-
-(define default-dynamic-load-libraries
- (case (build-platform)
- ((cygwin) cygwin-default-dynamic-load-libraries)
- (else `(,(string-append "lib" install-lib-name)))))
-
-
-;;; Library registration (used for code loading):
-
-(define (##sys#provide id)
- (##core#inline_allocate ("C_a_i_provide" 8) id))
-
-(define (##sys#provided? id)
- (##core#inline "C_i_providedp" id))
-
;;; Compile lambda to closure:
@@ -658,7 +584,7 @@
[(##core#require-for-syntax)
(let ((id (cadr x)))
- (load-extension id)
+ (chicken.load#load-extension id)
(compile '(##core#undefined)
e #f tf cntr se #f))]
@@ -875,6 +801,150 @@
(fx+ argc 1) ) ] ) ) ) ) )
+;;; Environments:
+
+(define interaction-environment
+ (let ((e (##sys#make-structure 'environment 'interaction-environment #f #f)))
+ (lambda () e)))
+
+(define-record-printer (environment e p)
+ (##sys#print "#<environment " #f p)
+ (##sys#print (##sys#slot e 1) #f p)
+ (##sys#write-char-0 #\> p))
+
+(define scheme-report-environment)
+(define null-environment)
+
+(let* ((r4s (module-environment 'r4rs 'scheme-report-environment/4))
+ (r5s (module-environment 'scheme 'scheme-report-environment/5))
+ (r4n (module-environment 'r4rs-null 'null-environment/4))
+ (r5n (module-environment 'r5rs-null 'null-environment/5)))
+ (define (strip se)
+ (foldr
+ (lambda (s r)
+ (if (memq (car s)
+ '(import
+ import-syntax
+ import-for-syntax
+ import-syntax-for-syntax
+ require-extension
+ require-extension-for-syntax
+ require-library
+ begin-for-syntax
+ export
+ module
+ cond-expand
+ syntax
+ reexport))
+ r
+ (cons s r)))
+ '()
+ se))
+ ;; Strip non-std syntax from SEs
+ (##sys#setslot r4s 2 (strip (##sys#slot r4s 2)))
+ (##sys#setslot r4n 2 (strip (##sys#slot r4n 2)))
+ (##sys#setslot r5s 2 (strip (##sys#slot r5s 2)))
+ (##sys#setslot r5n 2 (strip (##sys#slot r5n 2)))
+ (set! scheme-report-environment
+ (lambda (n)
+ (##sys#check-fixnum n 'scheme-report-environment)
+ (case n
+ ((4) r4s)
+ ((5) r5s)
+ (else
+ (##sys#error
+ 'scheme-report-environment
+ "unsupported scheme report environment version" n)))))
+ (set! null-environment
+ (lambda (n)
+ (##sys#check-fixnum n 'null-environment)
+ (case n
+ ((4) r4n)
+ ((5) r5n)
+ (else
+ (##sys#error
+ 'null-environment
+ "unsupported null environment version" n))))))
+
+) ; eval module
+
+
+(module chicken.load
+ (dynamic-load-libraries
+ load load-extension load-library load-noisily load-relative load-verbose
+ provide provided? require set-dynamic-load-mode!)
+
+(import (except scheme load) chicken chicken.foreign chicken.internal)
+
+(include "mini-srfi-1.scm")
+(include "egg-information.scm")
+
+;;; Installation locations
+
+(define-foreign-variable binary-version int "C_BINARY_VERSION")
+(define-foreign-variable install-lib-name c-string "C_INSTALL_LIB_NAME")
+(define-foreign-variable uses-soname? bool "C_USES_SONAME")
+
+(define-constant core-unit-requirements
+ '((scheme ; XXX not totally correct, also needs eval
+ . (##core#require library))
+ (chicken.foreign
+ . (##core#require-for-syntax chicken-ffi-syntax))
+ (chicken
+ . (##core#begin
+ (##core#require-for-syntax chicken-syntax)
+ (##core#require library)))))
+
+(define-constant core-units
+ '(chicken-syntax chicken-ffi-syntax continuation data-structures eval
+ expand extras file files internal irregex library lolevel pathname
+ port posix srfi-4 tcp repl read-syntax))
+
+(define-constant cygwin-default-dynamic-load-libraries '("cygchicken-0"))
+(define-constant macosx-load-library-extension ".dylib")
+(define-constant windows-load-library-extension ".dll")
+(define-constant hppa-load-library-extension ".sl")
+(define-constant default-load-library-extension ".so")
+(define-constant source-file-extension ".scm")
+(define-constant windows-object-file-extension ".obj")
+(define-constant unix-object-file-extension ".o")
+(define-constant loadable-file-extension ".so")
+
+(define object-file-extension
+ (cond ((eq? (software-type) 'windows) windows-object-file-extension)
+ (else unix-object-file-extension)))
+
+(define load-library-extension
+ (cond ((eq? (software-type) 'windows) windows-load-library-extension)
+ ((eq? (software-version) 'macosx) macosx-load-library-extension)
+ ((and (eq? (software-version) 'hpux)
+ (eq? (machine-type) 'hppa)) hppa-load-library-extension)
+ (else default-load-library-extension)))
+
+(define ##sys#load-dynamic-extension default-load-library-extension)
+
+; these are actually in unit extras, but that is used by default
+
+(define-constant builtin-features
+ '(srfi-30 srfi-46 srfi-61 srfi-62 ; runtime
+ srfi-0 srfi-2 srfi-8 srfi-9 srfi-11 srfi-15 ; syntax
+ srfi-16 srfi-17 srfi-26 srfi-31 srfi-55 srfi-88)) ; syntax cont
+
+(define default-dynamic-load-libraries
+ (case (build-platform)
+ ((cygwin) cygwin-default-dynamic-load-libraries)
+ (else `(,(string-append "lib" install-lib-name)))))
+
+
+;;; Library registration (used for code loading):
+
+(define (##sys#provide id)
+ (##core#inline_allocate ("C_a_i_provide" 8) id))
+
+(define (##sys#provided? id)
+ (##core#inline "C_i_providedp" id))
+
+
;;; Pathname helpers:
(define path-separators
@@ -1254,73 +1324,6 @@
#f
'dynamic)))))
-
-;;; Environments:
-
-(define interaction-environment
- (let ((e (##sys#make-structure 'environment 'interaction-environment #f #f)))
- (lambda () e)))
-
-(define-record-printer (environment e p)
- (##sys#print "#<environment " #f p)
- (##sys#print (##sys#slot e 1) #f p)
- (##sys#write-char-0 #\> p))
-
-(define scheme-report-environment)
-(define null-environment)
-
-(let* ((r4s (module-environment 'r4rs 'scheme-report-environment/4))
- (r5s (module-environment 'scheme 'scheme-report-environment/5))
- (r4n (module-environment 'r4rs-null 'null-environment/4))
- (r5n (module-environment 'r5rs-null 'null-environment/5)))
- (define (strip se)
- (foldr
- (lambda (s r)
- (if (memq (car s)
- '(import
- import-syntax
- import-for-syntax
- import-syntax-for-syntax
- require-extension
- require-extension-for-syntax
- require-library
- begin-for-syntax
- export
- module
- cond-expand
- syntax
- reexport))
- r
- (cons s r)))
- '()
- se))
- ;; Strip non-std syntax from SEs
- (##sys#setslot r4s 2 (strip (##sys#slot r4s 2)))
- (##sys#setslot r4n 2 (strip (##sys#slot r4n 2)))
- (##sys#setslot r5s 2 (strip (##sys#slot r5s 2)))
- (##sys#setslot r5n 2 (strip (##sys#slot r5n 2)))
- (set! scheme-report-environment
- (lambda (n)
- (##sys#check-fixnum n 'scheme-report-environment)
- (case n
- ((4) r4s)
- ((5) r5s)
- (else
- (##sys#error
- 'scheme-report-environment
- "unsupported scheme report environment version" n)) ) ) )
- (set! null-environment
- (lambda (n)
- (##sys#check-fixnum n 'null-environment)
- (case n
- ((4) r4n)
- ((5) r5n)
- (else
- (##sys#error
- 'null-environment
- "unsupported null environment version" n) )))))
-
-
;;; Find included file:
(define ##sys#include-pathnames (list (chicken-home)))
@@ -1362,19 +1365,20 @@
fname) ) )
(else (loop (##sys#slot paths 1))) ) ) ) ) ) )
-) ; eval module
+) ; chicken.load
-(import chicken chicken.eval)
;;; Simple invocation API:
+(import chicken chicken.eval chicken.load)
+
(declare
(hide last-error run-safe store-result store-string
CHICKEN_yield CHICKEN_eval CHICKEN_eval_string
CHICKEN_eval_to_string CHICKEN_eval_string_to_string
CHICKEN_apply CHICKEN_apply_to_string CHICKEN_eval_apply
CHICKEN_read CHICKEN_load CHICKEN_get_error_message))
-
+
(define last-error #f)
(define (run-safe thunk)
diff --git a/modules.scm b/modules.scm
index a69e0241..2bf32c6c 100644
--- a/modules.scm
+++ b/modules.scm
@@ -42,6 +42,7 @@
(import chicken.expand
chicken.internal
chicken.keyword
+ chicken.load
chicken.platform)
(define-alias dd d)
@@ -569,7 +570,7 @@
(##sys#macro-environment
(##sys#meta-macro-environment)))
(fluid-let ((##sys#notices-enabled #f)) ; to avoid re-import warnings
- (chicken.eval#load il)
+ (load il)
(set! mod (##sys#find-module mname 'import))))))
mod))
@@ -916,7 +917,7 @@
call-with-current-continuation input-port? output-port?
current-input-port current-output-port call-with-input-file
call-with-output-file open-input-file open-output-file
- close-input-port close-output-port (load . chicken.eval#load)
+ close-input-port close-output-port (load . chicken.load#load)
read read-char peek-char write display write-char newline eof-object?
with-input-from-file with-output-to-file (eval . chicken.eval#eval)
char-ready? imag-part real-part make-rectangular make-polar angle
diff --git a/rules.make b/rules.make
index a539803f..c1bdda32 100644
--- a/rules.make
+++ b/rules.make
@@ -512,6 +512,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.keyword,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.platform,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.time,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.load,eval))
$(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.io,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.pretty-print,extras))
@@ -539,6 +540,7 @@ batch-driver.c: batch-driver.scm mini-srfi-1.scm \
chicken.format.import.scm \
chicken.gc.import.scm \
chicken.internal.import.scm \
+ chicken.load.import.scm \
chicken.pathname.import.scm \
chicken.platform.import.scm \
chicken.pretty-print.import.scm \
@@ -568,6 +570,7 @@ core.c: core.scm mini-srfi-1.scm \
chicken.format.import.scm \
chicken.io.import.scm \
chicken.keyword.import.scm \
+ chicken.load.import.scm \
chicken.pretty-print.import.scm
optimizer.c: optimizer.scm mini-srfi-1.scm \
chicken.compiler.support.import.scm \
@@ -617,10 +620,10 @@ modules.c: modules.scm \
chicken.expand.import.scm \
chicken.internal.import.scm \
chicken.keyword.import.scm \
+ chicken.load.import.scm \
chicken.platform.import.scm
csc.c: csc.scm \
chicken.data-structures.import.scm \
- chicken.eval.import.scm \
chicken.format.import.scm \
chicken.pathname.import.scm \
chicken.posix.import.scm
@@ -632,6 +635,7 @@ csi.c: csi.scm \
chicken.internal.import.scm \
chicken.io.import.scm \
chicken.keyword.import.scm \
+ chicken.load.import.scm \
chicken.platform.import.scm \
chicken.port.import.scm \
chicken.pretty-print.import.scm \
@@ -765,7 +769,9 @@ library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations
internal.c: $(SRCDIR)internal.scm $(SRCDIR)mini-srfi-1.scm
$(bootstrap-lib) -emit-import-library chicken.internal
eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm $(SRCDIR)egg-information.scm
- $(bootstrap-lib) -emit-import-library chicken.eval
+ $(bootstrap-lib) \
+ -emit-import-library chicken.eval \
+ -emit-import-library chicken.load
read-syntax.c: $(SRCDIR)read-syntax.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.read-syntax
repl.c: $(SRCDIR)repl.scm $(SRCDIR)common-declarations.scm
diff --git a/types.db b/types.db
index 2894975b..13b911bd 100644
--- a/types.db
+++ b/types.db
@@ -852,14 +852,6 @@
;; eval
(chicken.eval#eval (procedure chicken.eval#eval (* #!optional (struct environment)) . *))
-(chicken.eval#load (procedure chicken.eval#load (string #!optional (procedure (*) . *)) undefined))
-(chicken.eval#load-extension (#(procedure #:enforce) chicken.eval#load-extension (symbol) undefined))
-(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#provide (#(procedure #:clean #:enforce) chicken.eval#provide (#!rest symbol) undefined))
-(chicken.eval#provided? (#(procedure #:clean #:enforce) chicken.eval#provided? (#!rest symbol) boolean))
-(chicken.eval#require (#(procedure #:clean) chicken.eval#require (#!rest symbol) undefined))
(chicken.eval#scheme-report-environment
(#(procedure #:clean #:enforce) chicken.eval#scheme-report-environment (#!optional fixnum) (struct environment)))
@@ -1212,6 +1204,17 @@
(chicken.keyword#keyword? (#(procedure #:pure) chicken.keyword#keyword? (*) boolean))
(chicken.keyword#string->keyword (#(procedure #:clean #:enforce) chicken.keyword#string->keyword (string) symbol))
+;; load
+
+(chicken.load#load (procedure chicken.load#load (string #!optional (procedure (*) . *)) undefined))
+(chicken.load#load-extension (#(procedure #:enforce) chicken.load#load-extension (symbol) undefined))
+(chicken.load#load-library (#(procedure #:enforce) chicken.load#load-library (symbol #!optional string) undefined))
+(chicken.load#load-relative (#(procedure #:enforce) chicken.load#load-relative (string #!optional (procedure (*) . *)) undefined))
+(chicken.load#load-verbose (#(procedure #:clean) chicken.load#load-verbose (#!optional *) *))
+(chicken.load#provide (#(procedure #:clean #:enforce) chicken.load#provide (#!rest symbol) undefined))
+(chicken.load#provided? (#(procedure #:clean #:enforce) chicken.load#provided? (#!rest symbol) boolean))
+(chicken.load#require (#(procedure #:clean) chicken.load#require (#!rest symbol) undefined))
+
;; platform
(chicken.platform#build-platform (#(procedure #:pure) chicken.platform#build-platform () symbol))
Trap