~ chicken-core (chicken-5) 15c5f8fcebc21c2629cc5cde47435a1edd2eec8a
commit 15c5f8fcebc21c2629cc5cde47435a1edd2eec8a
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Oct 13 20:22:10 2015 +1300
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Mon Nov 2 21:29:01 2015 +0100
Un-##sys# toplevel definitions not used outside eval.scm
Moves some module-local procedures out of the global environment.
Names-only commit, no logic is changed.
diff --git a/eval.scm b/eval.scm
index 5ff73fa1..a5e424f9 100644
--- a/eval.scm
+++ b/eval.scm
@@ -98,9 +98,6 @@
(define ##sys#explicit-library-modules '())
-(define default-dynamic-load-libraries
- `(,(string-append "lib" install-lib-name)))
-
(define-constant cygwin-default-dynamic-load-libraries '("cygchicken-0"))
(define-constant macosx-load-library-extension ".dylib")
(define-constant windows-load-library-extension ".dll")
@@ -123,7 +120,12 @@
(define-constant builtin-features/compiled
'(srfi-8 srfi-9 srfi-11 srfi-15 srfi-16 srfi-17 srfi-26) )
-(define ##sys#chicken-prefix
+(define default-dynamic-load-libraries
+ (case (build-platform)
+ ((cygwin) cygwin-default-dynamic-load-libraries)
+ (else `(,(string-append "lib" install-lib-name)))))
+
+(define chicken-prefix
(let ((prefix (and-let* ((p (get-environment-variable prefix-environment-variable)))
(##sys#string-append
p
@@ -136,8 +138,7 @@
;;; System settings
(define (chicken-home)
- (or (##sys#chicken-prefix "share/chicken")
- installation-home) )
+ (or (chicken-prefix "share/chicken") installation-home))
;;; Lo-level hashtable support:
@@ -206,7 +207,7 @@
;;; Compile lambda to closure:
-(define (##sys#eval-decorator p ll h cntr)
+(define (eval-decorator p ll h cntr)
(##sys#decorate-lambda
p
(lambda (x) (and (not (##sys#immediate? x)) (##core#inline "C_lambdainfop" x)))
@@ -271,7 +272,7 @@
##sys#current-thread) ) )
(define (decorate p ll h cntr)
- (##sys#eval-decorator p ll h cntr) )
+ (eval-decorator p ll h cntr))
(define (compile x e h tf cntr se)
(cond ((keyword? x) (lambda v x))
@@ -719,7 +720,7 @@
(let ([ids (map (lambda (x) (##sys#eval/meta x))
(cdr x))])
(apply ##sys#require ids)
- (let ([rs (##sys#lookup-runtime-requirements ids)])
+ (let ((rs (lookup-runtime-requirements ids)))
(compile
(if (null? rs)
'(##core#undefined)
@@ -892,12 +893,8 @@
(else
((##sys#compile-to-closure x '() se #f #f #f) '() ) ) ) ) )))
-(define ##sys#eval-handler eval-handler)
-
(define (eval x . env)
- (apply (##sys#eval-handler)
- x
- env) )
+ (apply (eval-handler) x env))
;;; Setting properties dynamically scoped
@@ -1074,7 +1071,7 @@
(define (load-noisily filename #!key (evaluator #f) (time #f) (printer #f))
(load/internal filename evaluator #t time printer))
-(define ##sys#load-library-extension ; this is crude...
+(define load-library-extension ; this is crude...
(cond [(eq? (software-type) 'windows) windows-load-library-extension]
[(eq? (software-version) 'macosx) macosx-load-library-extension]
[(and (eq? (software-version) 'hpux)
@@ -1083,28 +1080,23 @@
(define ##sys#load-dynamic-extension default-load-library-extension)
-(define ##sys#default-dynamic-load-libraries
- (case (build-platform)
- ((cygwin) cygwin-default-dynamic-load-libraries)
- (else default-dynamic-load-libraries) ) )
-
(define dynamic-load-libraries
(let ((ext
(if uses-soname?
(string-append
- ##sys#load-library-extension
+ load-library-extension
"."
(number->string binary-version))
- ##sys#load-library-extension)))
+ load-library-extension)))
(define complete
(cut ##sys#string-append <> ext))
(make-parameter
- (map complete ##sys#default-dynamic-load-libraries)
+ (map complete default-dynamic-load-libraries)
(lambda (x)
(##sys#check-list x)
x) ) ) )
-(define ##sys#load-library-0
+(define load-library-0
(let ([string-append string-append]
[display display] )
(lambda (uname lib)
@@ -1113,7 +1105,7 @@
(let ([libs
(if lib
(##sys#list lib)
- (cons (##sys#string-append (##sys#slot uname 1) ##sys#load-library-extension)
+ (cons (##sys#string-append (##sys#slot uname 1) load-library-extension)
(dynamic-load-libraries) ) ) ]
[top
(##sys#make-c-string
@@ -1133,13 +1125,13 @@
#t]
[else (loop (##sys#slot libs 1))] ) ) ) ) ) ) ) )
-(define ##sys#load-library
+(define load-library
(lambda (uname . lib)
(##sys#check-symbol uname 'load-library)
- (or (##sys#load-library-0 uname (and (pair? lib) (car lib)))
+ (or (load-library-0 uname (and (pair? lib) (car lib)))
(##sys#error 'load-library "unable to load library" uname _dlerror) ) ) )
-(define load-library ##sys#load-library)
+(define ##sys#load-library load-library)
(define ##sys#include-forms-from-file
(let ((with-input-from-file with-input-from-file)
@@ -1193,7 +1185,7 @@
(if (##sys#fudge 22) ; private repository?
(foreign-value "C_private_repository_path()" c-string)
(or (get-environment-variable repository-environment-variable)
- (##sys#chicken-prefix
+ (chicken-prefix
(##sys#string-append
"lib/chicken/"
(##sys#number->string (##sys#fudge 42))) )
@@ -1229,25 +1221,25 @@
(or (check pa)
(loop (##sys#slot paths 1)) ) ) ) ) ) ) ))
-(define ##sys#loaded-extensions '())
+(define loaded-extensions '())
-(define ##sys#load-extension
+(define load-extension
(let ((string->symbol string->symbol))
(lambda (id loc #!optional (err? #t))
(cond ((string? id) (set! id (string->symbol id)))
(else (##sys#check-symbol id loc)) )
(let ([p (##sys#canonicalize-extension-path id loc)])
- (cond ((member p ##sys#loaded-extensions))
+ (cond ((member p loaded-extensions))
((or (memq id ##sys#core-library-units)
(memq id ##sys#core-syntax-units))
- (or (##sys#load-library-0 id #f)
+ (or (load-library-0 id #f)
(and err?
(##sys#error loc "cannot load core library" id))))
(else
(let ([id2 (##sys#find-extension p #f)])
(cond (id2
(load/internal id2 #f)
- (set! ##sys#loaded-extensions (cons p ##sys#loaded-extensions))
+ (set! loaded-extensions (cons p loaded-extensions))
#t)
(err? (##sys#error loc "cannot load extension" id))
(else #f) ) ) ) ) ) ) ) )
@@ -1257,23 +1249,21 @@
(lambda (id)
(##sys#check-symbol id 'provide)
(let ([p (##sys#canonicalize-extension-path id 'provide)])
- (set! ##sys#loaded-extensions (cons p ##sys#loaded-extensions)) ) )
+ (set! loaded-extensions (cons p loaded-extensions))))
ids) )
(define ##sys#provide provide)
(define (provided? id)
- (and (member (##sys#canonicalize-extension-path id 'provided?) ##sys#loaded-extensions)
+ (and (member (##sys#canonicalize-extension-path id 'provided?) loaded-extensions)
#t) )
-(define ##sys#provided? provided?)
-
(define (require . ids)
- (for-each (cut ##sys#load-extension <> 'require) ids))
+ (for-each (cut load-extension <> 'require) ids))
(define ##sys#require require)
-(define ##sys#extension-information
+(define extension-information/internal
(let ([with-input-from-file with-input-from-file]
[string-append string-append]
[read read] )
@@ -1286,9 +1276,9 @@
(else #f) ) ) ) ) ))
(define (extension-information ext)
- (##sys#extension-information ext 'extension-information) )
+ (extension-information/internal ext 'extension-information))
-(define ##sys#lookup-runtime-requirements
+(define lookup-runtime-requirements
(let ([with-input-from-file with-input-from-file]
[read read] )
(lambda (ids)
@@ -1296,8 +1286,8 @@
(if (null? ids)
'()
(append
- (or (and-let* ([info (##sys#extension-information (car ids) #f)]
- [a (assq 'require-at-runtime info)] )
+ (or (and-let* ((info (extension-information/internal (car ids) #f))
+ (a (assq 'require-at-runtime info)))
(cdr a) )
'() )
(loop1 (cdr ids)) ) ) ) ) ) )
@@ -1334,7 +1324,7 @@
impid #t)
#t id) )
((memq id ##sys#explicit-library-modules)
- (let* ((info (##sys#extension-information id 'require-extension))
+ (let* ((info (extension-information/internal id 'require-extension))
(nr (and info (assq 'import-only info)))
(s (and info (assq 'syntax info))))
(values
@@ -1349,7 +1339,7 @@
impid #f))
#t id) ) )
(else
- (let ((info (##sys#extension-information id 'require-extension)))
+ (let ((info (extension-information/internal id 'require-extension)))
(cond (info
(let ((s (assq 'syntax info))
(nr (assq 'import-only info))
@@ -1660,11 +1650,11 @@
;;; SRFI-10:
-(define ##sys#sharp-comma-reader-ctors (make-vector 301 '()))
+(define sharp-comma-reader-ctors (make-vector 301 '()))
(define (define-reader-ctor spec proc)
(##sys#check-symbol spec 'define-reader-ctor)
- (##sys#hash-table-set! ##sys#sharp-comma-reader-ctors spec proc) )
+ (##sys#hash-table-set! sharp-comma-reader-ctors spec proc))
(set! ##sys#user-read-hook
(let ((old ##sys#user-read-hook)
@@ -1680,7 +1670,7 @@
(let ([spec (##sys#slot exp 0)])
(if (not (symbol? spec))
(err)
- (let ((ctor (##sys#hash-table-ref ##sys#sharp-comma-reader-ctors spec)))
+ (let ((ctor (##sys#hash-table-ref sharp-comma-reader-ctors spec)))
(if ctor
(apply ctor (##sys#slot exp 1))
(##sys#read-error port "undefined sharp-comma constructor" spec) ) ) ) ) ) ) )
Trap