Retropikzel/compile-scheme
1
0
Fork 0
Code Issues Activity

Added support for many more implementations. Moved much more towards SRFI-138 conformity.

Browse Source
This commit is contained in:
Retropikzel
2025-04-18 05:53:48 +03:00
parent a05aa0c813
commit b043e2efc8
20 changed files with 1152 additions and 289 deletions
Download Patch File Download Diff File Expand all files Collapse all files
libs/data.sld
+380 -96
View File
@@ -3,16 +3,36 @@
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(libs util)
(srfi 170))
(export data)
(begin
(define data
`((chibi
`((chezscheme
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("scheme"
" "
,(util-getenv "COMPILE_R7RS_CHEZSCHEME")
" "
"--quiet"
" "
,@(map (lambda (item)
(string-append "--libdirs " " " item ":"))
(append prepend-directories append-directories))
" "
"--program"
" "
,input-file)))))
(chibi
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("chibi-scheme"
" "
,(util-getenv "COMPILE_R7RS_CHIBI")
" "
,@(map (lambda (item)
(string-append "-I" " " item " "))
@@ -24,103 +44,173 @@
,input-file)))))
(chicken
(type . compiler)
(library-command . ,(lambda (library-file prepend-directories append-directories)
(string-append "csc -J "
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
(apply string-append `("csc -R r7rs -X r7rs -s -J"
" "
,(util-getenv "COMPILE_R7RS_CHICKEN")
" "
"-o"
" "
,@(map (lambda (item)
(if (string-starts-with? library-file item)
(string-append (string-replace (string-copy (string-cut-from-end library-file 4)
(+ (string-length item) 1))
#\/
#\.)
".so")
""))
(append prepend-directories append-directories))
" "
,library-file))))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append `("csc -R r7rs -X r7rs"
" "
library-file)))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(string-append "csc -static " input-file))))
,(util-getenv "COMPILE_R7RS_CHICKEN")
" "
"-output-file"
" "
,output-file
" "
,input-file)))))
(cyclone
(type . compiler)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("cyclone"
" "
,(util-getenv "COMPILE_R7RS_CYCLONE")
" "
"-o"
" "
,output-file
" "
,@(map (lambda (item) (string-append "-I " item " ")) prepend-directories)
,@(map (lambda (item) (string-append "-A " item " ")) append-directories)
,input-file)))))
(foment
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("foment"
" "
,(util-getenv "COMPILE_R7RS_FOMENT")
" "
,@(map (lambda (item)
(string-append "-I" " " item " "))
prepend-directories)
,@(map (lambda (item)
(string-append "-A" " " item " "))
append-directories)
" "
"-l"
" "
,input-file)))))
(gambit
(type . compiler)
(library-command . ,(lambda (library-file prepend-directories append-directories)
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
(apply string-append
`("gsc -c"
`("gsc -obj"
" "
"-o"
,(util-getenv "COMPILE_R7RS_GAMBIT")
" "
,(string-append (string-copy library-file
0
(- (string-length library-file)
4))
".c ")
" "
,@(map (lambda (item) (string-append item "/ ")) prepend-directories)
,@(map (lambda (item) (string-append item "/ ")) append-directories)
,library-file))))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("gsc -nopreload -exe"
`("echo '#!/usr/bin/env -S gsi-script -f -:search="
,@(map (lambda (item)
(string-append item "/"))
(append prepend-directories append-directories))
"'"
" "
">"
" "
,(string-append (string-cut-from-end input-file 4) ".tmp")
" "
"&&"
" "
"cat"
" "
,input-file
" "
">>"
" "
,(string-append (string-cut-from-end input-file 4) ".tmp")
" "
"&&"
" "
"gsc"
" "
,(util-getenv "COMPILE_R7RS_GAMBIT")
" "
"-:search="
,@(map (lambda (item)
(string-append item "/"))
(append prepend-directories append-directories))
" "
"-o"
" "
,output-file
" "
"-exe -nopreload"
" "
,@(map (lambda (item) (string-append item "/ ")) prepend-directories)
" "
,@(map (lambda (item) (string-append item "/ ")) append-directories)
" "
,(string-append (string-cut-from-end input-file 4) ".tmp")
;,input-file
)))))
(gauche
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("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)
" "
,input-file)))))
(gerbil
(type . compiler)
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
(apply string-append
`("gxc"
" "
"-O"
" "
,(util-getenv "COMPILE_R7RS_GERBIL")
" "
,library-file))))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("gxc"
" "
,(util-getenv "COMPILE_R7RS_GERBIL")
" "
"-exe"
" "
,@(map (lambda (item) (string-append item "/ ")) prepend-directories)
,@(map (lambda (item) (string-append item "/ ")) append-directories)
" "
,input-file
;" "
;"&&"
;" "
;"gsc"
;" "
;"-o"
;" "
;,output-file
;" "
;"-exe"
;,@(map (lambda (item) (string-append item "/ ")) prepend-directories)
;,@(map (lambda (item) (string-append item "/ ")) append-directories)
;" "
;,@(map (lambda (item) (string-append (string-copy item 0 (- (string-length item) 4)) ".c")) library-files)
;" "
;,(string-copy input-file 0 (- (string-length input-file) 4))
;".c"
)))))
(cyclone
(type . compiler)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(apply string-append
`("cyclone "
" "
,@(map (lambda (item)
(string-append "-I" " " item " "))
prepend-directories)
,@(map (lambda (item)
(string-append "-A" " " item " "))
append-directories)
" "
,input-file)))))
(gauche
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(apply string-append
`("gosh -r7"
" "
,@(map (lambda (item)
(string-append "-I" " " item " "))
prepend-directories)
,@(map (lambda (item)
(string-append "-A" " " item " "))
append-directories)
" "
,input-file)))))
(loko
(type . compiler)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(apply string-append
`("LOKO_LIBRARY_PATH="
,@(map (lambda (item)
(string-append item ":"))
prepend-directories)
,@(map (lambda (item)
(string-append item ":"))
append-directories)
" "
"loko -std=r7rs --compile"
" "
,input-file)))))
(guile
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("guile --r7rs"
`("guile"
" "
,(util-getenv "COMPILE_R7RS_GUILE")
" "
,(if r6rs? "--r6rs" "--r7rs")
" "
,@(map (lambda (item)
(string-append "-L" " " item " "))
@@ -130,11 +220,66 @@
append-directories)
" "
,input-file)))))
(husk
(type . compiler)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("huskc"
" "
,(util-getenv "COMPILE_R7RS_HUSK")
" "
"-o"
" "
,output-file
" "
;,@(map (lambda (item) (string-append "-L" " " item " ")) prepend-directories)
;,@(map (lambda (item) (string-append "-L" " " item " ")) append-directories)
" "
,input-file)))))
(ikarus
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("IKARUS_LIBRARY_PATH="
,@(map (lambda (item)
(string-append item ":"))
prepend-directories)
,@(map (lambda (item)
(string-append item ":"))
append-directories)
" "
"ikarus"
" "
,(util-getenv "COMPILE_R7RS_IKARUS")
" "
"--r6rs-script"
" "
,input-file)))))
(ironscheme
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("ironscheme"
" "
,(util-getenv "COMPILE_R7RS_IRONSCHEME")
" "
,@(map (lambda (item)
(string-append "-I \"" item "\" "))
prepend-directories)
,@(map (lambda (item)
(string-append "-I \"" item "\" "))
append-directories)
" "
,input-file)))))
(kawa
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("kawa --r7rs --full-tailcalls"
`("kawa"
" "
,(util-getenv "COMPILE_R7RS_KAWA")
" "
"--r7rs"
" "
"-Dkawa.import.path="
,@(map (lambda (item)
@@ -145,11 +290,85 @@
append-directories)
" "
,input-file)))))
(larceny
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("larceny"
,(util-getenv "COMPILE_R7RS_LARCENY")
" "
"-nobanner"
" "
,(if r6rs? "-r6rs" "-r7rs")
" "
,@(map (lambda (item)
(string-append "-I " item " "))
prepend-directories)
,@(map (lambda (item)
(string-append "-A " item " "))
append-directories)
" "
,input-file)))))
(loko
(type . compiler)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("LOKO_LIBRARY_PATH="
,@(map (lambda (item)
(string-append item ":"))
prepend-directories)
,@(map (lambda (item)
(string-append item ":"))
append-directories)
" "
"loko "
" "
,(util-getenv "COMPILE_R7RS_LOKO")
" "
,(if r6rs? "-std=r6rs" "-std=r7rs")
" "
"--compile"
" "
,input-file)))))
(meevax
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("meevax"
" "
,(util-getenv "COMPILE_R7RS_MEEVAX")
" "
;,@(map (lambda (item) (string-append "--load " item " ")) library-files)
;,@(map (lambda (item) (string-append " " item " ")) prepend-directories)
;,@(map (lambda (item) (string-append " " item " ")) append-directories)
" "
,input-file)))))
(mit-scheme
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("mit-scheme"
" "
,(util-getenv "COMPILE_R7RS_MIT_SCHEME")
" "
"--batch-mode"
" "
,@(map (lambda (item)
(string-append "--load " item " "))
library-files)
" "
"--load"
" "
,input-file
" "
"--eval \"(exit 0)\"")))))
(mosh
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("mosh"
" "
,(util-getenv "COMPILE_R7RS_MOSH")
" "
,@(map (lambda (item)
(string-append "--loadpath=" item " "))
@@ -159,9 +378,24 @@
append-directories)
" "
,input-file)))))
(picrin
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("picrin"
" "
,(util-getenv "COMPILE_R7RS_PICRIN")
" "
,@(map (lambda (item)
(string-append "-l " item " "))
library-files)
" "
"-e"
" "
,input-file)))))
(racket
(type . compiler)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(let ((rkt-input-file (if (string=? input-file "")
""
(change-file-suffix input-file ".rkt"))))
@@ -197,19 +431,29 @@
(newline)))))
library-files)
(apply string-append
;; TODO run realpath to each directory
;; as Racket expects static paths
`("PLTCOLLECTS="
,(string-join prepend-directories ":")
,(string-join append-directories ":")
" "
"raco exe --orig-exe ++lang r7rs -o "
"raco exe"
" "
,(util-getenv "COMPILE_R7RS_RACKET")
" "
"--orig-exe ++lang r7rs -o "
,output-file
" "
,rkt-input-file))))))
(sagittarius
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("sash -r7"
`("sash"
" "
,(util-getenv "COMPILE_R7RS_SAGITTARIUS")
" "
,(if r6rs? "-r6" "-r7")
" "
,@(map (lambda (item)
(string-append "-L " item " "))
@@ -221,9 +465,11 @@
,input-file)))))
(skint
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("skint"
" "
,(util-getenv "COMPILE_R7RS_SKINT")
" "
,@(map (lambda (item)
(string-append "-I " item "/ "))
@@ -233,11 +479,25 @@
append-directories)
" "
,input-file)))))
(stak
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("stak"
" "
,(util-getenv "COMPILE_R7RS_STAK")
" "
;,@(map (lambda (item) (string-append "-I " item " ")) prepend-directories)
;,@(map (lambda (item) (string-append "-A " item " ")) append-directories)
" "
,input-file)))))
(stklos
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("stklos"
" "
,(util-getenv "COMPILE_R7RS_STKLOS")
" "
,@(map (lambda (item)
(string-append "-I " item " "))
@@ -249,7 +509,7 @@
,input-file)))))
(tr7
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("TR7_LIB_PATH="
,@(map (lambda (item)
@@ -261,18 +521,42 @@
" "
"tr7i"
" "
,(util-getenv "COMPILE_R7RS_TR7")
" "
,input-file)))))
(vicare
(type . compiler)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(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"
" "
,input-file)))))
(ypsilon
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("ypsilon --r7rs"
`("ypsilon"
" "
,(util-getenv "COMPILE_R7RS_YPSILON")
" "
,(if r6rs? "--r6rs" "--r7rs")
" "
,@(map (lambda (item)
(string-append "--sitelib=" item))
(string-append "--sitelib=" item " "))
prepend-directories)
,@(map (lambda (item)
(string-append "--sitelib=" item))
(string-append "--sitelib=" item " "))
append-directories)
" "
,input-file)))))))))
libs/util.sld
+23 -3
View File
@@ -1,18 +1,31 @@
(define-library
(libs util)
(import (scheme base))
(import (scheme base)
(scheme process-context))
(export string-replace
string-ends-with?
string-starts-with?
string-cut-from-end
string-find
string-reverse
path->filename
change-file-suffix
string-join)
string-join
util-getenv)
(begin
(define util-getenv
(lambda (name)
(if (get-environment-variable name)
(get-environment-variable name)
"")))
(define string-replace
(lambda (string-content replace with)
(string-map (lambda (c) (char=? c replace) with c) string-content)))
(string-map (lambda (c)
(if (char=? c replace)
with c))
string-content)))
(define string-ends-with?
(lambda (string-content end)
@@ -34,6 +47,13 @@
#t
#f)))
(define string-cut-from-end
(lambda (string-content cut-length)
(string-copy string-content
0
(- (string-length string-content) 4))))
(define string-find
(lambda (string-content character)
(letrec* ((string-list (string->list string-content))