1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Ivan Shmakov, Mike Sperber
; This file contains things that tie together the compiler and the
; run-time system.
; EVAL
(define (eval form package)
(compile-and-run (list form) package #f #f))
; LOAD-INTO - load file into package.
(define (load-into filename package)
(really-load-into filename package #f #f))
(define (load-script-into filename package)
(really-load-into filename package #f #t))
; Evaluate forms as if they came from the given file.
(define (eval-from-file forms package filename)
(if filename
((fluid-cell-ref $note-file-package)
filename package))
(compile-and-run forms package filename #t))
; LOAD
(define (load filename . package-option)
(let ((package (if (null? package-option)
(interaction-environment)
(car package-option))))
(really-load-into filename package #t #f)))
;----------------
(define (really-load-into filename package note-undefined? script?)
(force-output (current-output-port)) ; just to make the output nice
(let ((forms (read-forms filename package script?)))
(newline (current-noise-port)) ; READ-FORMS prints the filename
(compile-and-run forms
package
filename
note-undefined?)))
(define (compile-and-run forms package maybe-filename note-undefined?)
(let* ((env (if maybe-filename
(bind-source-file-name maybe-filename
(package->environment package))
(package->environment package)))
(template (compile-forms (map (lambda (form)
(delay (expand-scanned-form form env)))
(scan-forms forms env))
maybe-filename
(package-uid package))))
(link! template package note-undefined?)
(with-load-filename maybe-filename
(lambda ()
(invoke-closure
(make-closure template
(package-uid package)))))))
(define $load-filename (make-fluid (make-cell #f)))
(define (with-load-filename filename thunk)
(let-fluid $load-filename (make-cell filename)
thunk))
(define (current-load-filename)
(fluid-cell-ref $load-filename))
|
