Most interpreters can now produce php file

.gitignore

@@ -17,3 +17,4 @@ deps
 tmp
 deb
 *.deb
+test-result.txt

Dockerfile.test

@@ -10,11 +10,14 @@ RUN make
 ARG SCHEME=chibi
 ARG IMAGE=chibi:head
 FROM schemers/${IMAGE}
-RUN apt-get update && apt-get install -y make gcc libffi-dev unzip
+RUN apt-get update && apt-get install -y \
+    --no-install-recommends \
+    build-essential libffi-dev unzip php libreadline-dev
 COPY --from=cache /cache /cache
 WORKDIR /cache/chibi-scheme
 RUN make install
 WORKDIR /
+RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
 RUN snow-chibi install --always-yes "(foreign c)"
 RUN snow-chibi install --always-yes "(srfi 170)"
 COPY Makefile .

Makefile

@@ -3,6 +3,7 @@ SCHEME=chibi
 VERSION=1.0.0
 R6RSTMP=tmp/${SCHEME}-r6rs
 R7RSTMP=tmp/${SCHEME}-r7rs
+DOCKERTAG=compile-r7rs-test-${SCHEME}
 DOCKERIMG=${SCHEME}:head
 ifeq "${SCHEME}" "chicken"
 DOCKERIMG="chicken:5"
@@ -95,8 +96,20 @@ test-r6rs:
 	@grep "Test successfull (\"1\" \"2\" \"3\")" ${R6RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R6RSTMP}/test-result.txt && exit 1)
 
 test-r6rs-docker:
