Merge branch 'master' into s-vector-values-g

src/gerbil/compiler/driver.ss

@@ -85,20 +85,25 @@ namespace: gxc
   (unless (string? srcpath)
     (raise-compile-error "Invalid module source path" srcpath))
 
-  (let ((outdir      (pgetq output-dir: opts))
-        (invoke-gsc? (pgetq invoke-gsc: opts))
-        (gsc-options (pgetq gsc-options: opts))
-        (keep-scm?   (pgetq keep-scm: opts))
-        (verbosity   (pgetq verbose: opts))
-        (optimize    (pgetq optimize: opts))
-        (debug       (pgetq debug: opts))
-        (gen-ssxi    (pgetq generate-ssxi: opts))
-        (parallel?   (pgetq parallel: opts)))
+  (let* ((outdir      (pgetq output-dir: opts))
+         (invoke-gsc? (pgetq invoke-gsc: opts))
+         (target      (or (pgetq target: opts) 'C))
+         (gsc-options (append
+		       ["-target" (symbol->string target)]
+		       (or (pgetq gsc-options: opts) [])))
+         (keep-scm?   (pgetq keep-scm: opts))
+         (verbosity   (pgetq verbose: opts))
+         (optimize    (pgetq optimize: opts))
+         (debug       (pgetq debug: opts))
+         (gen-ssxi    (pgetq generate-ssxi: opts))
+         (parallel?   (pgetq parallel: opts)))
+
     (when outdir
       (with-driver-mutex (create-directory* outdir)))
     (when optimize
       (with-driver-mutex (optimizer-info-init!)))
     (parameterize ((current-compile-output-dir outdir)
+                   (current-compilation-target target)
                    (current-compile-invoke-gsc invoke-gsc?)
                    (current-compile-gsc-options gsc-options)
                    (current-compile-keep-scm keep-scm?)
@@ -117,17 +122,21 @@ namespace: gxc
   (unless (string? srcpath)
     (raise-compile-error "Invalid module source path" srcpath))
 
-  (let ((outdir      (pgetq output-dir: opts))
-        (invoke-gsc? (pgetq invoke-gsc: opts))
-        (gsc-options (pgetq gsc-options: opts))
-        (keep-scm?   (pgetq keep-scm: opts))
-        (verbosity   (pgetq verbose: opts))
-        (debug       (pgetq debug: opts))
-        (parallel?   (pgetq parallel: opts)))
+  (let* ((outdir      (pgetq output-dir: opts))
+         (invoke-gsc? (pgetq invoke-gsc: opts))
+         (target      (or (pgetq target: opts) 'C))
+         (gsc-options (append
+		       ["-target" (symbol->string target)]
+		       (or (pgetq gsc-options: opts) [])))
+         (keep-scm?   (pgetq keep-scm: opts))
+         (verbosity   (pgetq verbose: opts))
+         (debug       (pgetq debug: opts))
+         (parallel?   (pgetq parallel: opts)))
     (when outdir
       (with-driver-mutex (create-directory* outdir)))
     (parameterize ((current-compile-output-dir outdir)
                    (current-compile-invoke-gsc invoke-gsc?)
+                   (current-compilation-target target)
                    (current-compile-gsc-options gsc-options)
                    (current-compile-keep-scm keep-scm?)
                    (current-compile-verbose verbosity)

src/gerbil/core/expander.ss

@@ -41,6 +41,7 @@ package: gerbil/core
     current-expander-path
     current-expander-phi
     current-expander-compiling?
+    current-compilation-target
     current-module-reader-path
     current-module-reader-args
     local-context? top-context? module-context? prelude-context?

src/gerbil/core/sugar.ss

@@ -146,7 +146,10 @@ package: gerbil/core
       ((_ message detail ...)
        (stx-string? #'message)
        (apply raise-syntax-error #f (stx-e #'message) stx
-              (syntax->list #'(detail ...)))))))
+              (syntax->list #'(detail ...))))))
+
+  (defrules compilation-target? ()
+    ((_ sym) (eq? (current-compilation-target) 'sym))))
 
 (module Sugar-2
   (import Sugar-1 (phi: +1 Sugar-1))

src/gerbil/expander/core.ss

@@ -37,6 +37,9 @@ namespace: gx
 (def current-expander-compiling?
   (make-parameter #f))
 
+(def current-compilation-target
+  (make-parameter #f))
+
 ;; expander context
 (defstruct expander-context (id table)
   constructor: :init!

src/gerbil/gxc-main.ss

@@ -9,6 +9,7 @@
   (displayln " -h,--help                   display this help message and exit")
   (displayln " -d <dir>                    set compiler output directory; defaults to $GERBIL_PATH/lib")
   (displayln " -exe                        compile an executable")
+  (displayln " -target                     the compilation output target: C or js; defaults to C")
   (displayln " -o <file>                   set executable output file")
   (displayln " -O                          optimize gerbil source")
   (displayln " -full-program-optimization  perform full program optimization")
@@ -29,6 +30,7 @@
 (def (gxc-parse-args args)
   (def outdir (path-expand "lib" (gerbil-path)))
   (def invoke-gsc #t)
+  (def target 'C)
   (def keep-scm #f)
   (def verbose #f)
   (def optimize #f)
@@ -48,6 +50,7 @@
   (def (make-opts)
     [invoke-gsc: invoke-gsc
      keep-scm: keep-scm
+     target: target
      verbose: verbose
      optimize: optimize
      full-program-optimization: full-program-optimization
@@ -127,7 +130,15 @@
               (else
                `("-e" ,include-gambit-sharp)))))
           (lp rest))
-         (("-prelude")
+         (("-target")
+          (match rest
+            ([opt . rest]
+	     (set! target (string->symbol opt))
+             (lp rest))
+            (else
+             (gxc-print-usage!)
+             (exit 1))))
+	 (("-prelude")
           (match rest
             ([opt . rest]
              (add-gsc-option! ["-prelude" opt])