source: project/release/5/compile-file/tags/1.0/compile-file.scm @ 35590

Last change on this file since 35590 was 35590, checked in by evhan, 3 years ago

compile-file: Add to egg-locations and tag version 1.0

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