source: project/release/4/setup-helper/trunk/setup-helper.scm @ 15870

Last change on this file since 15870 was 15870, checked in by Ivan Raikov, 11 years ago

added (use setup-api) to setup-helper, otherwise required-chicken-version is unbound

File size: 7.5 KB
Line 
1;;;; setup-helper.scm -*- Hen -*-
2;;;; Kon Lovett, Mar '09
3
4
5;;; Release 4 Only!
6(use setup-api) ;; needed for required-chicken-version
7(required-chicken-version 4)
8
9
10;;; Extension Information
11
12(define (verify-extension-name nam)
13  (let ((extnam (->string nam)))
14    (unless (string=? extnam (extension-name))
15      (error "unexpected extension-name" extnam (extension-name)) ) ) )
16
17
18;;; Support
19
20;; Filename Support
21
22(define (filename bn #!optional en) (make-pathname #f (->string bn) (and en (->string en))))
23
24(define (make-directory dir)
25  (cond ((string? dir)  dir)
26        ((symbol? dir)  (symbol->string dir))
27        ((pair? dir)
28          (let ((len (length dir)))
29            (if (= 1 len) (->string (car dir))
30                (make-pathname (map ->string (take dir (sub1 len))) (->string (last dir))) ) ) )
31        (else
32          (warning 'make-directory "unknown argument" dir) ) ) )
33
34(define (document-filename bn) (filename bn "html"))
35
36(define (source-filename bn) (filename bn "scm"))
37
38(define (shared-library-filename bn) (filename bn ##sys#load-library-extension))
39
40(define (shared-filename bn) (filename bn ##sys#load-dynamic-extension))
41
42(define (static-library-filename bn) (filename bn "a"))
43
44(define (static-filename bn) (filename bn "o"))
45
46(define (import-filename bn) (filename bn "import"))
47
48(define (source-import-filename bn) (source-filename (import-filename bn)))
49
50(define (shared-import-filename bn) (shared-filename (import-filename bn)))
51
52(define (inline-filename bn) (filename bn "inline"))
53
54(define (program-filename bn) (filename bn (and (eq? 'windows (software-type)) "exe")))
55
56(define (make-repository-pathname bn) (make-pathname (repository-path) bn))
57
58;; File Support
59
60(define (copy-file-to-directory fn dn) (copy-file fn (make-pathname dn fn)))
61
62(define (copy-to-repository fn) (copy-file-to-directory fn (repository-path)))
63
64(define (copy-to-home fn) (copy-file-to-directory fn (chicken-home)))
65
66;; SRFI-29 Bundle Support
67
68(define install-srfi-29-bundle)
69(let ((*srfi-29-bundles-directory* (make-repository-pathname "srfi-29-bundles")))
70  (define (srfi-29-bundle-directory spec)
71    (if (null? spec) *srfi-29-bundles-directory*
72        (make-directory (append (list *srfi-29-bundles-directory*) spec)) ) )
73  (set! install-srfi-29-bundle
74    (lambda (nam . spec)
75      (unless (directory? *srfi-29-bundles-directory*)
76        (error "missing SRFI-29 bundles directory; please install SRFI-29") )
77      (let* ((spec (map ->string spec))
78             (nam (->string nam))
79             (dir (srfi-29-bundle-directory spec)) )
80        (copy-file (make-pathname (append '(".") spec) nam)
81                   (make-pathname dir nam)
82                   #t) ) ) ) )
83
84;; Compile Support
85
86(define default-static-compile-options (make-parameter '(-c -optimize-level 2 -debug-level 1)))
87(define default-shared-compile-options (make-parameter '(-shared -optimize-level 2 -debug-level 1)))
88(define default-import-compile-options (make-parameter '(-shared -optimize-level 3 -debug-level 0)))
89
90(define (compile-static nam #!key (options '()) inline?)
91  (compile
92    ,(source-filename nam)
93    ,@(default-static-compile-options)
94    -unit ,nam
95    ,@(if (memq '-output-file options) '() `(-output-file ,(static-filename nam)))
96    ,@(if inline? `(-emit-inline-file ,(inline-filename nam)) '())
97    ,@options) )
98
99(define (compile-shared nam #!key (options '()) inline?)
100  (compile
101    ,(source-filename nam)
102    ,@(default-shared-compile-options)
103    ,@(if (memq '-output-file options) '() `(-output-file ,(shared-filename nam)))
104    ,@(if inline? `(-emit-inline-file ,(inline-filename nam)) '())
105    ,@options) )
106
107(define (compile-shared-module nam #!key (options '()) inline?)
108  (compile
109    ,(source-filename nam)
110    ,@(default-shared-compile-options)
111    ,@(if (memq '-output-file options) '() `(-output-file ,(shared-filename nam)))
112    -emit-import-library ,nam
113    ,@(if inline? `(-emit-inline-file ,(inline-filename nam)) '())
114    ,@options)
115  (compile
116    ,(source-import-filename nam)
117    ,@(default-import-compile-options)
118    -output-file ,(shared-import-filename nam)) )
119
120;; Install Support
121
122(define default-static-install-options (make-parameter '()))
123(define default-shared-install-options (make-parameter '()))
124(define default-shared-module-install-options (make-parameter '()))
125(define default-shared+static-module-install-options (make-parameter '()))
126
127(define (install-static-extension nam ver #!key (options '()) (files '()) output-file?)
128  (install-extension nam
129   `(,@(if output-file? '() `(,(static-filename nam))) ,@files)
130   `(,@(default-static-install-options)
131     (version ,ver)
132     (static ,(static-filename nam))
133     (documentation ,(document-filename nam))
134     ,@options)) )
135
136(define (install-shared-extension nam ver #!key (options '()) (files '()) output-file?)
137  (install-extension nam
138   `(,@(if output-file? '() `(,(shared-filename nam))) ,@files)
139   `(,@(default-shared-install-options)
140     (version ,ver)
141     (documentation ,(document-filename nam))
142     ,@options)) )
143
144(define (install-shared-extension-module nam ver #!key (options '()) (files '()) output-file?)
145  (install-extension nam
146   `(,@(if output-file? '() `(,(shared-filename nam)))
147     ,(shared-import-filename nam)
148     ,@files)
149   `(,@(default-shared-module-install-options)
150     (version ,ver)
151     (documentation ,(document-filename nam))
152     ,@options)) )
153
154(define (install-shared+static-extension-module nam ver
155          #!key (options '()) (files '()) shared-output-file? static-output-file?)
156  (install-extension nam
157   `(,@(if shared-output-file? '() `(,(shared-filename nam)))
158     ,(shared-import-filename nam)
159     ,@(if static-output-file? '() `((static-filename nam)))
160     ,@files)
161   `(,@(default-shared+static-module-install-options)
162     (version ,ver)
163     (static ,(static-filename nam))
164     (documentation ,(document-filename nam))
165     ,@options)) )
166
167;; Setup Support
168
169(define (setup-static-extension nam ver
170          #!key (compile-options '()) inline? (install-options '()) (files '()))
171  (and-let* ((of (memq '-output-file compile-options)))
172    (set! files (append files (list (cadr of)))) )
173  (compile-static nam options: compile-options inline?: inline?)
174  (install-static-extension nam ver options: install-options files: files) )
175
176(define (setup-shared-extension nam ver
177          #!key (compile-options '()) inline? (install-options '()) (files '()))
178  (and-let* ((of (memq '-output-file compile-options)))
179    (set! files (append files (list (cadr of)))) )
180  (compile-shared nam options: compile-options inline?: inline?)
181  (install-shared-extension nam ver options: install-options files: files) )
182
183(define (setup-shared-extension-module nam ver
184          #!key (compile-options '()) inline? (install-options '()) (files '()))
185  (and-let* ((of (memq '-output-file compile-options)))
186    (set! files (append files (list (cadr of)))) )
187  (compile-shared-module nam options: compile-options inline?: inline?)
188  (install-shared-extension-module nam ver options: install-options files: files) )
189
190(define (setup-shared+static-extension-module nam ver
191          #!key (shared-compile-options '()) shared-inline?
192                (static-compile-options '()) static-inline?
193                (install-options '()) (files '()))
194  (compile-static nam options: static-compile-options inline?: static-inline?)
195  (compile-shared-module nam options: shared-compile-options inline?: shared-inline?)
196  (install-shared+static-extension-module nam ver options: install-options files: files) )
197
198;; Empty "Conglomerate" Extension Support
199
200(define (install-extension-tag nam ver) (install-extension nam '() `((version ,ver))))
Note: See TracBrowser for help on using the repository browser.