1
0
Fork 0

Compare commits

...

5 Commits

Author SHA1 Message Date
retropikzel f242adb81f Rename libnames that I forgot 2025-12-05 12:54:36 +02:00
retropikzel fee543372a Rename libs/data to libs/implementations. Code cleanup 2025-12-05 12:49:58 +02:00
retropikzel d1eb851b28 Fixing tests 2025-12-04 17:53:12 +02:00
retropikzel b2f72f5d77 Fixing tests 2025-12-04 11:57:15 +02:00
retropikzel 8ecaaa8d5a Add support for capyscheme 2025-12-04 10:23:34 +02:00
7 changed files with 836 additions and 845 deletions

43
Jenkinsfile vendored
View File

@ -13,6 +13,11 @@ pipeline {
buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
}
parameters {
string(name: 'R6RS_SCHEMES', defaultValue: 'capyscheme chezscheme guile ikarus ironscheme larceny loko mosh racket sagittarius ypsilon', description: '')
string(name: 'R7RS_SCHEMES', defaultValue: 'capyscheme chibi chicken cyclone gambit foment gauche guile kawa larceny loko meevax mit-scheme mosh racket sagittarius skint stklos tr7 ypsilon', description: '')
}
stages {
stage('Build and install') {
steps {
@ -21,29 +26,31 @@ pipeline {
}
}
stage('Test R6RS') {
steps {
script {
def SCHEMES = "chezscheme guile ikarus ironscheme larceny loko mosh racket sagittarius ypsilon"
SCHEMES.split().each { SCHEME ->
stage("${SCHEME} R6RS") {
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
sh "make SCHEME=${SCHEME} test-r6rs-docker"
stage('Test') {
parallel {
stage('R6RS') {
steps {
script {
R7RS_SCHEMES.split().each { SCHEME ->
stage("${SCHEME} R6RS") {
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
sh "make SCHEME=${SCHEME} test-r6rs-docker"
}
}
}
}
}
}
}
}
stage('Test R7RS') {
steps {
script {
def SCHEMES = "chibi chicken cyclone gambit foment gauche guile kawa larceny loko meevax mit-scheme mosh racket sagittarius skint stklos tr7 ypsilon"
SCHEMES.split().each { SCHEME ->
stage("${SCHEME} R7RS") {
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
sh "make SCHEME=${SCHEME} test-r7rs-docker"
stage('R7RS') {
steps {
script {
R7RS_SCHEMES.split().each { SCHEME ->
stage("${SCHEME} R7RS") {
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
sh "make SCHEME=${SCHEME} test-r7rs-docker"
}
}
}
}
}

View File

@ -11,7 +11,7 @@ endif
ifeq "${SCHEME}" "vicare"
DOCKERIMG="vicare"
endif
STATIC_LIBS=libs.util.a libs.library-util.a libs.data.a libs.srfi-64-util.a
STATIC_LIBS=libs.util.a libs.library-util.a libs.implementations.a libs.srfi-64-util.a
all: build-chibi
@ -28,13 +28,13 @@ build-chicken:
ar rcs libs.util.a libs.util.o
csc -R r7rs -X r7rs -static -c -J -unit libs.library-util -o libs.library-util.o libs/library-util.sld
ar rcs libs.library-util.a libs.library-util.o
csc -R r7rs -X r7rs -static -c -J -unit libs.data -o libs.data.o libs/data.sld
ar rcs libs.data.a libs.data.o
csc -R r7rs -X r7rs -static -c -J -unit libs.implementations -o libs.implementations.o libs/implementations.sld
ar rcs libs.implementation.a libs.implementations.o
csc -R r7rs -X r7rs -static \
-o compile-scheme \
-uses libs.util \
-uses libs.library-util \
-uses libs.data \
-uses libs.implementations \
-uses foreign.c \
-uses srfi-170 \
compile-scheme.scm

View File

@ -53,8 +53,12 @@ OPTIONS
--list-r6rs List supported R6RS implementations.
--list-r6rs-except List supported R6RS implementations, except ones given.
--list-r7rs List supported R7RS implementations.
--list-r7rs-except List supported R7RS implementations, except ones given.
--list-all List all supported implementations.
--version Show the software version.

View File

@ -1,12 +1,12 @@
(import (scheme base)
(scheme file)
(scheme read)
(scheme write)
(scheme process-context)
(libs util)
(libs data)
(libs library-util)
(srfi 170))
(scheme file)
(scheme read)
(scheme write)
(scheme process-context)
(libs util)
(libs implementations)
(libs library-util)
(srfi 170))
(define debug? (if (member "--debug" (command-line)) #t #f))
@ -110,9 +110,7 @@
(if input-file
"a.out"
#f))))
(if (and (symbol=? scheme-type 'compiler)
;(symbol=? compilation-target 'php)
)
(if (and (symbol=? scheme-type 'compiler))
(string-append outfile ".bin")
outfile)))
@ -130,10 +128,7 @@
((member "-o" (command-line))
(cadr (member "-o" (command-line))))
(input-file (string-cut-from-end input-file 4)))))
(if (and (symbol=? scheme-type 'compiler)
(symbol=? compilation-target 'php))
(string-append outfile ".bin")
outfile)))
outfile))
(define prepend-directories
(letrec ((looper (lambda (rest result)
@ -210,15 +205,12 @@
(list
(cond
((symbol=? compilation-target 'windows) "")
((symbol=? compilation-target 'php) "")
(else "exec"))
(cond
((symbol=? compilation-target 'windows) "%0%")
((symbol=? compilation-target 'php) "$binname")
(else "\"$0\""))
(cond
((symbol=? compilation-target 'windows) "")
((symbol=? compilation-target 'php) "")
(else "\"$@\""))
(if input-file input-file "")
(if output-file output-file "")
@ -283,24 +275,6 @@
#\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
@ -323,27 +297,5 @@
(let ((exit-code (system command)))
(when (not (= exit-code 0))
(exit exit-code))))
scheme-command)
(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)))
scheme-command))

View File

@ -1,761 +0,0 @@
(define-library
(libs data)
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(srfi 170)
(libs util))
(export data)
(begin
(define pwd (cond-expand (windows "%CD%") (else "${PWD}")))
(define data
`((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
" chezscheme "
,(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)
#;(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
`(,(string-append "gsc -:search="
(apply string-append
(map (lambda (item)
(string-append item "/, "))
(append prepend-directories
append-directories)))
(search-library-file (append append-directories
prepend-directories)
library-file)))))
(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))
(link-file
(string-append
(string-cut-from-end input-file 4) "_.c")))
`(,(string-append "gsc -:search="
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item ","))
(append prepend-directories
append-directories)))
1)
" -link -flat -nopreload "
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item " "))
library-files-paths))
1)
" "
input-file)
,(string-append "gsc -:search="
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item ","))
(append prepend-directories
append-directories)))
1)
" -obj "
(apply string-append
(map (lambda (item)
(string-append (string-cut-from-end item 4) ".c "))
library-files-paths))
" "
(string-append (string-cut-from-end input-file 4) ".c")
" "
(string-append (string-cut-from-end input-file 4) "_.c"))
,(string-append "gcc -o "
output-file
" "
(apply string-append
(map (lambda (item)
(string-append (string-cut-from-end item 4) ".o "))
library-files-paths))
" "
(string-append (string-cut-from-end input-file 4) ".o")
" "
(string-append (string-cut-from-end input-file 4) "_.o"))
)))))
(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
,(if (symbol=? compilation-target 'windows)
" gosh.exe "
" 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 --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 "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 (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
,(if r6rs?
" plt-r6rs "
" racket ")
,(util-getenv "COMPILE_R7RS_RACKET")
,(if r6rs? "" " -I r7rs ")
,@(map (lambda (item)
(string-append
(if r6rs? " ++path " " -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")
,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)))))))))

786
libs/implementations.sld Normal file
View File

@ -0,0 +1,786 @@
(define-library
(libs implementations)
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(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 " "))
(append prepend-directories
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
" chezscheme "
,(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)
#;(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
`(,(string-append "gsc -:search="
(apply string-append
(map (lambda (item)
(string-append item "/, "))
(append prepend-directories
append-directories)))
(search-library-file (append append-directories
prepend-directories)
library-file)))))
(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))
(link-file
(string-append
(string-cut-from-end input-file 4) "_.c")))
`(,(string-append "gsc -:search="
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item ","))
(append prepend-directories
append-directories)))
1)
" -link -flat -nopreload "
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item " "))
library-files-paths))
1)
" "
input-file)
,(string-append "gsc -:search="
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item ","))
(append prepend-directories
append-directories)))
1)
" -obj "
(apply string-append
(map (lambda (item)
(string-append (string-cut-from-end item 4) ".c "))
library-files-paths))
" "
(string-append (string-cut-from-end input-file 4) ".c")
" "
(string-append (string-cut-from-end input-file 4) "_.c"))
,(string-append "gcc -o "
output-file
" "
(apply string-append
(map (lambda (item)
(string-append (string-cut-from-end item 4) ".o "))
library-files-paths))
" "
(string-append (string-cut-from-end input-file 4) ".o")
" "
(string-append (string-cut-from-end input-file 4) "_.o"))
)))))
(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
,(if (symbol=? compilation-target 'windows)
" gosh.exe "
" 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 "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 (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
,(if r6rs?
" plt-r6rs "
" racket ")
,(util-getenv "COMPILE_R7RS_RACKET")
,(if r6rs? "" " -I r7rs ")
,@(map (lambda (item)
(string-append
(if r6rs? " ++path " " -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")
,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

@ -56,7 +56,8 @@
(define (echo text) (display text) (newline))
(define (cat path) (for-each (lambda (line) (echo line)) (file->list path)))
(define r6rs-schemes '(chezscheme
(define r6rs-schemes '(capyscheme
chezscheme
guile
ikarus
ironscheme
@ -67,7 +68,8 @@
sagittarius
ypsilon))
(define r7rs-schemes '(chibi
(define r7rs-schemes '(capyscheme
chibi
chicken
cyclone
;gambit
@ -86,7 +88,8 @@
stklos
tr7
ypsilon))
(define all-schemes '(chezscheme
(define all-schemes '(capyscheme
chezscheme
chibi
chicken
cyclone