1; Part of Scheme 48 1.9.  See file COPYING for notices and license.
2
3; Authors: Richard Kelsey, Jonathan Rees, Michael Sperber, Marcus Crestani, Robert Ransom
4
5; Generate filenames.make from *-packages.scm.
6
7; Define DEFINE-STRUCTURE and friends
8(for-each load
9	  '("scheme/bcomp/module-language.scm"
10	    "scheme/alt/dummy-interface.scm"
11	    "scheme/alt/config.scm"
12	    "scheme/env/flatload.scm"))
13
14; The following bogus structures are required in order to load
15; scheme/more-interfaces.scm.
16(define ascii      (structure (make-simple-interface 'ascii      '())))
17(define bitwise    (structure (make-simple-interface 'bitwise    '())))
18(define vm-data    (structure (make-simple-interface 'vm-data    '())))
19(define enumerated (structure (make-simple-interface 'enumerated '())))
20(define tables     (structure (make-simple-interface 'tables     '())))
21(define cells      (structure (make-simple-interface 'cells      '())))
22(define platform   (structure (make-simple-interface 'structure  '())))
23
24; The following loads are unnecessary; they only serve to suppress
25; annoying "undefined" warnings for interfaces.
26(for-each load
27	  '("scheme/interfaces.scm"
28	    "scheme/vm/shared-interfaces.scm"
29	    "scheme/more-interfaces.scm"
30	    "scheme/sort/interfaces.scm"))
31
32(load-configuration "scheme/packages.scm")
33
34; The following defines are unnecessary; they only serve to suppress
35; annoying "undefined" warnings for some forward references.
36(define methods 0)
37(define tables 0)
38
39(define exceptions #f) ; avoid undefined warning
40
41(flatload linker-structures)
42
43(set! exceptions low-exceptions) ; so we don't have to import low-exceptions in the linker
44
45(define q-f (all-file-names link-config))
46
47; (display "Initial structures") (newline)
48(flatload initial-structures)
49
50(define scheme (make-scheme environments evaluation))
51
52(define initial-system
53  (structure (export)
54    (open ;; Cf. initial.scm
55	  (make-initial-system scheme (make-mini-command scheme))
56	  module-system
57	  ensures-loaded
58	  for-reification))) ;foo...
59
60(define i-f (all-file-names initial-system))
61
62; (display "Usual structures") (newline)
63(flatload usual-structures)
64
65(define u-f (all-file-names usual-features initial-system))
66
67(define (write-file-names mumble comment . stuff)
68  (comment "This file was generated automatically.")
69  (do ((stuff stuff (cddr stuff)))
70      ((null? stuff))
71    (mumble (car stuff) (cadr stuff))
72    ;; (mumble 'all-files (reverse *all-files*))
73    ))
74
75;; Unix
76
77(begin
78  (display "Writing ") (display "build/filenames.make") (newline)
79  (call-with-output-file "build/filenames.make"
80    (lambda (port)
81      (write-file-names (lambda (name filenames)
82			  (newline port)
83			  (display name port)
84			  (display " = " port)
85			  (for-each (lambda (filename)
86				      (display filename port)
87				      (display " " port))
88				    filenames)
89			  (newline port))
90			(lambda (comment)
91			  (display "# " port)
92			  (display comment port)
93			  (newline port))
94			'initial-files i-f
95			'usual-files u-f
96			'linker-files q-f))))
97
98;; Windows
99
100(begin
101  (display "Writing ") (display "build/filenames.bat") (newline)
102  (call-with-output-file "build/filenames.bat"
103    (lambda (port)
104      (write-file-names (lambda (name filenames)
105			  (newline port)
106			  (display "@set " port)
107			  (display name port)
108			  (display "=" port)
109			  (for-each (lambda (filename)
110				      (display filename port)
111				      (display " " port))
112				    filenames)
113			  (newline port))
114			(lambda (comment)
115			  (display "@rem " port)
116			  (display comment port)
117			  (newline port))
118			'initial-files i-f
119			'usual-files u-f
120			'linker-files q-f))))
121
122