source: project/release/3/match-action/trunk/setup-header.scm @ 8930

Last change on this file since 8930 was 8930, checked in by Kon Lovett, 12 years ago

Canon dir struct

File size: 8.5 KB
Line 
1;;;; setup-header.scm
2;;;; Kon Lovett, May '06
3
4(required-chicken-version 2.5)
5
6;;; Constants & Procedures
7
8(define REPOSITORY-DIRECTORY (repository-path))
9
10(define *version* (if (file-exists? "version") (string-chomp (read-all "version") "\n") "trunk"))
11
12;; These must be kept in synch w/ testbase-results.scm!
13
14(define TESTBASE-DIRECTORY (make-pathname REPOSITORY-DIRECTORY "testbase"))
15
16(define (->symbol obj)
17  (cond
18    [(symbol? obj)  obj]
19    [(string? obj)  (string->symbol obj)]
20    [else           (string->symbol (->string obj))]) )
21
22;; Pathname Constructors
23
24(define (make-filename bn . en)
25  (apply make-pathname #f (->string bn) en) )
26
27(define (make-docu-filename bn)
28  (make-filename bn "html") )
29
30(define (make-dynld-filename bn)
31  (make-filename bn ##sys#load-dynamic-extension) )
32
33(define (make-static-filename bn)
34  (make-filename bn "o") )
35
36(define (make-source-filename bn)
37  (make-filename bn "scm") )
38
39(define (make-exports-filename bn)
40  (make-filename bn "exports") )
41
42(define (make-program-filename bn)
43  (make-filename bn (and (eq? 'windows (software-type)) ".exe")) )
44
45(define (make-repository-pathname bn)
46  (make-pathname REPOSITORY-DIRECTORY bn) )
47
48(define (make-program-pathname dn pn)
49  (make-pathname dn (make-program-filename pn)) )
50
51;;
52
53#;
54(define (installed-program-exists? bn)
55  (or (file-exists? (make-program-pathname (program-path) bn))
56      (file-exists? (make-program-pathname (installation-prefix) bn))) )
57
58;; File Copy Operations
59
60(define (*file-copy fn dn)
61  (let ([fn (->string fn)])
62    (copy-file fn (make-pathname dn fn)) ) )
63
64(define (copy-to-repository fn)
65  (*file-copy (->string fn) REPOSITORY-DIRECTORY) )
66
67(define (copy-to-shared fn)
68  (*file-copy (->string fn) (chicken-home)) )
69
70(define (copy-file-to-test-repository fn)
71  (*file-copy (->string fn) TESTBASE-DIRECTORY) )
72
73(define (copy-testbase-file bn)
74  (copy-file-to-test-repository (make-pathname "tests" (->string bn))) )
75
76;; Install TestBase related file(s)
77
78(define (install-test . flnms)
79  (newline)
80  (print "* Installing TestBase Test-Files in " TESTBASE-DIRECTORY #\:)
81  (for-each
82    (lambda (x)
83      (if (list? x)
84        ; then has extra files (probably test data)
85        (for-each copy-testbase-file x)
86        ; else test is self contained
87        (copy-testbase-file x) ) )
88    flnms) )
89
90;; Options Parsing
91
92(define (parse-install-arguments ver opt)
93  ;
94  (set! ver
95    (cond
96      [(string? ver)  ver]
97      [(symbol? ver)  (eval ver)]
98      [(number? ver)  (number->string ver)]
99      [else           (error "invalid install version argument" ver)]))
100  ;
101  (let ([cmp-args '()] [rqr@run '()] [opt-args '()])
102    (let loop ([lst opt])
103      (if (null? lst)
104        (values ver (reverse cmp-args) rqr@run opt-args)
105        (let ([itm (car lst)])
106          (cond
107            [(pair? itm)
108              (if (eq? 'require-at-runtime (car itm))
109                (set! rqr@run (append (cdr itm) rqr@run))
110                (set! opt-args (cons itm opt-args)) )]
111            [(symbol? itm)
112              (let ([str (symbol->string itm)])
113                (if (char=? #\+ (string-ref str 0))
114                  (set! cmp-args
115                    (append
116                      `(,(string->symbol (substring str 1)) -extend)
117                      cmp-args))
118                  (set! cmp-args (cons itm cmp-args)) ) )]
119            [(atom? itm)
120              (set! cmp-args (cons itm cmp-args))]
121            [else
122              (set! opt-args (cons itm opt-args))])
123          (loop (cdr lst)) )) ) ) )
124
125;;; Operation Macros
126
127;; Note that these can accept quasi-stuff in OPT
128
129(define-macro (compile-dynld DYNFIL . OPT)
130  `(compile
131    -s
132    -O2 -d1
133    ,(make-source-filename DYNFIL)
134    -o ,(make-dynld-filename DYNFIL)
135    -check-imports -emit-exports ,(make-exports-filename DYNFIL)
136    ,@OPT) )
137
138(define-macro (compile-dynld/rename SRCDYNFIL OUTDYNFIL . OPT)
139  `(compile
140    -s
141    -O2 -d1
142    ,(make-source-filename SRCDYNFIL)
143    -o ,(make-dynld-filename OUTDYNFIL)
144    -check-imports -emit-exports ,(make-exports-filename OUTDYNFIL)
145    ,@OPT) )
146
147(define-macro (compile-static SRCSTAFIL . OPT)
148  `(compile
149    -c
150    -O2 -d1
151    ,(make-source-filename SRCSTAFIL)
152    -unit ,SRCSTAFIL
153    -o ,(make-static-filename SRCSTAFIL)
154    -check-imports -emit-exports ,(make-exports-filename SRCSTAFIL)
155    ,@OPT) )
156
157(define-macro (compile-static/rename SRCSTAFIL OUTSTAFIL . OPT)
158  `(compile
159    -c
160    -O2 -d1
161    ,(make-source-filename SRCSTAFIL)
162    -unit ,OUTSTAFIL
163    -o ,(make-static-filename OUTSTAFIL)
164    -check-imports -emit-exports ,(make-exports-filename OUTSTAFIL)
165    ,@OPT) )
166
167;; Note that these cannot accept quasi-stuff in OPT
168
169(define-macro (install-dynld DYNFIL VER . OPT)
170  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
171    `(begin
172      (compile-dynld ,DYNFIL ,@CMP-ARGS)
173      (install-extension ',(->symbol DYNFIL)
174        '(,(make-dynld-filename DYNFIL) )
175        '(,@OPT-ARGS
176          ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
177          (version ,VERSTR)
178          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )
179
180(define-macro (install-dynld+docu DYNFIL VER . OPT)
181  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
182    `(begin
183      (compile-dynld ,DYNFIL ,@CMP-ARGS)
184      (install-extension ',(->symbol DYNFIL)
185        '(,(make-dynld-filename DYNFIL)
186          ,(make-docu-filename DYNFIL) )
187        '(,@OPT-ARGS
188          ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
189          (documentation ,(make-docu-filename DYNFIL))
190          (version ,VERSTR)
191          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )
192
193(define-macro (install-dynld+source DYNFIL VER . OPT)
194  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
195    `(begin
196      (compile-dynld ,DYNFIL ,@CMP-ARGS)
197      (install-extension ',(->symbol DYNFIL)
198        '(,(make-dynld-filename DYNFIL)
199          ,(make-source-filename DYNFIL) )
200        '(,@OPT-ARGS
201          ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
202          (version ,VERSTR)
203          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )
204
205(define-macro (install-dynld+source+docu DYNFIL VER . OPT)
206  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
207    `(begin
208      (compile-dynld ,DYNFIL ,@CMP-ARGS)
209      (install-extension ',(->symbol DYNFIL)
210        '(,(make-dynld-filename DYNFIL)
211          ,(make-source-filename DYNFIL)
212          ,(make-docu-filename DYNFIL) )
213        '(,@OPT-ARGS
214          ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
215          (documentation ,(make-docu-filename DYNFIL))
216          (version ,VERSTR)
217          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )
218
219(define-macro (install-syntax SYNFIL VER . OPT)
220  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
221    `(install-extension ',(->symbol SYNFIL)
222      '(,(make-source-filename SYNFIL) )
223      '(,@OPT-ARGS
224        ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
225        (version ,VERSTR)
226        (syntax) ) ) ) )
227
228(define-macro (install-syntax+docu SYNFIL VER . OPT)
229  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
230    `(install-extension ',(->symbol SYNFIL)
231      '(,(make-source-filename SYNFIL)
232        ,(make-docu-filename SYNFIL) )
233      '(,@OPT-ARGS
234        ,@(if (null? RQR@RUN) '() `((require-at-runtime ,@RQR@RUN)))
235        (version ,VERSTR)
236        (documentation ,(make-docu-filename SYNFIL))
237        (syntax) ) ) ) )
238
239(define-macro (install-dynld+syntax SYNFIL DYNFIL VER . OPT)
240  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
241    `(begin
242      (compile-dynld ,DYNFIL ,@CMP-ARGS)
243      (install-extension ',(->symbol SYNFIL)
244        '(,(make-source-filename SYNFIL)
245          ,(make-dynld-filename DYNFIL) )
246        '(,@OPT-ARGS
247          (syntax)
248          (require-at-runtime ,(->symbol DYNFIL) ,@RQR@RUN)
249          (version ,VERSTR)
250          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )
251
252(define-macro (install-dynld+syntax+docu SYNFIL DYNFIL VER . OPT)
253  (let-values (([VERSTR CMP-ARGS RQR@RUN OPT-ARGS] (parse-install-arguments VER OPT)))
254    `(begin
255      (compile-dynld ,DYNFIL ,@CMP-ARGS)
256      (install-extension ',(->symbol SYNFIL)
257        '(,(make-docu-filename SYNFIL)
258          ,(make-source-filename SYNFIL)
259          ,(make-dynld-filename DYNFIL) )
260        '(,@OPT-ARGS
261          (documentation ,(make-docu-filename SYNFIL))
262          (syntax)
263          (require-at-runtime ,(->symbol DYNFIL) ,@RQR@RUN)
264          (version ,VERSTR)
265          (exports ,(make-exports-filename DYNFIL)) ) ) ) ) )
Note: See TracBrowser for help on using the repository browser.