diff --git a/Makefile b/Makefile index b76e0a0..49035d5 100644 --- a/Makefile +++ b/Makefile @@ -110,6 +110,18 @@ test-r7rs-docker: docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} . docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c "make SCHEME=${SCHEME} test-r7rs" +test-r7rs-wine: + rm -rf ${R7RSTMP} + mkdir -p ${R7RSTMP} + cp -r r7rs-testfiles/* ${R7RSTMP}/ + cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} COMPILE_R7RS_TARGET_OS=windows compile-r7rs -I ./libs -o main main.scm + -cd ${R7RSTMP} && wine main.bat 1 2 3 > test-result.txt 2>&1 + @grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1) + +test-r7rs-wine-docker: + docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} . + docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c "make SCHEME=${SCHEME} test-r7rs" + clean: rm -rf test-r7rs rm -rf compile-r7rs diff --git a/compile-r7rs.scm b/compile-r7rs.scm index 79d5a69..e2d8de0 100644 --- a/compile-r7rs.scm +++ b/compile-r7rs.scm @@ -9,17 +9,20 @@ (libs library-util) (srfi 170)) -(when (member "--list-r6rs-schemes" (command-line)) +(when (or (member "--list-r6rs" (command-line)) + (member "--list-r6rs-schemes" (command-line))) (for-each (lambda (scheme) (display scheme) (display " ")) r6rs-schemes) (newline) (exit 0)) -(when (member "--list-r7rs-schemes" (command-line)) +(when (or (member "--list-r7rs" (command-line)) + (member "--list-r7rs-schemes" (command-line))) (for-each (lambda (scheme) (display scheme) (display " ")) r7rs-schemes) (newline) (exit 0)) -(when (member "--list-schemes" (command-line)) +(when (or (member "--list" (command-line)) + (member "--list-schemes" (command-line))) (for-each (lambda (scheme) (display scheme) (display " ")) all-schemes) (newline) (exit 0)) @@ -32,10 +35,11 @@ (newline (current-error-port)) (exit 1)) (when (not (assoc scheme data)) (error "Unsupported implementation" scheme)) -(define compilation-target (if (get-environment-variable "TARGET") - (get-environment-variable "TARGET") - (cond-expand (windows "windows") - (else "unix")))) +(define compilation-target + (if (get-environment-variable "COMPILE_R7RS_TARGET_OS") + (string->symbol (get-environment-variable "COMPILE_R7RS_TARGET_OS")) + (cond-expand (windows 'windows) + (else 'unix)))) (define input-file (let ((input-file #f)) @@ -152,12 +156,21 @@ (define scheme-command (apply (cdr (assoc 'command (cdr (assoc scheme data)))) - (list (if input-file input-file "") - (if output-file output-file "") - prepend-directories - append-directories - library-files - r6rs?))) + (list + (cond ((symbol=? compilation-target 'windows) "") + (else "exec")) + ;; How to get the script file + (cond ((symbol=? compilation-target 'windows) "%0%") + (else "$(cd -- \"$(dirname \"$0\")\" >/dev/null 2>&1 && pwd -P)/\"$0\"")) + (cond ((symbol=? compilation-target 'windows) "") + (else "\"$@\"")) + (if input-file input-file "") + (if output-file output-file "") + prepend-directories + append-directories + library-files + r6rs? + compilation-target))) (define scheme-library-command (lambda (library-file) @@ -176,112 +189,50 @@ result)))))) (looper (command-line) (list)))) -;(display "Scheme ") -;(display scheme) -;(newline) -;(display "Type ") -;(display scheme-type) -;(newline) -;(newline) - -; Compile libraries (when (not (null? library-files)) - #;(if single-library-input-file - (display "Given library file: ") - (display "Found library files: ")) - ;(display library-files) - ;(newline) (when (assoc 'library-command (cdr (assoc scheme data))) (for-each (lambda (file) (let* ((library-command (scheme-library-command file))) - ;(display "Compiling library ") - ;(display file) - ;(newline) (for-each (lambda (command) - ;(display "Running ") - ;(write command) - ;(newline) - ;(display "Exit code ") (let ((exit-code (c-system (string->c-utf8 command)))) - ;(display exit-code) - ;(newline) (when (not (= exit-code 0)) (exit exit-code)))) library-command))) library-files))) -; Create executable file (when (and (equal? scheme-type 'interpreter) input-file) (when (and output-file (file-exists? output-file)) (delete-file output-file)) - (let ((shebang-line (string-append - (cond ((string=? compilation-target "unix") - (string-append - "#!/bin/sh" - (string #\newline) - "#|" - (string #\newline) - "tmpfile=$(mktemp)" - (string #\newline) - "tail -n+9 \"$0\" > ${tmpfile}" - (string #\newline))) - ((string=? compilation-target "windows") - (string-append - "@echo off" - (string #\newline) - "start"))) - scheme-command - (cond ((string=? compilation-target "unix") - (string-append - " \"$@\"" - (string #\newline) - "rm -rf ${tmpfile}" - (string #\newline) - "exit" - (string #\newline) - "|#" - (string #\newline))) - ((string=? compilation-target "windows") - "")))) - (scheme-program (slurp input-file))) - ;(display "Creating startup script ") - ;(display output-file) - ;(newline) - ;(display "Starting with ") - ;(display shebang-line) - ;(newline) + (let ((scheme-program (slurp input-file))) (with-output-to-file - (if (string=? compilation-target "windows") + (if (symbol=? compilation-target 'windows) (string-append output-file ".bat") output-file) (lambda () - (display shebang-line) - (newline) - (display scheme-program) - (newline))) - (cond ((string=? compilation-target "unix") + (if (symbol=? compilation-target 'windows) + "" + (for-each + display + `(#\newline + "#|" + #\newline + ,scheme-command + #\newline + "|#" + #\newline + ,scheme-program))))) + (cond ((symbol=? compilation-target 'unix) (c-system (string->c-utf8 (string-append "chmod +x " output-file))))))) (when (and (equal? scheme-type 'compiler) input-file) (when (and output-file (file-exists? output-file)) (delete-file output-file)) - ;(display "Compiling file ") - ;(display input-file) - ;(newline) (for-each (lambda (command) - ;(display "Running ") - ;(write command) - ;(newline) - ;(display "Exit code ") (let ((exit-code (c-system (string->c-utf8 command)))) - ;(display exit-code) - ;(newline) (when (not (= exit-code 0)) (exit exit-code)))) - scheme-command) - ;(newline) - ) + scheme-command)) diff --git a/libs/data.sld b/libs/data.sld index d11bc59..16bf035 100644 --- a/libs/data.sld +++ b/libs/data.sld @@ -11,10 +11,20 @@ (define data `((chezscheme (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (let ((separator (cond-expand (windows ";") (else ":")))) (apply string-append - `("chezscheme " + `(,exec-cmd + " chezscheme " ,(util-getenv "COMPILE_R7RS_CHEZSCHEME") " " ,(if (and (null? prepend-directories) @@ -28,23 +38,35 @@ (string-append item separator)) (append prepend-directories append-directories))) "\""))) - " --program ${tmpfile}")))))) + " --program " + ,script-file + " " + ,args)))))) (chibi (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) (apply string-append - `("chibi-scheme" - " " + `(,exec-cmd + " chibi-scheme " ,(util-getenv "COMPILE_R7RS_CHIBI") - " " ,@(map (lambda (item) - (string-append "-I" " " item " ")) + (string-append " -I" " " item " ")) prepend-directories) - " " ,@(map (lambda (item) - (string-append "-A" " " item " ")) + (string-append " -A" " " item " ")) append-directories) - " ${tmpfile}"))))) + ,script-file + " " + ,args))))) (chicken (type . compiler) (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) @@ -74,18 +96,26 @@ "-unit " unit) ,(string-append "ar rcs " static-out " " out))))) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) `(,(string-append "csc -R r7rs -X r7rs " (util-getenv "COMPILE_R7RS_CHICKEN") " -static " - " " (apply string-append (map (lambda (item) - (string-append "-I " item " ")) + (string-append " -I " item " ")) (append append-directories prepend-directories))) (apply string-append (map (lambda (library-file) - (string-append "-uses " + (string-append " -uses " (if (string-starts-with? library-file "srfi") (string-replace (string-cut-from-end library-file 4) #\/ #\-) (string-replace (string-cut-from-end library-file 4) #\/ #\.)) @@ -108,7 +138,16 @@ (search-library-file (append prepend-directories append-directories) library-file))))) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) `(,(string-append "cyclone " (util-getenv "COMPILE_R7RS_CYCLONE") " " @@ -126,18 +165,29 @@ "sleep 0")))))) (foment (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("foment " + `(,exec-cmd + " foment " ,(util-getenv "COMPILE_R7RS_FOMENT") - " " ,@(map (lambda (item) - (string-append "-I" " " item " ")) + (string-append " -I" " " item " ")) prepend-directories) ,@(map (lambda (item) - (string-append "-A" " " item " ")) + (string-append " -A" " " item " ")) append-directories) - " ${tmpfile}"))))) + ,script-file + " " + ,args))))) #;(gambit (type . compiler) (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) @@ -171,18 +221,32 @@ output-tmp-file)))))) (gauche (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("gosh " + `(,exec-cmd + ,(if (symbol=? compilation-target 'windows) + " gosh.exe " + " gosh ") ,(util-getenv "COMPILE_R7RS_GAUCHE") " -r7 " ,@(map (lambda (item) - (string-append "-I" " " item " ")) + (string-append " -I" " " item " ")) prepend-directories) ,@(map (lambda (item) - (string-append "-A" " " item " ")) + (string-append " -A" " " item " ")) append-directories) - " ${tmpfile}"))))) + ,script-file + " " + ,args))))) (guile (type . interpreter) (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) @@ -202,32 +266,69 @@ (string-cut-from-end library-path 4) ".go") library-path))))) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("guile " + `(,exec-cmd + " guile " ,(util-getenv "COMPILE_R7RS_GUILE") ,(if r6rs? " --r6rs -x .sls " " --r7rs -x .sld ") ,@(map (lambda (item) - (string-append "-L " item " " - "-L " (dirname item) " ")) + (string-append " -L " item " " + " -L " (dirname item) " ")) (append prepend-directories append-directories)) - " -s ${tmpfile}"))))) + " -s " + ,script-file + " " + ,args))))) (ikarus (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) (apply string-append `( "IKARUS_LIBRARY_PATH=" ,@(map (lambda (item) (string-append item ":")) prepend-directories) ,@(map (lambda (item) (string-append item ":")) append-directories) + " " + ,exec-cmd " ikarus " ,(util-getenv "COMPILE_R7RS_IKARUS") - " --r6rs-script ${tmpfile}"))))) + " --r6rs-script " + ,script-file + " " + ,args))))) (ironscheme (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) (apply string-append - `("ironscheme " + `(,exec-cmd + " ironscheme " ,(util-getenv "COMPILE_R7RS_IRONSCHEME") " " ,@(map (lambda (item) @@ -236,90 +337,79 @@ ,@(map (lambda (item) (string-append "-I \"" item "\" ")) append-directories) - " ${tmpfile}"))))) + ,script-file + " " + ,args))))) (kawa (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("kawa -J--add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED -J--enable-native-access=ALL-UNNAMED -J--enable-preview " + `("CLASSPATH=" + ,@(map (lambda (item) + (string-append "${PWD}/" item ":")) + (append prepend-directories + append-directories)) + " " + ,exec-cmd + " kawa -J--add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED -J--enable-native-access=ALL-UNNAMED -J--enable-preview " ,(util-getenv "COMPILE_R7RS_KAWA") " -Dkawa.import.path=" ,@(map (lambda (item) - (string-append item "/*.sld:")) + (string-append "${PWD}/" item "/*.sld:")) (append prepend-directories append-directories)) - " --script1 ${0}")))) - (command-old . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) - (set! append-directories - (append append-directories - (list "/usr/local/share/kawa/lib"))) - (let* ((output-jar (string-append output-file ".jar")) - (main-class - (string-append (string-cut-from-end (path->filename input-file) - 4))) - (kawa-jar-path "/usr/local/share/kawa/lib/kawa.jar") - (classpath - (string-append - kawa-jar-path " " - (apply - string-append - (map (lambda (dir) - (string-append dir " ")) - (append prepend-directories append-directories))))) - (import-paths - (apply - string-append - `("-Dkawa.import.path=" - ,@(map (lambda (dir) - (string-append dir "/*.sld:")) - (append prepend-directories append-directories)) - "*.sld"))) - (library-dirs (apply string-append - (append (map (lambda (item) - (string-append item " ")) - (append prepend-directories - append-directories))))) - (class-files - (apply - string-append - (map - (lambda (lib) - (string-append - (string-cut-from-end - (search-library-file (append prepend-directories - append-directories) - lib) - 4) - ".class ")) - library-files)))) - `(,(string-append "rm -rf " output-jar) - ,(string-append - "echo 'Main-Class: " main-class "\nClass-Path: . " classpath "' > MANIFEST.mf") - ,(string-append "kawa " import-paths " --main -C " input-file) - ,(string-append "jar cfm " output-jar " MANIFEST.mf " main-class ".class ") - ,(string-append "jar uf " output-jar " " library-dirs) - ,(string-append "printf '#!/bin/sh\nMYSELF=$(which \"$0\" 2>/dev/null)\n[ $? -gt 0 -a -f \"$0\" ] && MYSELF=\"./$0\"\njava=java\nif test -n \"$JAVA_HOME\"; then\n java=\"$JAVA_HOME/bin/java\"\nfi\nexec \"$java\" --add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED --add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED --add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED --enable-native-access=ALL-UNNAMED --enable-preview -jar $MYSELF \"$@\"\nexit 1\n' > " output-file) - ,(string-append "cat " output-jar " >> " output-file) - ,(string-append "rm -rf " output-jar) - ,(string-append "chmod +x " output-file)))))) + " -f " + ,script-file + " " + ,args))))) (larceny (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("larceny -nobanner -quiet -utf8 " + `(,exec-cmd + " larceny -nobanner -quiet -utf8 " ,(if r6rs? " -r6 " " -r7 ") ,(util-getenv "COMPILE_R7RS_LARCENY") - " " ,@(map (lambda (item) - (string-append "-I " item " ")) + (string-append " -I " item " ")) prepend-directories) ,@(map (lambda (item) - (string-append "-A " item " ")) + (string-append " -A " item " ")) append-directories) - " -program ${tmpfile} --"))))) + " -program " + ,script-file + " -- " + ,args))))) (loko (type . compiler) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (let ((out (string-cut-from-end input-file 4))) `(,(string-append "LOKO_LIBRARY_PATH=" (apply string-append @@ -341,9 +431,19 @@ ,(string-append "mv " out " " output-file)))))) (meevax (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) (apply string-append - `("meevax " + `(,exec-cmd + " meevax " ,(util-getenv "COMPILE_R7RS_MEEVAX") ,@(map (lambda (item) (string-append " -I" " " item " ")) @@ -351,24 +451,49 @@ ,@(map (lambda (item) (string-append " -A" " " item " ")) append-directories) - " ${tmpfile}"))))) + ,script-file + " " + ,args))))) (mit-scheme (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) (apply string-append - `("mit-scheme --batch-mode --no-init-file " + `(,exec-cmd + " mit-scheme --batch-mode --no-init-file " ,@(map (lambda (item) - (string-append "--load " + (string-append " --load " (search-library-file (append append-directories prepend-directories) item) " ")) library-files) - " --load \"${tmpfile}\" --eval \"(exit 0)\" --args"))))) + " --load " + ,script-file + " --eval \"(exit 0)\" " + " --args " + ,args))))) (mosh (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) (let ((dirs (append append-directories prepend-directories))) (apply string-append `(,(if (> (length dirs) 0) @@ -377,9 +502,13 @@ (apply string-append (map (lambda (item) (string-append item ":")) dirs))) "") + " " + ,exec-cmd " mosh " ,(util-getenv "COMPILE_R7RS_MOSH") - " ${tmpfile}")))))) + ,script-file + " " + ,args)))))) (racket (type . interpreter) (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) @@ -388,31 +517,59 @@ library-file)) (library-rkt-file (change-file-suffix full-path ".rkt"))) (if r6rs? - `(,(string-append "plt-r6rs --compile " library-file)) + `("sleep 0") ;`(,(string-append "plt-r6rs --compile " library-file)) `(,(string-append "printf " "'#lang r7rs\\n" "(import (except (scheme base) let let-values let*-values string-copy string-copy! string-for-each string-map string-fill! string->list))\\n" "(include \"" (path->filename library-file) "\")\\n' > " library-rkt-file)))))) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (let ((rkt-input-file (if (string=? input-file "") "" (change-file-suffix input-file ".rkt")))) (apply string-append - `("racket " + `(,exec-cmd + ,(if r6rs? + " plt-r6rs " + " racket ") ,(util-getenv "COMPILE_R7RS_RACKET") - ,(if r6rs? " -I r6rs " " -I r7rs ") + ,(if r6rs? "" " -I r7rs ") ,@(map (lambda (item) - (string-append " -S " item " ")) + (string-append + (if r6rs? " ++path " " -S ") + item " ")) (append prepend-directories append-directories)) ,(if r6rs? "" " --script ") - " ${tmpfile}")))))) + ,script-file + " " + ,args)))))) (sagittarius (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("sash -d " + `(,exec-cmd + ,(if (symbol=? compilation-target 'windows) + " sash.exe -d " + " sash -d ") ,(util-getenv "COMPILE_R7RS_SAGITTARIUS") ,(if r6rs? " -r6 " " -r7 ") ,@(map (lambda (item) @@ -421,12 +578,24 @@ ,@(map (lambda (item) (string-append " -A " item " ")) append-directories) - " ${tmpfile}"))))) + ,script-file + " " + ,args))))) (skint (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) (apply string-append - `("skint " + `(,exec-cmd + " skint " ,(util-getenv "COMPILE_R7RS_SKINT") " " ,@(map (lambda (item) @@ -435,12 +604,25 @@ ,@(map (lambda (item) (string-append "-A " item "/ ")) append-directories) - " --program=${tmpfile}"))))) + " --program=" + ,script-file + " " + ,args))))) (stklos (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("stklos " + `(,exec-cmd + " stklos " ,(util-getenv "COMPILE_R7RS_STKLOS") " " ,@(map (lambda (item) @@ -449,24 +631,48 @@ ,@(map (lambda (item) (string-append "-A " item " ")) append-directories) - " ${tmpfile}"))))) + ,script-file + " " + ,args))))) (tr7 (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("TR7_LIB_PATH=" + `(" TR7_LIB_PATH=" ,@(map (lambda (item) (string-append item ":")) prepend-directories) ,@(map (lambda (item) (string-append item ":")) append-directories) + " " + ,exec-cmd " tr7i " ,(util-getenv "COMPILE_R7RS_TR7") - " ${tmpfile}"))))) + ,script-file + " " + ,args))))) (vicare (type . compiler) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append `("vicare " ,(util-getenv "COMPILE_R7RS_VICARE") @@ -479,9 +685,19 @@ " --compile-program"))))) (ypsilon (type . interpreter) - (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) (apply string-append - `("ypsilon " + `(,exec-cmd + " ypsilon " ,(util-getenv "COMPILE_R7RS_YPSILON") ,(if r6rs? " --r6rs " " --r7rs ") " --mute" @@ -492,4 +708,7 @@ ,@(map (lambda (item) (string-append "--sitelib=" item " ")) append-directories) - " --top-level-program ${tmpfile}"))))))))) + " --top-level-program " + ,script-file + " " + ,args))))))))) diff --git a/r7rs-testfiles/main.scm b/r7rs-testfiles/main.scm index 2bb4049..4a3a20d 100644 --- a/r7rs-testfiles/main.scm +++ b/r7rs-testfiles/main.scm @@ -8,15 +8,11 @@ (hello-world) (define l (list "1" "2" "3")) + +;; Implementations are allowed to give diffrent amout of args (cond-expand - ;; Meevax gives too much args - ;; For this test for now this is okay (meevax (when (> (length (command-line)) 3) (write l))) - ;; mit-scheme gives too much args - ;; For this test for now this is okay (mit (when (> (length (command-line)) 3) (write l))) - ;; tr7 gives too much args - ;; For this test for now this is okay (tr7 (when (> (length (command-line)) 3) (write l))) (else (write (list-tail (command-line) 1))))