From fd98961ffb6daa445ec04491dc647442b7806812 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Mon, 4 Dec 2017 22:31:30 +0100 Subject: [PATCH] Move defs of standard Scheme procedures from "eval" unit to library.scm These library.scm definitions are stubs, which get replaced (via set!) when loading the eval unit. This should clear up how things get defined, with lots of comments to clarify what is going on. At least we no longer export standard Scheme identifiers from nonstandard modules. --- c-platform.scm | 4 +++- eval.scm | 46 +++++++++++++++++++++++----------------------- library.scm | 28 ++++++++++++++++++++++++---- modules.scm | 12 ++++++------ types.db | 21 ++++++++++++--------- 5 files changed, 68 insertions(+), 43 deletions(-) diff --git a/c-platform.scm b/c-platform.scm index a8a77c7a..dde59b46 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -140,7 +140,9 @@ values call-with-values vector procedure? memq memv member assq assv assoc list-tail list-ref abs char-ready? peek-char list->string string->list current-input-port current-output-port - make-polar make-rectangular real-part imag-part)) ) + make-polar make-rectangular real-part imag-part + load eval interaction-environment null-environment + scheme-report-environment)) ) (define-constant +flonum-bindings+ (map (lambda (x) (symbol-append 'chicken.flonum# x)) diff --git a/eval.scm b/eval.scm index 718ea80d..418875d1 100644 --- a/eval.scm +++ b/eval.scm @@ -45,13 +45,10 @@ <# (module chicken.eval - (eval-handler module-environment - - ;; TODO These should only be exported by the scheme module (and r4rs/r5rs): - eval interaction-environment null-environment scheme-report-environment) + (eval-handler module-environment) ;; Exclude bindings defined within this module. -(import (except scheme eval interaction-environment null-environment scheme-report-environment) +(import scheme (except chicken eval-handler) chicken.blob chicken.internal @@ -753,9 +750,9 @@ (else ((compile-to-closure x '() se #f #f #f #t) '()))))))) -(define (eval x . env) - (apply (eval-handler) x env)) - +(set! scheme#eval + (lambda (x . env) + (apply (eval-handler) x env))) ;;; User-facing `module-environment` procedure: @@ -808,10 +805,7 @@ (cons (##sys#slot llist 0) vars) (fx+ argc 1) ) ] ) ) ) ) ) - -;;; Environments: - -(define interaction-environment +(set! scheme#interaction-environment (let ((e (##sys#make-structure 'environment 'interaction-environment #f #f))) (lambda () e))) @@ -820,9 +814,6 @@ (##sys#print (##sys#slot e 1) #f p) (##sys#write-char-0 #\> p)) -(define scheme-report-environment) -(define null-environment) - (let* ((r4s (chicken.module#module-environment 'r4rs 'scheme-report-environment/4)) (r5s (chicken.module#module-environment 'scheme 'scheme-report-environment/5)) (r4n (chicken.module#module-environment 'r4rs-null 'null-environment/4)) @@ -854,7 +845,7 @@ (##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 + (set! scheme#scheme-report-environment (lambda (n) (##sys#check-fixnum n 'scheme-report-environment) (case n @@ -864,7 +855,7 @@ (##sys#error 'scheme-report-environment "unsupported scheme report environment version" n))))) - (set! null-environment + (set! scheme#null-environment (lambda (n) (##sys#check-fixnum n 'null-environment) (case n @@ -875,6 +866,11 @@ 'null-environment "unsupported null environment version" n)))))) + +;;; OBSOLETE: Remove after bootstrapping. Import libraries emitted by +;;; old compilers will still refer to chicken.eval#eval. +(define chicken.eval#eval scheme#eval) + ) ; eval module @@ -883,7 +879,7 @@ load-library load-noisily load-relative load-verbose provide provided? require) -(import (except scheme load) +(import scheme chicken chicken.eval chicken.foreign @@ -1101,10 +1097,9 @@ (close-input-port in)))))))) (##core#undefined)))) -;; Exported by "scheme", so use full name to avoid exporting it here. -;; TODO: Maybe change this later to (set! scheme#load (lambda ..)) -(define (chicken.load#load filename #!optional evaluator) - (load/internal filename evaluator)) +(set! scheme#load + (lambda (filename #!optional evaluator) + (load/internal filename evaluator))) (define (load-relative filename #!optional evaluator) (let ((fn (make-relative-pathname ##sys#current-load-filename filename))) @@ -1379,12 +1374,17 @@ fname) ) ) (else (loop (##sys#slot paths 1))) ) ) ) ) ) ) +;;; OBSOLETE: Remove after bootstrapping. Import libraries loaded +;;; from an old compiler's library path will still refer to +;;; chicken.load#load in their compiled module registration code. +(define chicken.load#load scheme#load) + ) ; chicken.load ;;; Simple invocation API: -(import chicken chicken.eval chicken.load chicken.condition) +(import chicken scheme chicken.eval chicken.load chicken.condition) (declare (hide last-error run-safe store-result store-string diff --git a/library.scm b/library.scm index 44927eef..e7814c4b 100644 --- a/library.scm +++ b/library.scm @@ -242,10 +242,10 @@ EOF eof-object? with-input-from-file with-output-to-file char-ready? imag-part real-part make-rectangular make-polar angle magnitude numerator denominator values call-with-values dynamic-wind - ;; NOTE: {null,scheme-report,interaction}-environment and eval - ;; are defined in chicken.eval, load is defined in chicken.load! - ;; The definition of "scheme" in modules.scm includes these. - ) + + ;; The following procedures are overwritten in eval.scm: + eval interaction-environment null-environment + scheme-report-environment load) ;; We use r5rs-null to get just the syntax exports for "scheme", ;; because importing them from "scheme" would be importing then from @@ -544,6 +544,26 @@ EOF (define write) (define display) +;;; Evaluation environments: + +;; All of the stuff below is overwritten with their "real" +;; implementations by chicken.eval (see eval.scm) + +(define (eval x . env) + (##sys#error 'eval "`eval' is not defined; the `eval' unit was probably not linked with this executable") ) + +(define (interaction-environment) + (##sys#error 'interaction-environment "`interaction-environment' is not defined; the `eval' unit was probably not linked with this executable")) + +(define (scheme-report-environment n) + (##sys#error 'scheme-report-environment "`scheme-report-environment' is not defined; the `eval' unit was probably not linked with this executable")) + +(define (null-environment) + (##sys#error 'null-environment "`null-environment' is not defined; the `eval' unit was probably not linked with this executable")) + +(define (load filename . evaluator) + (##sys#error 'load "`load' is not defined; the `eval' unit was probably not linked with this executable") ) + ;; Other stuff: (define force) diff --git a/modules.scm b/modules.scm index c8484248..a5521cbd 100644 --- a/modules.scm +++ b/modules.scm @@ -316,7 +316,7 @@ (ifs (module-import-forms mod)) (sexports (module-sexports mod)) (mifs (module-meta-import-forms mod))) - `(,@(if (pair? ifs) `((chicken.eval#eval '(import-syntax ,@(strip-syntax ifs)))) '()) + `(,@(if (pair? ifs) `((scheme#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 @@ -1010,23 +1010,23 @@ (open-output-file . scheme#open-output-file) (close-input-port . scheme#close-input-port) (close-output-port . scheme#close-output-port) - (load . chicken.load#load) (read . scheme#read) + (load . scheme#load) (read . scheme#read) (read-char . scheme#read-char) (peek-char . scheme#peek-char) (write . scheme#write) (display . scheme#display) (write-char . scheme#write-char) (newline . scheme#newline) (eof-object? . scheme#eof-object?) (with-input-from-file . scheme#with-input-from-file) (with-output-to-file . scheme#with-output-to-file) - (eval . chicken.eval#eval) (char-ready? . scheme#char-ready?) + (eval . scheme#eval) (char-ready? . scheme#char-ready?) (imag-part . scheme#imag-part) (real-part . scheme#real-part) (make-rectangular . scheme#make-rectangular) (make-polar . scheme#make-polar) (angle . scheme#angle) (magnitude . scheme#magnitude) (numerator . scheme#numerator) (denominator . scheme#denominator) - (scheme-report-environment . chicken.eval#scheme-report-environment) - (null-environment . chicken.eval#null-environment) - (interaction-environment . chicken.eval#interaction-environment))) + (scheme-report-environment . scheme#scheme-report-environment) + (null-environment . scheme#null-environment) + (interaction-environment . scheme#interaction-environment))) (r4rs-syntax ##sys#scheme-macro-environment)) (##sys#register-core-module 'r4rs 'library r4rs-values r4rs-syntax) (##sys#register-core-module diff --git a/types.db b/types.db index 8aaaf5db..9f93fbd0 100644 --- a/types.db +++ b/types.db @@ -826,18 +826,22 @@ ((integer) (fixnum) (let ((#(tmp) #(1))) '1)) ((ratnum) (integer) (##core#inline "C_u_i_ratnum_denom" #(1)))) -;; eval +(scheme#load (procedure scheme#load (string #!optional (procedure (*) . *)) undefined)) + +(scheme#eval (procedure scheme#eval (* #!optional (struct environment)) . *)) + +(scheme#scheme-report-environment + (#(procedure #:clean #:enforce) scheme#scheme-report-environment (#!optional fixnum) (struct environment))) -(chicken.eval#eval (procedure chicken.eval#eval (* #!optional (struct environment)) . *)) +(scheme#null-environment + (#(procedure #:clean #:enforce) scheme#null-environment (#!optional fixnum) (struct environment))) -(chicken.eval#scheme-report-environment - (#(procedure #:clean #:enforce) chicken.eval#scheme-report-environment (#!optional fixnum) (struct environment))) +(scheme#interaction-environment + (#(procedure #:clean) scheme#interaction-environment () (struct environment))) -(chicken.eval#null-environment - (#(procedure #:clean #:enforce) chicken.eval#null-environment (#!optional fixnum) (struct environment))) -(chicken.eval#interaction-environment - (#(procedure #:clean) chicken.eval#interaction-environment () (struct environment))) + +;; eval (chicken.eval#module-environment (#(procedure #:clean #:enforce) chicken.eval#module-environment ((or symbol (list-of (or symbol fixnum)))) (struct environment))) @@ -1279,7 +1283,6 @@ (chicken.load#dynamic-load-libraries (#(procedure #:clean) chicken.load#dynamic-load-libraries (#!optional (list-of string)) (list-of string))) -(chicken.load#load (procedure chicken.load#load (string #!optional (procedure (*) . *)) undefined)) (chicken.load#load-library (#(procedure #:enforce) chicken.load#load-library (symbol #!optional string) undefined)) (chicken.load#load-noisily (procedure chicken.load#load-noisily (string #!rest) undefined)) (chicken.load#load-relative (#(procedure #:enforce) chicken.load#load-relative (string #!optional (procedure (*) . *)) undefined)) -- 2.11.0