1
0
Fork 0

Improve outputted scripts on Linux

This commit is contained in:
retropikzel 2025-11-05 06:13:35 +02:00
parent 0e4e8890c4
commit 45e80037cf
4 changed files with 407 additions and 229 deletions

View File

@ -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

View File

@ -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 "")
(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?)))
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))

View File

@ -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 " "))
prepend-directories)
" "
,@(map (lambda (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,11 +96,19 @@
"-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 " "))
@ -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 " "))
prepend-directories)
,@(map (lambda (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,9 +221,21 @@
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)
@ -182,7 +244,9 @@
,@(map (lambda (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,9 +266,19 @@
(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)
@ -212,22 +286,49 @@
" -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 " "))
prepend-directories)
,@(map (lambda (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,12 +451,24 @@
,@(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 "
@ -365,10 +477,23 @@
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,10 +631,21 @@
,@(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="
,@(map (lambda (item)
@ -461,12 +654,25 @@
,@(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)))))))))

View File

@ -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))))