-	docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
+	docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
-	docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c "make SCHEME=${SCHEME} test-r6rs"
+	docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r6rs"
+
+test-r6rs-php:
+	rm -rf ${R6RSTMP}
+	mkdir -p ${R6RSTMP}
+	cp -r r6rs-php-testfiles/* ${R6RSTMP}/
+	cd ${R6RSTMP} && COMPILE_R7RS=${SCHEME} COMPILE_R7RS_TARGET=php compile-r7rs -o main.php main.sps
+	-cd ${R6RSTMP} && php main.php > test-result.txt 2>&1
+	@grep "Test successfull" ${R6RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R6RSTMP}/test-result.txt && exit 1)
+
+test-r6rs-php-docker:
+	docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
+	docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r6rs-php"
 
 test-r7rs:
 	rm -rf ${R7RSTMP}
@@ -107,8 +120,32 @@ test-r7rs:
 	@grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
 
 test-r7rs-docker:
-	docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
+	docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
-	docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c "make SCHEME=${SCHEME} test-r7rs"
+	docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} 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=windows compile-r7rs -I ./libs -o main.bat 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=${DOCKERTAG} .
+	docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs-wine"
+
+test-r7rs-php:
+	rm -rf ${R7RSTMP}
+	mkdir -p ${R7RSTMP}
+	cp -r r7rs-php-testfiles/* ${R7RSTMP}/
+	cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} COMPILE_R7RS_TARGET=php compile-r7rs -o main.php main.scm
+	-cd ${R7RSTMP} && php main.php > test-result.txt 2>&1
+	@grep "Test successfull" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
+
+test-r7rs-php-docker:
+	docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
+	docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs-php"
 
 clean:
 	rm -rf test-r7rs

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")
+(define compilation-target
-                             (get-environment-variable "TARGET")
+  (if (get-environment-variable "COMPILE_R7RS_TARGET")
-                             (cond-expand (windows "windows")
+    (string->symbol (get-environment-variable "COMPILE_R7RS_TARGET"))
-                                          (else "unix"))))
+    (cond-expand (windows 'windows)
+                 (else 'unix))))
 
 (define input-file
   (let ((input-file #f))
@@ -64,12 +68,18 @@
     #t
     #f))
 
+(define scheme-type (cdr (assoc 'type (cdr (assoc scheme data)))))
+
 (define output-file
-  (if (member "-o" (command-line))
+  (let ((outfile (if (member "-o" (command-line))
                    (cadr (member "-o" (command-line)))
                    (if input-file
                      "a.out"
-      #f)))
+                     #f))))
+    (if (and (symbol=? scheme-type 'compiler)
+             (symbol=? compilation-target 'php))
+      (string-append outfile ".bin")
+      outfile)))
 
 (define prepend-directories
   (letrec ((looper (lambda (rest result)
@@ -148,16 +158,29 @@
                                (list)
                                (list)))
 
-(define scheme-type (cdr (assoc 'type (cdr (assoc scheme data)))))
-
 (define scheme-command
   (apply (cdr (assoc 'command (cdr (assoc scheme data))))
-         (list (if input-file input-file "")
+         (list
+           (cond
+             ((symbol=? compilation-target 'windows) "")
+             ((symbol=? compilation-target 'php) "")
+             (else "exec"))
+           ;; How to get the script file
+           (cond
+             ((symbol=? compilation-target 'windows) "%0%")
+             ((symbol=? compilation-target 'php) "$binname")
+             (else "$(cd -- \"$(dirname \"$0\")\" >/dev/null 2>&1 && pwd -P)/\"$0\""))
+           (cond
+             ((symbol=? compilation-target 'windows) "")
+             ((symbol=? compilation-target 'php) "")
+             (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 +199,95 @@
                                  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
+  (let ((scheme-program (slurp input-file)))
-                        (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)
     (with-output-to-file
-      (if (string=? compilation-target "windows")
+      output-file
-        (string-append output-file ".bat")
-        output-file)
       (lambda ()
-        (display shebang-line)
+        (cond
-        (newline)
+          ((symbol=? compilation-target 'windows)
-        (display scheme-program)
+           (for-each
-        (newline)))
+             display
-    (cond ((string=? compilation-target "unix")
+             `(";dir; start /WAIT " ,scheme-command " && exit"
+               #\newline
+               ,scheme-program
+               )))
+          ((symbol=? compilation-target 'php)
+           (for-each
+             display
+             `("<?php"
+               " $descriptorspec = array(0 => fopen('php://stdin', 'r'), 1 => array('pipe', 'w'), 2 => fopen('php://stderr', 'w'));"
+               " $cwd = '.';"
+               " $filepath = $_SERVER['SCRIPT_FILENAME'];"
+               " $filename = $_SERVER['SCRIPT_NAME'];"
+               " $binname = '/tmp/test.bin';"
+               " system(\"tail -n+3 $filepath > $binname\");"
+               " $scheme_command = \"" ,scheme-command "\";"
+               " $process = proc_open($scheme_command, $descriptorspec, $pipes, $cwd, $_ENV);"
+               " echo stream_get_contents($pipes[1]);"
+               " die();"
+               " ?>"
+               #\newline
+               #\newline
+               ,scheme-program)))
+          (else
+            (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 (symbol=? 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)
+  (cond
-  )
+    ((symbol=? compilation-target 'php)
+     (let* ((php-file (string-cut-from-end output-file 4))
+            (port (open-binary-output-file php-file))
+            (bin (slurp-bytes output-file)))
+       (for-each
+         (lambda (item) (write-bytevector (string->utf8 item) port))
+         `("<?php"
+           " $descriptorspec = array(0 => fopen('php://stdin', 'r'), 1 => array('pipe', 'w'), 2 => fopen('php://stderr', 'w'));"
+           " $cwd = '.';"
+           " $filepath = $_SERVER['SCRIPT_FILENAME'];"
+           " $binname = '/tmp/test.bin';"
+           " system(\"tail -n+3 $filepath > $binname\");"
+           " $process = proc_open($binname, $descriptorspec, $pipes, $cwd, $_ENV);"
+           " echo stream_get_contents($pipes[1]);"
+           " die();"
+           " ?>"
+           ,(string #\newline)
+           ,(string #\newline)))
+       (write-bytevector bin port)
+       (close-output-port port)))
+    (else #t)))
 

libs/data.sld

@@ -8,13 +8,24 @@
           (libs util))
   (export data)
   (begin
+    (define pwd (cond-expand (windows "%CD%") (else "${PWD}")))
     (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)
@@ -22,29 +33,41 @@
                                       ""
                                       (apply string-append
                                              (list "--libdirs "
-                                                   "\""
+                                                   "'"
                                                    (apply string-append
                                                           (map (lambda (item)
                                                                  (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 +97,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 +139,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 +166,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 +222,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 +267,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 " "
+                                        (string-append " -L " item " "
-                                                       "-L " (dirname 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 +338,83 @@
                                ,@(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)
+                                        (if (char=? (string-ref item 0) #\/)
+                                          (string-append 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:"))
+                                        (if (char=? (string-ref item 0) #\/)
+                                          (string-append item "/*.sld")
+                                          (string-append pwd "/" item "/*.sld")))
                                       (append prepend-directories
                                               append-directories))
-                               " --script1 ${0}"))))
+                               " -f "
-        (command-old . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
+                               ,script-file
-                      (set! append-directories
+                               " "
-                        (append append-directories
+                               ,args)))))
-                                (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))))))
         (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,34 +436,74 @@
                              ,(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 " "))
+                                        (if (char=? (string-ref item 0) #\/)
+                                          (string-append " -I " pwd "/" item " ")
+                                          (string-append " -I " item " ")))
                                         prepend-directories)
                                  ,@(map (lambda (item)
-                                          (string-append " -A" " " item " "))
+                                        (if (char=? (string-ref item 0) #\/)
+                                          (string-append " -A " pwd "/" 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)' "
+                                  ,(if (string=? args "")
+                                     ""
+                                     (string-append " --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 +512,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 +527,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 +588,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 +614,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 +641,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)
-                                 " tr7i "
+                                 " "
+                                 ,exec-cmd
+                                 " tr7i -1 "
                                  ,(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 +695,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 +718,7 @@
                                  ,@(map (lambda (item)
                                           (string-append "--sitelib=" item " "))
                                         append-directories)
-                                 " --top-level-program ${tmpfile}")))))))))
+                                 " --top-level-program "
+                                 ,script-file
+                                 " "
+                                 ,args)))))))))

libs/util.sld

@@ -25,6 +25,7 @@
           dirname
           search-library-file
           slurp
+          slurp-bytes
           file->list
           trim
           trim-end
@@ -216,6 +217,17 @@
                           (string-append line (string #\newline)))
                         (looper (list) (read-line))))))))
 
+    (define (slurp-bytes path)
+      (letrec* ((looper (lambda (result bytes)
+                          (if (eof-object? bytes)
+                            result
+                            (looper (bytevector-append result bytes)
+                                    (read-bytevector 4000))))))
+        (with-input-from-file
+          path
+          (lambda ()
+            (looper (bytevector) (read-bytevector 4000))))))
+
     (define (file->list path)
       (letrec* ((looper (lambda (result line)
                           (if (eof-object? line)

r6rs-php-testfiles/main.sps

@@ -0,0 +1,6 @@
+#!r6rs
+(import (rnrs)
+        (rnrs programs))
+
+(display "Test successfull")
+(newline)

r7rs-php-testfiles/main.scm

@@ -0,0 +1,6 @@
+(import (scheme base)
+        (scheme read)
+        (scheme write))
+
+(display "Test successfull")
+(newline)

r7rs-testfiles/main.scm

@@ -8,16 +8,11 @@
 (hello-world)
 
 (define l (list "1" "2" "3"))
+
+;; Implementations are allowed to give different 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))))
 
 (over-9000)