diff --git a/src/build/build-bach.ss b/src/build/build-bach.ss index 98ff619d0..774c17f43 100644 --- a/src/build/build-bach.ss +++ b/src/build/build-bach.ss @@ -41,13 +41,16 @@ (visualc ".obj") (else ".o"))) -(def (path->string-literal path) - (string-append - "\"" - (string-map - (lambda (c) (if (char=? c #\\) #\/ c)) - path) - "\"")) +; generates an `include` form for use in a source code, gsc's -e option etc. +; It takes care of windows paths where we need to escape the path. +; e.g. (displayln (include-source "d:\\gerbil\\mycode.scm")) should print +; (include "d:\\gerbil\\mycode.scm") +; instead of: +; (include "d:\gerbil\mycode.scm") +; which results in an error: +; *** ERROR -- Invalid escaped character: #\g +(def (include-source path) + (string-append "(include " (object->string path) ")")) (def (link-output-options output-bin) (cond-expand @@ -131,6 +134,12 @@ (def (replace-extension path ext) (string-append (path-strip-extension path) ext)) +(def (replace-extension-with-c path) + (replace-extension path ".c")) + +(def (replace-extension-with-object path) + (replace-extension path compiler-obj-suffix)) + ;; first compile the module (displayln "... compile " bach-main) (compile-module (string-append bach-main ".ss") @@ -141,16 +150,15 @@ ;; and then compile the binary (let* ((builtin-modules-scm (map static-file-name builtin-modules)) - (builtin-modules-c (map (cut replace-extension <> ".c") builtin-modules-scm)) - (builtin-modules-o (map (cut replace-extension <> compiler-obj-suffix) builtin-modules-scm)) + (builtin-modules-c (map replace-extension-with-c builtin-modules-scm)) + (builtin-modules-o (map replace-extension-with-object builtin-modules-scm)) (bach-main-scm (static-file-name bach-main)) - (bach-main-c (replace-extension bach-main-scm ".c")) - (bach-main-o (replace-extension bach-main-scm compiler-obj-suffix)) + (bach-main-c (replace-extension-with-c bach-main-scm)) + (bach-main-o (replace-extension-with-object bach-main-scm)) (bach-link-c (path-expand "gerbil-link.c" gerbil-libdir)) (bach-link-o (replace-extension bach-link-c compiler-obj-suffix)) (gambit-sharp (path-expand "_gambit#.scm" gerbil-libdir)) - (include-gambit-sharp - (string-append "(include " (path->string-literal gambit-sharp) ")")) + (include-gambit-sharp (include-source gambit-sharp)) (gsc-gx-macros (if (gerbil-runtime-smp?) ["-e" "(define-cond-expand-feature|enable-smp|)" diff --git a/src/gerbil/compiler/driver.ss b/src/gerbil/compiler/driver.ss index 05e6df6f3..34ef4b5e6 100644 --- a/src/gerbil/compiler/driver.ss +++ b/src/gerbil/compiler/driver.ss @@ -63,13 +63,16 @@ namespace: gxc (visualc ".obj") (else ".o"))) -(def (path->string-literal path) - (string-append - "\"" - (string-map - (lambda (c) (if (char=? c #\\) #\/ c)) - path) - "\"")) +; generates an `include` form for use in a source code, gsc's -e option etc. +; It takes care of windows paths where we need to escape the path. +; e.g. (displayln (include-source "d:\\gerbil\\mycode.scm")) should print +; (include "d:\\gerbil\\mycode.scm") +; instead of: +; (include "d:\gerbil\mycode.scm") +; which results in an error: +; *** ERROR -- Invalid escaped character: #\g +(def (include-source path) + (string-append "(include " (object->string path) ")")) (def gerbil-runtime-modules '("gerbil/runtime/gambit" @@ -187,6 +190,12 @@ namespace: gxc (def (replace-extension path ext) (string-append (path-strip-extension path) ext)) + (def (replace-extension-with-c path) + (replace-extension path ".c")) + + (def (replace-extension-with-object path) + (replace-extension path compiler-obj-suffix)) + (def (userlib-module? ctx) (and (not (exclude-module? ctx)) (not (libgerbil-module? ctx)))) @@ -234,22 +243,22 @@ namespace: gxc (libgerbil-deps (filter libgerbil-module? deps)) (libgerbil-scm (map find-static-module-file libgerbil-deps)) (libgerbil-scm (fold-libgerbil-runtime-scm gerbil-staticdir libgerbil-scm)) - (libgerbil-c (map (cut replace-extension <> ".c") libgerbil-scm)) - (libgerbil-o (map (cut replace-extension <> compiler-obj-suffix) libgerbil-scm)) + (libgerbil-c (map replace-extension-with-c libgerbil-scm)) + (libgerbil-o (map replace-extension-with-object libgerbil-scm)) (src-deps (filter userlib-module? deps)) (src-deps-scm (map find-static-module-file src-deps)) (src-deps-scm (filter not-file-empty? src-deps-scm)) (src-deps-scm (map path-expand src-deps-scm)) - (src-deps-c (map (cut replace-extension <> ".c") src-deps-scm)) - (src-deps-o (map (cut replace-extension <> compiler-obj-suffix) src-deps-scm)) + (src-deps-c (map replace-extension-with-c src-deps-scm)) + (src-deps-o (map replace-extension-with-object src-deps-scm)) (src-bin-scm (find-static-module-file ctx)) (src-bin-scm (path-expand src-bin-scm)) - (src-bin-c (replace-extension src-bin-scm ".c")) - (src-bin-o (replace-extension src-bin-scm compiler-obj-suffix)) + (src-bin-c (replace-extension-with-c src-bin-scm)) + (src-bin-o (replace-extension-with-object src-bin-scm)) (output-bin (path-expand output-bin)) (output-scm (path-expand output-scm)) - (output-c (replace-extension output-scm ".c")) - (output-o (replace-extension output-scm compiler-obj-suffix)) + (output-c (replace-extension-with-c output-scm)) + (output-o (replace-extension-with-object output-scm)) (output_-c (replace-extension output-scm "_.c")) (output_-o (replace-extension output-scm (string-append "_" compiler-obj-suffix))) (gsc-link-opts (gsc-link-options)) @@ -406,7 +415,7 @@ namespace: gxc (gerbil-libdir (path-expand "lib" gerbil-home)) (runtime (map find-static-module-file gerbil-runtime-modules)) (gambit-sharp (path-expand "lib/_gambit#.scm" gerbil-home)) - (include-gambit-sharp (string-append "(include " (path->string-literal gambit-sharp) ")")) + (include-gambit-sharp (include-source gambit-sharp)) (bin-scm (find-static-module-file ctx)) (deps (find-runtime-module-deps ctx)) (deps (map find-static-module-file deps))