diff --git a/Makefile b/Makefile index b0a333c..65e910c 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ .PHONY: README.md PREFIX=/usr/local SCHEME=chibi -VERSION=1.2.0 +VERSION=1.3.0 R6RSTMP=.tmp/${SCHEME}-r6rs R7RSTMP=.tmp/${SCHEME}-r7rs DOCKERTAG=compile-scheme-test-${SCHEME} diff --git a/compile-scheme.scm b/compile-scheme.scm index 279b2e3..62e1b18 100644 --- a/compile-scheme.scm +++ b/compile-scheme.scm @@ -8,6 +8,8 @@ (libs library-util) (srfi 170)) +(define compilation-targets '(unix cgi windows)) + (define debug? (if (or (member "--debug" (command-line)) (get-environment-variable "SCHEME_COMPILE_DEBUG")) @@ -20,7 +22,7 @@ (exit 0)) (when (member "--version" (command-line)) - (display "1.1.1") + (display "1.3.0") (newline) (exit 0)) @@ -64,6 +66,25 @@ (newline) (exit 0)) +(when (member "--list-targets" (command-line)) + (for-each + (lambda (target) + (display target) + (display ": ") + (cond + ((symbol=? target 'unix) + (display " ") + (display "Creates either unix executable or executable script")) + ((symbol=? target 'cgi) + (display " ") + (display "Creates either unix executable or executable script that") + (display "works with CGI, not all implementations work with this")) + ((symbol=? target 'windows) + (display "Creates either windows executable or executable batch script"))) + (newline)) + compilation-targets) + (exit 0)) + (define scheme (cond ((get-environment-variable "COMPILE_R7RS") @@ -110,16 +131,6 @@ (define scheme-type (cdr (assoc 'type (cdr (assoc scheme data))))) -(define compilation-target - (let ((outfile (if (member "-o" (command-line)) - (cadr (member "-o" (command-line))) - (if input-file - "a.out" - #f)))) - (if (and (symbol=? scheme-type 'compiler)) - (string-append outfile ".bin") - outfile))) - (define compilation-target (cond ((member "--target" (command-line)) @@ -190,18 +201,30 @@ (list) (list))) +(define scheme-command-exec-command + (cond + ((symbol=? compilation-target 'windows) "; @echo off &") + ((symbol=? compilation-target 'cgi) "#!/usr/bin/env -S") + (else "exec"))) + +(define scheme-command-script-file + (cond + ((symbol=? compilation-target 'windows) "\"%~f0\"") + ((symbol=? compilation-target 'cgi) "") + ((symbol=? compilation-target 'cgi) "") + (else "\"$0\""))) + +(define scheme-command-args + (cond + ((symbol=? compilation-target 'windows) "%* & exit /b") + ((symbol=? compilation-target 'cgi) "") + (else "\"$@\""))) + (define scheme-command (apply (cdr (assoc 'command (cdr (assoc scheme data)))) - (list - (cond - ((symbol=? compilation-target 'windows) "; @echo off &") - (else "exec")) - (cond - ((symbol=? compilation-target 'windows) "\"%~f0\"") - (else "\"$0\"")) - (cond - ((symbol=? compilation-target 'windows) "%* & exit /b") - (else "\"$@\"")) + (list scheme-command-exec-command + scheme-command-script-file + scheme-command-args (if input-file input-file "") (if output-file output-file "") prepend-directories @@ -258,10 +281,16 @@ (cond ((symbol=? compilation-target 'windows) (for-each - display - `(,scheme-command - #\newline - ,scheme-program))) + display + `(,scheme-command + #\newline + ,scheme-program))) + ((symbol=? compilation-target 'cgi) + (for-each + display + `(,scheme-command + #\newline + ,scheme-program))) (else (for-each display @@ -273,8 +302,10 @@ "|#" #\newline ,scheme-program)))))) - (cond ((symbol=? compilation-target 'unix) - (system (string-append "chmod +x " output-file)))))) + (cond + ((or (symbol=? compilation-target 'unix) + (symbol=? compilation-target 'cgi)) + (system (string-append "chmod +x " output-file)))))) (when (and (symbol=? scheme-type 'compiler) input-file) (when (and output-file (file-exists? output-file)) diff --git a/libs/implementations.scm b/libs/implementations.scm new file mode 100644 index 0000000..6ba5847 --- /dev/null +++ b/libs/implementations.scm @@ -0,0 +1,775 @@ +(define pwd (cond-expand (windows "%CD%") (else "${PWD}"))) +(define data + `((capyscheme + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,exec-cmd + " capy " + ,(util-getenv "COMPILE_R7RS_CAPYSCHEME") + " " + ,@(map (lambda (item) + (string-append "-L" " " item " ")) + prepend-directories) + ,@(map (lambda (item) + (string-append "-A" " " item " ")) + append-directories) + ,(cond (r6rs? " --r6rs ") + (else " --r7rs ")) + ,(cond ((symbol=? compilation-target 'cgi) " ") + (else " --script ")) + ,script-file + " " + ,args))))) + (chezscheme + (type . interpreter) + (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 + `(,exec-cmd + " scheme " + ,(util-getenv "COMPILE_R7RS_CHEZSCHEME") + " " + ,(if (and (null? prepend-directories) + (null? append-directories)) + "" + (apply string-append + (list "--libdirs " + "'" + (apply string-append + (map (lambda (item) + (string-append item separator)) + (append prepend-directories append-directories))) + "'"))) + ,(cond ((symbol=? compilation-target 'cgi) " ") + (else " --program ")) + ,script-file + " " + ,args)))))) + (chibi + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) + (apply string-append + `(,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) + ,script-file + " " + ,args))))) + (chicken + (type . compiler) + (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) + (let ((unit (string-append (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) #\/ #\.)))) + (out (string-append (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) #\/ #\.)) + ".o")) + (static-out (string-append (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) #\/ #\.)) + ".a"))) + `(,(string-append "csc -R r7rs -X r7rs " + (util-getenv "COMPILE_R7RS_CHICKEN") + " -static -c -J -o " + out + " " + (search-library-file (append prepend-directories append-directories) library-file) + " " + (apply string-append + (map (lambda (item) + (string-append "-I " item " ")) + (append append-directories + prepend-directories))) + "-unit " + unit) + ,(string-append "ar rcs " static-out " " out))))) + (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 " ")) + (append append-directories prepend-directories))) + (apply string-append + (map (lambda (library-file) + (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) #\/ #\.)) + " ")) + library-files)) + " -output-file " + output-file + " " + input-file))))) + (cyclone + (type . compiler) + (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) + `(,(string-append "cyclone " + (util-getenv "COMPILE_R7RS_CYCLONE") + " " + (apply string-append + (map (lambda (item) (string-append "-I " item " ")) prepend-directories)) + (apply string-append + (map (lambda (item) (string-append "-A " item " ")) append-directories)) + (search-library-file (append prepend-directories + append-directories) + library-file))))) + (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") + " " + (apply string-append + (map (lambda (item) (string-append "-I " item " ")) prepend-directories)) + (apply string-append + (map (lambda (item) (string-append "-A " item " ")) append-directories)) + input-file) + ,(string-append + (if (not (string=? (string-cut-from-end input-file 4) output-file)) + (string-append + "mv " + (string-cut-from-end input-file 4) + " " + output-file) + "sleep 0")))))) + (foment + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,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) + ,script-file + " " + ,args))))) + (gambit + (type . compiler) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (let ((library-files-paths + (map (lambda (item) + (search-library-file (append prepend-directories + append-directories) + item)) + library-files))) + `(,(string-append "echo \"#!/usr/bin/env gsi -:r7rs,search=" + (apply string-append + (map (lambda (item) + (string-append item "/, ")) + (append prepend-directories + append-directories))) + "\" > " + (string-append output-file ".tmp")) + ,(string-append "cat " + input-file + " >> " + (string-append output-file ".tmp")) + ,(apply string-append + `(" gsc " + ,(util-getenv "COMPILE_R7RS_GAMBIT") + " -:r7rs,search=" + ,(apply string-append + (map (lambda (item) + (string-append item "/, ")) + (append prepend-directories + append-directories))) + " -o " + ,output-file + " -exe -nopreload " + ,(string-append output-file ".tmp")))))))) + (gauche + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,exec-cmd + " gosh " + ,(util-getenv "COMPILE_R7RS_GAUCHE") + " -r7 " + ,@(map (lambda (item) + (string-append " -I" " " item " ")) + prepend-directories) + ,@(map (lambda (item) + (string-append " -A" " " item " ")) + append-directories) + ,script-file + " " + ,args))))) + (guile + (type . interpreter) + (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) + (let ((library-path (search-library-file (append append-directories + prepend-directories) + library-file))) + `(,(string-append + "guild compile " + (if r6rs? " --r6rs " " --r7rs ") + (apply string-append + (map (lambda (item) + (string-append "-L" " " item " ")) + (append prepend-directories + append-directories))) + " -o " + (string-append + (string-cut-from-end library-path 4) + ".go") + library-path))))) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,exec-cmd + " guile " + ,(util-getenv "COMPILE_R7RS_GUILE") + ,(if r6rs? " --r6rs -x .sls " " --r7rs -x .sld ") + ,@(map (lambda (item) + (string-append " -L " item " ")) + (append prepend-directories + append-directories)) + + ,(cond ((symbol=? compilation-target 'cgi) + (string-append (string #\newline) + "!#")) + (else " -s ")) + ,script-file + " " + ,args))))) + (ikarus + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) + (apply string-append + `(,(if (symbol=? compilation-target 'cgi) + exec-cmd + "") + " IKARUS_LIBRARY_PATH=" + ,@(map (lambda (item) (string-append item ":")) prepend-directories) + ,@(map (lambda (item) (string-append item ":")) append-directories) + " " + ,(if (symbol=? compilation-target 'cgi) + "" + exec-cmd) + " ikarus " + ,(util-getenv "COMPILE_R7RS_IKARUS") + " --r6rs-script " + ,script-file + " " + ,args))))) + (ironscheme + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) + (apply string-append + `(,exec-cmd + " ironscheme " + ,(util-getenv "COMPILE_R7RS_IRONSCHEME") + " " + ,@(map (lambda (item) + (string-append "-I \"" item "\" ")) + prepend-directories) + ,@(map (lambda (item) + (string-append "-I \"" item "\" ")) + append-directories) + ,script-file + " " + ,args))))) + (kawa + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,exec-cmd + " kawa -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED -J--enable-native-access=ALL-UNNAMED --r7rs --full-tailcalls" + ,(util-getenv "COMPILE_R7RS_KAWA") + " -Dkawa.import.path=" + ,@(map (lambda (item) + (if (char=? (string-ref item 0) #\/) + (string-append item "/*.sld:") + (string-append pwd "/" item "/*.sld:"))) + (append prepend-directories + append-directories + (list "/usr/local/share/kawa/lib"))) + ,(if (symbol=? compilation-target 'cgi) + "" + " -f ") + ,script-file + " " + ,args))))) + (larceny + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,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 " + ,script-file + " -- " + ,args))))) + (loko + (type . compiler) + (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 + (map (lambda (item) + (string-append item ":")) + prepend-directories)) + (apply string-append + (map (lambda (item) + (string-append item ":")) + append-directories)) + " loko " + (util-getenv "COMPILE_R7RS_LOKO") + " " + (if r6rs? "-std=r6rs" "-std=r7rs") + " " + "--compile" + " " + input-file) + ,(string-append "mv " out " " output-file)))))) + (meevax + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) + (apply string-append + `(,exec-cmd + " meevax " + ,(util-getenv "COMPILE_R7RS_MEEVAX") + ,@(map (lambda (item) + (if (char=? (string-ref item 0) #\/) + (string-append " -I " pwd "/" item " ") + (string-append " -I " item " "))) + prepend-directories) + ,@(map (lambda (item) + (if (char=? (string-ref item 0) #\/) + (string-append " -A " pwd "/" item " ") + (string-append " -A " item " "))) + append-directories) + ,script-file + " " + ,args))))) + (mit-scheme + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) + (apply string-append + `(,exec-cmd + " mit-scheme " + ,(if (symbol=? compilation-target 'cgi) + "" + " --batch-mode ") + ,@(map + (lambda (item) + (string-append " --load " + (search-library-file (append append-directories + prepend-directories) + item) + " ")) + library-files) + ,(if (symbol=? compilation-target 'cgi) + "" + " --load ") + ,script-file + ,(if (symbol=? compilation-target 'cgi) + "" + " --eval '(exit 0)' ") + ,(if (string=? args "") + "" + (string-append " --args " args))))))) + (mosh + (type . interpreter) + (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 (symbol=? compilation-target 'cgi) + exec-cmd + "") + " IKARUS_LIBRARY_PATH=" + ,(if (> (length dirs) 0) + (string-append + " MOSH_LOADPATH=" + (apply string-append + (map (lambda (item) (string-append item ":")) dirs))) + "") + " " + ,(if (symbol=? compilation-target 'cgi) + "" + exec-cmd) + " mosh " + ,(util-getenv "COMPILE_R7RS_MOSH") + ,script-file + " " + ,args)))))) + (racket + (type . interpreter) + (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) + (let* ((full-path (search-library-file (append append-directories + prepend-directories) + library-file)) + (library-rkt-file (change-file-suffix full-path ".rkt"))) + (if r6rs? + `("sleep 0") + `(,(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 (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 + `(,exec-cmd + " racket " + ,(util-getenv "COMPILE_R7RS_RACKET") + ,(if r6rs? " -I scheme/init -l r6rs/run.rkt" " -I r7rs ") + ,@(map (lambda (item) + (string-append " -S " item " ")) + (append prepend-directories + append-directories)) + ,(if r6rs? " " " --script ") + ,script-file + " " + ,args)))))) + (sagittarius + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,exec-cmd + ,(if (symbol=? compilation-target 'windows) + " sash.exe -d " + " sash -d ") + ,(util-getenv "COMPILE_R7RS_SAGITTARIUS") + ,(if r6rs? " -r6 " " -r7 ") + ,@(map (lambda (item) + (string-append " -L " item " ")) + prepend-directories) + ,@(map (lambda (item) + (string-append " -A " item " ")) + append-directories) + ,script-file + " " + ,args))))) + (skint + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs + compilation-target) + (apply string-append + `(,exec-cmd + " skint " + ,(util-getenv "COMPILE_R7RS_SKINT") + " " + ,@(map (lambda (item) + (string-append "-I " item "/ ")) + prepend-directories) + ,@(map (lambda (item) + (string-append "-A " item "/ ")) + append-directories) + " --program=" + ,script-file + " " + ,args))))) + (stklos + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,exec-cmd + " stklos " + ,(util-getenv "COMPILE_R7RS_STKLOS") + " " + ,@(map (lambda (item) + (string-append "-I " item " ")) + prepend-directories) + ,@(map (lambda (item) + (string-append "-A " item " ")) + append-directories) + ,script-file + " " + ,args))))) + (tr7 + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,(if (symbol=? compilation-target 'cgi) + exec-cmd + "") + " TR7_LIB_PATH=" + ,@(map (lambda (item) + (string-append item ":")) + prepend-directories) + ,@(map (lambda (item) + (string-append item ":")) + append-directories) + " " + ,(if (symbol=? compilation-target 'cgi) + "" + exec-cmd) + " tr7i " + ,(util-getenv "COMPILE_R7RS_TR7") + " -1 " + ,script-file + " " + ,args))))) + (vicare + (type . compiler) + (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") + ,@(map (lambda (item) + (string-append " -I " item " ")) + prepend-directories) + ,@(map (lambda (item) + (string-append " -A " item " ")) + append-directories) + " --compile-program")))))) + (ypsilon + (type . interpreter) + (command . ,(lambda (exec-cmd + script-file + args + input-file + output-file + prepend-directories + append-directories + library-files + r6rs? + compilation-target) + (apply string-append + `(,exec-cmd + " ypsilon " + ,(util-getenv "COMPILE_R7RS_YPSILON") + ,(if r6rs? " --r6rs " " --r7rs ") + " --mute" + " --quiet " + ,@(map (lambda (item) + (string-append "--sitelib=" item " ")) + prepend-directories) + ,@(map (lambda (item) + (string-append "--sitelib=" item " ")) + append-directories) + " --top-level-program " + ,script-file + " " + ,args))))))) diff --git a/libs/implementations.sld b/libs/implementations.sld index 5f6af65..ffce9e3 100644 --- a/libs/implementations.sld +++ b/libs/implementations.sld @@ -7,744 +7,4 @@ (srfi 170) (libs util)) (export data) - (begin - (define pwd (cond-expand (windows "%CD%") (else "${PWD}"))) - (define data - `((capyscheme - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,exec-cmd - " capy " - ,(util-getenv "COMPILE_R7RS_CAPYSCHEME") - " " - ,@(map (lambda (item) - (string-append "-L" " " item " ")) - prepend-directories) - ,@(map (lambda (item) - (string-append "-A" " " item " ")) - append-directories) - " --script " - ,script-file - " " - ,args))))) - (chezscheme - (type . interpreter) - (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 - `(,exec-cmd - " scheme " - ,(util-getenv "COMPILE_R7RS_CHEZSCHEME") - " " - ,(if (and (null? prepend-directories) - (null? append-directories)) - "" - (apply string-append - (list "--libdirs " - "'" - (apply string-append - (map (lambda (item) - (string-append item separator)) - (append prepend-directories append-directories))) - "'"))) - " --program " - ,script-file - " " - ,args)))))) - (chibi - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs - compilation-target) - (apply string-append - `(,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) - ,script-file - " " - ,args))))) - (chicken - (type . compiler) - (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) - (let ((unit (string-append (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) #\/ #\.)))) - (out (string-append (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) #\/ #\.)) - ".o")) - (static-out (string-append (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) #\/ #\.)) - ".a"))) - `(,(string-append "csc -R r7rs -X r7rs " - (util-getenv "COMPILE_R7RS_CHICKEN") - " -static -c -J -o " - out - " " - (search-library-file (append prepend-directories append-directories) library-file) - " " - (apply string-append - (map (lambda (item) - (string-append "-I " item " ")) - (append append-directories - prepend-directories))) - "-unit " - unit) - ,(string-append "ar rcs " static-out " " out))))) - (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 " ")) - (append append-directories prepend-directories))) - (apply string-append - (map (lambda (library-file) - (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) #\/ #\.)) - " ")) - library-files)) - " -output-file " - output-file - " " - input-file))))) - (cyclone - (type . compiler) - (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) - `(,(string-append "cyclone " - (util-getenv "COMPILE_R7RS_CYCLONE") - " " - (apply string-append - (map (lambda (item) (string-append "-I " item " ")) prepend-directories)) - (apply string-append - (map (lambda (item) (string-append "-A " item " ")) append-directories)) - (search-library-file (append prepend-directories - append-directories) - library-file))))) - (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") - " " - (apply string-append - (map (lambda (item) (string-append "-I " item " ")) prepend-directories)) - (apply string-append - (map (lambda (item) (string-append "-A " item " ")) append-directories)) - input-file) - ,(string-append (if (not (string=? (string-cut-from-end input-file 4) output-file)) - (string-append - "mv " - (string-cut-from-end input-file 4) - " " - output-file) - "sleep 0")))))) - (foment - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,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) - ,script-file - " " - ,args))))) - (gambit - (type . compiler) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (let ((library-files-paths - (map (lambda (item) - (search-library-file (append prepend-directories - append-directories) - item)) - library-files))) - `(,(string-append "echo \"#!/usr/bin/env gsi -:r7rs,search=" - (apply string-append - (map (lambda (item) - (string-append item "/, ")) - (append prepend-directories - append-directories))) - "\" > " - (string-append output-file ".tmp")) - ,(string-append "cat " - input-file - " >> " - (string-append output-file ".tmp")) - ,(apply string-append - `(" gsc " - ,(util-getenv "COMPILE_R7RS_GAMBIT") - " -:r7rs,search=" - ,(apply string-append - (map (lambda (item) - (string-append item "/, ")) - (append prepend-directories - append-directories))) - " -o " - ,output-file - " -exe -nopreload " - ,(string-append output-file ".tmp")))))))) - (gauche - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,exec-cmd - " gosh " - ,(util-getenv "COMPILE_R7RS_GAUCHE") - " -r7 " - ,@(map (lambda (item) - (string-append " -I" " " item " ")) - prepend-directories) - ,@(map (lambda (item) - (string-append " -A" " " item " ")) - append-directories) - ,script-file - " " - ,args))))) - (guile - (type . interpreter) - (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) - (let ((library-path (search-library-file (append append-directories - prepend-directories) - library-file))) - `(,(string-append "guild compile " - (if r6rs? " --r6rs " " --r7rs ") - (apply string-append - (map (lambda (item) - (string-append "-L" " " item " ")) - (append prepend-directories - append-directories))) - " -o " - (string-append - (string-cut-from-end library-path 4) - ".go") - library-path))))) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,exec-cmd - " guile " - ,(util-getenv "COMPILE_R7RS_GUILE") - ,(if r6rs? " --r6rs -x .sls " " --r7rs -x .sld ") - ,@(map (lambda (item) - (string-append " -L " item " ")) - (append prepend-directories - append-directories)) - " -s " - ,script-file - " " - ,args))))) - (ikarus - (type . interpreter) - (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 " - ,script-file - " " - ,args))))) - (ironscheme - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs - compilation-target) - (apply string-append - `(,exec-cmd - " ironscheme " - ,(util-getenv "COMPILE_R7RS_IRONSCHEME") - " " - ,@(map (lambda (item) - (string-append "-I \"" item "\" ")) - prepend-directories) - ,@(map (lambda (item) - (string-append "-I \"" item "\" ")) - append-directories) - ,script-file - " " - ,args))))) - (kawa - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,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 --r7rs --full-tailcalls" - ,(util-getenv "COMPILE_R7RS_KAWA") - " -Dkawa.import.path=" - ,@(map (lambda (item) - (if (char=? (string-ref item 0) #\/) - (string-append item "/*.sld:") - (string-append pwd "/" item "/*.sld:"))) - (append prepend-directories - append-directories - (list "/usr/local/share/kawa/lib"))) - " -f " - ,script-file - " " - ,args))))) - (larceny - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,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 " - ,script-file - " -- " - ,args))))) - (loko - (type . compiler) - (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 - (map (lambda (item) - (string-append item ":")) - prepend-directories)) - (apply string-append - (map (lambda (item) - (string-append item ":")) - append-directories)) - " loko " - (util-getenv "COMPILE_R7RS_LOKO") - " " - (if r6rs? "-std=r6rs" "-std=r7rs") - " " - "--compile" - " " - input-file) - ,(string-append "mv " out " " output-file)))))) - (meevax - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs - compilation-target) - (apply string-append - `(,exec-cmd - " meevax " - ,(util-getenv "COMPILE_R7RS_MEEVAX") - ,@(map (lambda (item) - (if (char=? (string-ref item 0) #\/) - (string-append " -I " pwd "/" item " ") - (string-append " -I " item " "))) - prepend-directories) - ,@(map (lambda (item) - (if (char=? (string-ref item 0) #\/) - (string-append " -A " pwd "/" item " ") - (string-append " -A " item " "))) - append-directories) - ,script-file - " " - ,args))))) - (mit-scheme - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs - compilation-target) - (apply string-append - `(,exec-cmd - " mit-scheme --batch-mode --no-init-file " - ,@(map - (lambda (item) - (string-append " --load " - (search-library-file (append append-directories - prepend-directories) - item) - " ")) - library-files) - " --load " - ,script-file - " --eval '(exit 0)' " - ,(if (string=? args "") - "" - (string-append " --args " args))))))) - (mosh - (type . interpreter) - (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) - (string-append - "MOSH_LOADPATH=" - (apply string-append - (map (lambda (item) (string-append item ":")) dirs))) - "") - " " - ,exec-cmd - " mosh " - ,(util-getenv "COMPILE_R7RS_MOSH") - ,script-file - " " - ,args)))))) - (racket - (type . interpreter) - (library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) - (let* ((full-path (search-library-file (append append-directories - prepend-directories) - library-file)) - (library-rkt-file (change-file-suffix full-path ".rkt"))) - (if r6rs? - `("sleep 0") - `(,(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 (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 - `(,exec-cmd - " racket " - ,(util-getenv "COMPILE_R7RS_RACKET") - ,(if r6rs? " -I scheme/init -l r6rs/run.rkt" " -I r7rs ") - ,@(map (lambda (item) - (string-append " -S " item " ")) - (append prepend-directories - append-directories)) - ,(if r6rs? " " " --script ") - ,script-file - " " - ,args)))))) - (sagittarius - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,exec-cmd - ,(if (symbol=? compilation-target 'windows) - " sash.exe -d " - " sash -d ") - ,(util-getenv "COMPILE_R7RS_SAGITTARIUS") - ,(if r6rs? " -r6 " " -r7 ") - ,@(map (lambda (item) - (string-append " -L " item " ")) - prepend-directories) - ,@(map (lambda (item) - (string-append " -A " item " ")) - append-directories) - ,script-file - " " - ,args))))) - (skint - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs - compilation-target) - (apply string-append - `(,exec-cmd - " skint " - ,(util-getenv "COMPILE_R7RS_SKINT") - " " - ,@(map (lambda (item) - (string-append "-I " item "/ ")) - prepend-directories) - ,@(map (lambda (item) - (string-append "-A " item "/ ")) - append-directories) - " --program=" - ,script-file - " " - ,args))))) - (stklos - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,exec-cmd - " stklos " - ,(util-getenv "COMPILE_R7RS_STKLOS") - " " - ,@(map (lambda (item) - (string-append "-I " item " ")) - prepend-directories) - ,@(map (lambda (item) - (string-append "-A " item " ")) - append-directories) - ,script-file - " " - ,args))))) - (tr7 - (type . interpreter) - (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) - (string-append item ":")) - prepend-directories) - ,@(map (lambda (item) - (string-append item ":")) - append-directories) - " " - ,exec-cmd - " tr7i " - ,(util-getenv "COMPILE_R7RS_TR7") - " -1 " - ,script-file - " " - ,args))))) - (vicare - (type . compiler) - (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") - ,@(map (lambda (item) - (string-append " -I " item " ")) - prepend-directories) - ,@(map (lambda (item) - (string-append " -A " item " ")) - append-directories) - " --compile-program"))))) - (ypsilon - (type . interpreter) - (command . ,(lambda (exec-cmd - script-file - args - input-file - output-file - prepend-directories - append-directories - library-files - r6rs? - compilation-target) - (apply string-append - `(,exec-cmd - " ypsilon " - ,(util-getenv "COMPILE_R7RS_YPSILON") - ,(if r6rs? " --r6rs " " --r7rs ") - " --mute" - " --quiet " - ,@(map (lambda (item) - (string-append "--sitelib=" item " ")) - prepend-directories) - ,@(map (lambda (item) - (string-append "--sitelib=" item " ")) - append-directories) - " --top-level-program " - ,script-file - " " - ,args))))))))) + (include "implementations.scm"))