1
0
Fork 0

Add cgi script as compilation target

This commit is contained in:
retropikzel 2026-01-17 10:41:59 +02:00
parent a5174e96b8
commit 677a9c7929
4 changed files with 835 additions and 769 deletions

View File

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

View File

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

775
libs/implementations.scm Normal file
View File

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

View File

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