Merge branch '268-dev'

cyclone.scm

@@ -21,7 +21,8 @@
         (scheme cyclone primitives)
         (scheme cyclone transforms)
         (scheme cyclone cps-optimizations)
-        (scheme cyclone libraries))
+        (scheme cyclone libraries)
+        (srfi 18))
 
 (define *fe:batch-compile* #t) ;; Batch compilation. TODO: default to false or true??
 (define *optimization-level* 2) ;; Default level
@@ -721,9 +722,7 @@
     in-prog))
 
 ;; Compile and emit:
-(define (run-compiler args cc? cc-prog cc-exec cc-lib cc-so 
+(define (run-compiler args append-dirs prepend-dirs)
-                      cc-opts cc-prog-linker-opts cc-prog-linker-objs 
-                      append-dirs prepend-dirs)
   (let* ((in-file (car args))
          (expander (base-expander))
          (in-prog-raw (read-file in-file))
@@ -754,17 +753,6 @@
                    " "
                    lib-options)
                  lib-options)))
-         ;; Only read C compiler options from module being compiled
-         (cc-opts*
-          (cond
-            (program? 
-              (string-join ;; Check current program for options
-                (program-c-compiler-opts! in-prog)
-                " "))
-            (else
-              (string-join 
-                (lib:c-compiler-options (car in-prog)) 
-                " "))))
          (exec-file (basename in-file))
          (src-file (string-append exec-file ".c"))
          (meta-file (string-append exec-file ".meta"))
@@ -803,13 +791,85 @@
                      lib-deps)
                    in-file 
                    append-dirs 
-                   prepend-dirs)))))
+                   prepend-dirs))))))
-         (result (create-c-file in-prog)))
+    (create-c-file in-prog)
+    (cond
+     (program?
+      ;; Use .meta file to store information for C compiler phase
+      (save-program-metadata meta-file lib-deps c-linker-options))
+     (else
+      ;; Emit .meta file
+      (with-output-to-file
+        meta-file
+        (lambda ()
+          (display ";; This file was automatically generated by the Cyclone Scheme compiler")
+          (newline)
+          (write (macro:get-defined-macros))))))))
 
+(define (save-program-metadata filename lib-deps c-linker-options)
+  (with-output-to-file
+    filename
+    (lambda ()
+      (display ";; This file was automatically generated by the Cyclone Scheme compiler")
+      (newline)
+      (write `(lib-deps . ,lib-deps))
+      (newline)
+      (write `(c-linker-options . ,c-linker-options)))))
+
+(define (load-program-metadata filename)
+  (let ((data (call-with-input-file filename  read-all)))
+    (delete-file filename)
+    data))
+
+(define (get-meta meta symbol default)
+  (if (assoc symbol meta)
+      (cdr (assoc symbol meta))
+      default))
+
+(define (run-external-compiler 
+           args append-dirs prepend-dirs
+           cc? cc-prog cc-exec cc-lib cc-so 
+           cc-opts cc-prog-linker-opts cc-prog-linker-objs)
+  (let* ((in-file (car args))
+         (expander (base-expander))
+         (in-prog-raw (read-file in-file))
+         (program? (not (library? (car in-prog-raw))))
+         (in-prog
+          (cond
+            (program? 
+              (Cyc-add-feature! 'program) ;; Load special feature
+              ;; TODO: what about top-level cond-expands in the program?
+              in-prog-raw)
+            (else
+              ;; Account for any cond-expand declarations in the library
+              (list (lib:cond-expand (car in-prog-raw) expander)))))
+         ;; Only read C compiler options from module being compiled
+         (cc-opts*
+          (cond
+            (program? 
+              (string-join ;; Check current program for options
+                (program-c-compiler-opts! in-prog)
+                " "))
+            (else
+              (string-join 
+                (lib:c-compiler-options (car in-prog)) 
+                " "))))
+         (exec-file (basename in-file))
+         (src-file (string-append exec-file ".c"))
+         (meta-file (string-append exec-file ".meta"))
+         (get-comp-env 
+           (lambda (sym str)
+             (if (> (string-length str) 0)
+                 str
+                 (Cyc-compilation-environment sym)))) 
+        )
     ;; Compile the generated C file
     (cond
       (program?
-        (letrec ((objs-str 
+        (letrec ((metadata (load-program-metadata meta-file))
+                 (c-linker-options (get-meta metadata 'c-linker-options '()))
+                 (lib-deps (get-meta metadata 'lib-deps '()))
+                 (objs-str 
                   (string-append
                     cc-prog-linker-objs
                     (apply
@@ -857,13 +917,6 @@
               (display comp-objs-cmd)
               (newline)))))
       (else
-        ;; Emit .meta file
-        (with-output-to-file
-          meta-file
-          (lambda ()
-            (display ";; This file was automatically generated by the Cyclone Scheme compiler")
-            (newline)
-            (write (macro:get-defined-macros))))
         ;; Compile library
         (let ((comp-lib-cmd
                (string-append
@@ -930,6 +983,8 @@
                 ;               (equal? #\- (string-ref arg 0)))))
                 ;   args))
        (compile? #t)
+       (run-scm-compiler? (member "-run-scm-compiler" args))
+       (no-compiler-subprocess (member "-no-compiler-subprocess" args))
        (cc-prog (apply string-append (collect-opt-values args "-CP")))
        (cc-exec (apply string-append (collect-opt-values args "-CE")))
        (cc-lib  (apply string-append (collect-opt-values args "-CL")))
@@ -1073,7 +1128,28 @@ Debug options:
             (cdr err))
           (newline)
           (exit 1)))
-      (run-compiler non-opts compile? cc-prog cc-exec cc-lib cc-so 
+      (cond
-                    cc-opts cc-linker-opts cc-linker-extra-objects 
+        (run-scm-compiler? 
-                    append-dirs prepend-dirs)))))
+          ;; Compile Scheme code into a C file
+          (run-compiler non-opts append-dirs prepend-dirs))
+        (else
+          ;; Generate the C file
+          (cond
+           (no-compiler-subprocess
+            ;; Special case, we can generate .C file within this process
+            (run-compiler non-opts append-dirs prepend-dirs))
+           (else
+            ;; Normal path is to run another instance of cyclone to generate
+            ;; the .C file. This lets us immediately free those resources once
+            ;; the Scheme compilation is done.
+            (system
+              (string-append 
+                (calling-program) " -run-scm-compiler "
+                (string-join args " ")))))
+          ;; Call the C compiler
+          (run-external-compiler
+            non-opts append-dirs prepend-dirs
+            compile? cc-prog cc-exec cc-lib cc-so 
+            cc-opts cc-linker-opts cc-linker-extra-objects)))
+      ))))