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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
; Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Generate filenames.make from *-packages.scm.
; Define DEFINE-STRUCTURE and friends
(for-each load
'("scheme/bcomp/module-language.scm"
"scheme/alt/dummy-interface.scm"
"scheme/alt/config.scm"
"scheme/env/flatload.scm"))
; The following bogus structures are required in order to load
; scheme/more-interfaces.scm.
(define ascii (structure (make-simple-interface 'ascii '())))
(define bitwise (structure (make-simple-interface 'bitwise '())))
(define vm-data (structure (make-simple-interface 'vm-data '())))
(define enumerated (structure (make-simple-interface 'enumerated '())))
(define tables (structure (make-simple-interface 'tables '())))
(define cells (structure (make-simple-interface 'cells '())))
(define platform (structure (make-simple-interface 'structure '())))
; The following loads are unnecessary; they only serve to suppress
; annoying "undefined" warnings for interfaces.
(for-each load
'("scheme/interfaces.scm"
"scheme/vm/shared-interfaces.scm"
"scheme/more-interfaces.scm"
"scheme/sort/interfaces.scm"))
(load-configuration "scheme/packages.scm")
; The following defines are unnecessary; they only serve to suppress
; annoying "undefined" warnings for some forward references.
(define methods 0)
(define tables 0)
(flatload linker-structures)
(define q-f (all-file-names link-config))
; (display "Initial structures") (newline)
(flatload initial-structures)
(define scheme (make-scheme environments evaluation))
(define initial-system
(structure (export)
(open ;; Cf. initial.scm
(make-initial-system scheme (make-mini-command scheme))
module-system
ensures-loaded
for-reification))) ;foo...
(define i-f (all-file-names initial-system))
; (display "Usual structures") (newline)
(flatload usual-structures)
(define u-f (all-file-names usual-features initial-system))
(define (write-file-names mumble comment . stuff)
(comment "#### This file was generated automatically. ####")
(do ((stuff stuff (cddr stuff)))
((null? stuff))
(mumble (car stuff) (cadr stuff))
;; (mumble 'all-files (reverse *all-files*))
))
;; Unix
(begin
(display "Writing ") (display "build/filenames.make") (newline)
(call-with-output-file "build/filenames.make"
(lambda (port)
(write-file-names (lambda (name filenames)
(newline port)
(display name port)
(display " = " port)
(for-each (lambda (filename)
(display filename port)
(display " " port))
filenames)
(newline port))
(lambda (comment)
(display "#" port)
(display comment port)
(newline port))
'initial-files i-f
'usual-files u-f
'linker-files q-f))))
;; Windows
(begin
(display "Writing ") (display "build/filenames.bat") (newline)
(call-with-output-file "build/filenames.bat"
(lambda (port)
(write-file-names (lambda (name filenames)
(newline port)
(display "@set " port)
(display name port)
(display "=" port)
(for-each (lambda (filename)
(display filename port)
(display " " port))
filenames)
(newline port))
(lambda (comment)
(display "@rem " port)
(display comment port)
(newline port))
'initial-files i-f
'usual-files u-f
'linker-files q-f))))
|
