source: project/release/4/setup-helper/tags/1.1.4/setup-helper.scm @ 15930

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

setup-helper release 1.1.4

File size: 7.6 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) 
65  (copy-file-to-directory 
66   fn (or (and (installation-prefix) 
67               (make-pathname (installation-prefix) "share/chicken"))
68          (chicken-home))))
69
70;; SRFI-29 Bundle Support
71
72(define install-srfi-29-bundle)
73(let ((*srfi-29-bundles-directory* (make-repository-pathname "srfi-29-bundles")))
74  (define (srfi-29-bundle-directory spec)
75    (if (null? spec) *srfi-29-bundles-directory*
76        (make-directory (append (list *srfi-29-bundles-directory*) spec)) ) )
77  (set! install-srfi-29-bundle
78    (lambda (nam . spec)
79      (unless (directory? *srfi-29-bundles-directory*)
80        (error "missing SRFI-29 bundles directory; please install SRFI-29") )
81      (let* ((spec (map ->string spec))
82             (nam (->string nam))
83             (dir (srfi-29-bundle-directory spec)) )
84        (copy-file (make-pathname (append '(".") spec) nam)
85                   (make-pathname dir nam)
86                   #t) ) ) ) )
87
88;; Compile Support
89
90(define default-static-compile-options (make-parameter '(-c -optimize-level 2 -debug-level 1)))
91(define default-shared-compile-options (make-parameter '(-shared -optimize-level 2 -debug-level 1)))
92(define default-import-compile-options (make-parameter '(-shared -optimize-level 3 -debug-level 0)))
93
94(define (compile-static nam #!key (options '()) inline?)
95  (compile
96    ,(source-filename nam)
97    ,@(default-static-compile-options)
98    -unit ,nam
99    ,@(if (memq '-output-file options) '() `(-output-file ,(static-filename nam)))
100    ,@(if inline? `(-emit-inline-file ,(inline-filename nam)) '())
101    ,@options) )
102
103(define (compile-shared nam #!key (options '()) inline?)
104  (compile
105    ,(source-filename nam)
106    ,@(default-shared-compile-options)
107    ,@(if (memq '-output-file options) '() `(-output-file ,(shared-filename nam)))
108    ,@(if inline? `(-emit-inline-file ,(inline-filename nam)) '())
109    ,@options) )
110
111(define (compile-shared-module nam #!key (options '()) inline?)
112  (compile
113    ,(source-filename nam)
114    ,@(default-shared-compile-options)
115    ,@(if (memq '-output-file options) '() `(-output-file ,(shared-filename nam)))
116    -emit-import-library ,nam
117    ,@(if inline? `(-emit-inline-file ,(inline-filename nam)) '())
118    ,@options)
119  (compile
120    ,(source-import-filename nam)
121    ,@(default-import-compile-options)
122    -output-file ,(shared-import-filename nam)) )
123
124;; Install Support
125
126(define default-static-install-options (make-parameter '()))
127(define default-shared-install-options (make-parameter '()))
128(define default-shared-module-install-options (make-parameter '()))
129(define default-shared+static-module-install-options (make-parameter '()))
130
131(define (install-static-extension nam ver #!key (options '()) (files '()) output-file?)
132  (install-extension nam
133   `(,@(if output-file? '() `(,(static-filename nam))) ,@files)
134   `(,@(default-static-install-options)
135     (version ,ver)
136     (static ,(static-filename nam))
137     (documentation ,(document-filename nam))
138     ,@options)) )
139
140(define (install-shared-extension nam ver #!key (options '()) (files '()) output-file?)
141  (install-extension nam
142   `(,@(if output-file? '() `(,(shared-filename nam))) ,@files)
143   `(,@(default-shared-install-options)
144     (version ,ver)
145     (documentation ,(document-filename nam))
146     ,@options)) )
147
148(define (install-shared-extension-module nam ver #!key (options '()) (files '()) output-file?)
149  (install-extension nam
150   `(,@(if output-file? '() `(,(shared-filename nam)))
151     ,(shared-import-filename nam)
152     ,@files)
153   `(,@(default-shared-module-install-options)
154     (version ,ver)
155     (documentation ,(document-filename nam))
156     ,@options)) )
157
158(define (install-shared+static-extension-module nam ver
159          #!key (options '()) (files '()) shared-output-file? static-output-file?)
160  (install-extension nam
161   `(,@(if shared-output-file? '() `(,(shared-filename nam)))
162     ,(shared-import-filename nam)
163     ,@(if static-output-file? '() `((static-filename nam)))
164     ,@files)
165   `(,@(default-shared+static-module-install-options)
166     (version ,ver)
167     (static ,(static-filename nam))
168     (documentation ,(document-filename nam))
169     ,@options)) )
170
171;; Setup Support
172
173(define (setup-static-extension nam ver
174          #!key (compile-options '()) inline? (install-options '()) (files '()))
175  (and-let* ((of (memq '-output-file compile-options)))
176    (set! files (append files (list (cadr of)))) )
177  (compile-static nam options: compile-options inline?: inline?)
178  (install-static-extension nam ver options: install-options files: files) )
179
180(define (setup-shared-extension nam ver
181          #!key (compile-options '()) inline? (install-options '()) (files '()))
182  (and-let* ((of (memq '-output-file compile-options)))
183    (set! files (append files (list (cadr of)))) )
184  (compile-shared nam options: compile-options inline?: inline?)
185  (install-shared-extension nam ver options: install-options files: files) )
186
187(define (setup-shared-extension-module nam ver
188          #!key (compile-options '()) inline? (install-options '()) (files '()))
189  (and-let* ((of (memq '-output-file compile-options)))
190    (set! files (append files (list (cadr of)))) )
191  (compile-shared-module nam options: compile-options inline?: inline?)
192  (install-shared-extension-module nam ver options: install-options files: files) )
193
194(define (setup-shared+static-extension-module nam ver
195          #!key (shared-compile-options '()) shared-inline?
196                (static-compile-options '()) static-inline?
197                (install-options '()) (files '()))
198  (compile-static nam options: static-compile-options inline?: static-inline?)
199  (compile-shared-module nam options: shared-compile-options inline?: shared-inline?)
200  (install-shared+static-extension-module nam ver options: install-options files: files) )
201
202;; Empty "Conglomerate" Extension Support
203
204(define (install-extension-tag nam ver) (install-extension nam '() `((version ,ver))))
Note: See TracBrowser for help on using the repository browser.