source: project/release/5/compile-file/trunk/compile-file.scm @ 34718

Last change on this file since 34718 was 34718, checked in by sjamaan, 18 months ago

release/5: Replace use by import in eggs

File size: 1.5 KB
Line 
1;;;; compile-file.scm - Programmatic compiler invocation
2
3(declare
4  (unit compile-file)
5  (fixnum-arithmetic))
6
7(module compile-file
8  (compile-file compile-file-options)
9
10(import (chicken)
11        (chicken file)
12        (chicken foreign)
13        (chicken format)
14        (chicken pathname)
15        (chicken process)
16        (chicken string)
17        ;; rename "load" to avoid conflict with keyword argument
18        (rename (scheme) (load load-file)))
19
20(define compile-file-options
21  (make-parameter '("-O2" "-d2")))
22
23(define compile-file
24  (let ((csc (foreign-value "C_CSC_PROGRAM" c-string))
25        (path (foreign-value "C_INSTALL_BIN_HOME" c-string)))
26    (lambda (filename #!key options output-file (load #t) verbose)
27      (let* ((cscpath (or (file-exists? (make-pathname path csc)) "csc"))
28             (tmpfile (and (not output-file) (create-temporary-file "so")))
29             (crapshell (eq? (build-platform) 'mingw32))
30             (cmd (sprintf "~a~a -s ~a ~a -o ~a~a"
31                    (if crapshell "\"" "")
32                    (qs cscpath)
33                    (string-intersperse
34                     (or options
35                         (compile-file-options)))
36                    (qs filename)
37                    (qs (or output-file tmpfile))
38                    (if crapshell "\"" ""))))
39        (when verbose (print "  " cmd))
40        (let ((status (system cmd)))
41          (cond ((zero? status)
42                 (unless output-file
43                   (on-exit
44                    (lambda ()
45                      (handle-exceptions ex #f (delete-file* tmpfile)))))
46                 (when load
47                   (let ((f (or output-file tmpfile)))
48                     (handle-exceptions ex
49                         (begin
50                           (delete-file* f)
51                           (abort ex))
52                       (load-file f)
53                       f))))
54                (else #f))))))))
Note: See TracBrowser for help on using the repository browser.