Adding test-r7rs
This commit is contained in:
+578
@@ -0,0 +1,578 @@
|
||||
(define data
|
||||
`((chezscheme
|
||||
(type . interpreter)
|
||||
(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 " "))
|
||||
prepend-directories)
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A" " " item " "))
|
||||
append-directories)
|
||||
,input-file)))))
|
||||
(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")))
|
||||
(apply 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)
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-I " item " "))
|
||||
(append append-directories
|
||||
prepend-directories))
|
||||
"-unit "
|
||||
,unit
|
||||
" "
|
||||
"&&"
|
||||
" "
|
||||
"ar"
|
||||
" "
|
||||
"rcs"
|
||||
" "
|
||||
,static-out
|
||||
" "
|
||||
,out)))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append `("csc -R r7rs -X r7rs"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_CHICKEN")
|
||||
" "
|
||||
"-static"
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-I " item " "))
|
||||
(append append-directories prepend-directories))
|
||||
,@(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?)
|
||||
(apply string-append
|
||||
`("cyclone"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_CYCLONE")
|
||||
" "
|
||||
,@(map (lambda (item) (string-append "-I " item " ")) prepend-directories)
|
||||
,@(map (lambda (item) (string-append "-A " item " ")) append-directories)
|
||||
,(search-library-file (append prepend-directories
|
||||
append-directories)
|
||||
library-file)))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append
|
||||
`("cyclone "
|
||||
,(util-getenv "COMPILE_R7RS_CYCLONE")
|
||||
" "
|
||||
,@(map (lambda (item) (string-append "-I " item " ")) prepend-directories)
|
||||
,@(map (lambda (item) (string-append "-A " item " ")) append-directories)
|
||||
,input-file
|
||||
,(if (not (string=? (string-cut-from-end input-file 4) output-file))
|
||||
(string-append
|
||||
" && "
|
||||
"mv "
|
||||
(string-cut-from-end input-file 4)
|
||||
" "
|
||||
output-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)
|
||||
" "
|
||||
,input-file)))))
|
||||
(gambit
|
||||
(type . compiler)
|
||||
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
|
||||
(apply string-append `("gsc -:r7rs -obj "
|
||||
,@(map (lambda (item)
|
||||
(string-append item "/ "))
|
||||
(append prepend-directories
|
||||
append-directories))
|
||||
,(search-library-file (append append-directories
|
||||
prepend-directories)
|
||||
library-file)))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(let ((real
|
||||
(string-append (string-cut-from-end input-file 4)
|
||||
"-real")))
|
||||
(apply
|
||||
string-append
|
||||
`("gsc -o " ,real
|
||||
" -exe -nopreload "
|
||||
,@(map (lambda (item)
|
||||
(string-append item "/ "))
|
||||
(append prepend-directories
|
||||
append-directories))
|
||||
,input-file
|
||||
" && "
|
||||
"printf '#!/bin/sh\\n./" ,real
|
||||
" -:r7rs,search="
|
||||
,@(map (lambda (item)
|
||||
(string-append item "/ "))
|
||||
(append prepend-directories
|
||||
append-directories))
|
||||
""
|
||||
"\\n"
|
||||
"'"
|
||||
" > " ,output-file
|
||||
" && "
|
||||
"chmod +x " ,output-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)))))
|
||||
(guile
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append
|
||||
`("guile"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_GUILE")
|
||||
" "
|
||||
,(if r6rs? "--r6rs" "--r7rs")
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-L" " " item " "))
|
||||
(append prepend-directories
|
||||
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
|
||||
`("export IKARUS_LIBRARY_PATH="
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
append-directories)
|
||||
"\n"
|
||||
"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 r6rs?)
|
||||
(apply string-append
|
||||
`("kawa"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_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 "
|
||||
"-Dkawa.import.path=\""
|
||||
,@(map (lambda (item)
|
||||
(string-append item "/*.sld:"))
|
||||
(append prepend-directories
|
||||
append-directories
|
||||
(list "/usr/local/share/kawa/lib")))
|
||||
"\" "
|
||||
"--r7rs"
|
||||
" "
|
||||
,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"
|
||||
" "
|
||||
"-quiet"
|
||||
" "
|
||||
"-utf8"
|
||||
" "
|
||||
,(if r6rs? "-r6rs" "-r7rs")
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-I " item " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A " item " "))
|
||||
append-directories)
|
||||
" "
|
||||
"-program"
|
||||
" "
|
||||
,input-file)))))
|
||||
(loko
|
||||
(type . compiler)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(let ((out (string-cut-from-end input-file 4)))
|
||||
(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
|
||||
" "
|
||||
"&&"
|
||||
" "
|
||||
"mv"
|
||||
" "
|
||||
,out
|
||||
" "
|
||||
,output-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 "-I" " " item " "))
|
||||
prepend-directories)
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A" " " 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")
|
||||
" "
|
||||
,@(map
|
||||
(lambda (item)
|
||||
(string-append "--load "
|
||||
(search-library-file (append append-directories
|
||||
prepend-directories)
|
||||
item)
|
||||
" "))
|
||||
library-files)
|
||||
" "
|
||||
"--load"
|
||||
" "
|
||||
,input-file
|
||||
" "
|
||||
"--eval \"(exit 0)\"")))))
|
||||
(mosh
|
||||
(type . interpreter)
|
||||
(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 " "))
|
||||
(append append-directories prepend-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 . 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?
|
||||
(apply string-append
|
||||
`("plt-r6rs"
|
||||
" "
|
||||
"--compile"
|
||||
" "
|
||||
,library-file))
|
||||
(apply string-append
|
||||
`("printf"
|
||||
" "
|
||||
"'#lang r7rs\\n"
|
||||
"(import (except (scheme base) let let-values let*-values string-copy string-copy! string-for-each string-map string-fill! string->list))\\n"
|
||||
"(include \""
|
||||
,(path->filename library-file)
|
||||
"\")\\n"
|
||||
"'"
|
||||
" "
|
||||
">"
|
||||
" "
|
||||
,library-rkt-file))))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(let ((rkt-input-file (if (string=? input-file "")
|
||||
""
|
||||
(change-file-suffix input-file ".rkt"))))
|
||||
(when (not r6rs?)
|
||||
(when (not (string=? rkt-input-file ""))
|
||||
(when (file-exists? rkt-input-file)
|
||||
(delete-file rkt-input-file))
|
||||
(with-output-to-file
|
||||
rkt-input-file
|
||||
(lambda ()
|
||||
(display "#lang r7rs")
|
||||
(newline)
|
||||
(display "(import (except (scheme base) let let-values let*-values string-copy string-copy! string-for-each string-map string-fill! string->list))")
|
||||
(newline)
|
||||
(display "(include \"")
|
||||
(display (path->filename input-file))
|
||||
(display "\")")
|
||||
(newline)))))
|
||||
(apply string-append
|
||||
`("racket "
|
||||
,(util-getenv "COMPILE_R7RS_RACKET")
|
||||
" "
|
||||
;"-I " ,(if r6rs? "r6rs " "r7rs ")
|
||||
,@(map (lambda (item)
|
||||
(string-append "-S " item " "))
|
||||
(append prepend-directories
|
||||
append-directories))
|
||||
" "
|
||||
,(if r6rs? input-file rkt-input-file)))))))
|
||||
(sagittarius
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append
|
||||
`("sash "
|
||||
,(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)
|
||||
" "
|
||||
,input-file)))))
|
||||
(skint
|
||||
(type . interpreter)
|
||||
(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 "/ "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A " item "/ "))
|
||||
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 r6rs?)
|
||||
(apply string-append
|
||||
`("stklos"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_STKLOS")
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-I " item " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A " item " "))
|
||||
append-directories)
|
||||
" "
|
||||
,input-file)))))
|
||||
(tr7
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append
|
||||
`("TR7_LIB_PATH="
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
append-directories)
|
||||
" "
|
||||
"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 r6rs?)
|
||||
(apply string-append
|
||||
`("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"
|
||||
" "
|
||||
,input-file)))))))
|
||||
+1
-579
@@ -7,582 +7,4 @@
|
||||
(srfi 170)
|
||||
(libs util))
|
||||
(export data)
|
||||
(begin
|
||||
(define data
|
||||
`((chezscheme
|
||||
(type . interpreter)
|
||||
(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 " "))
|
||||
prepend-directories)
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A" " " item " "))
|
||||
append-directories)
|
||||
,input-file)))))
|
||||
(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")))
|
||||
(apply 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)
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-I " item " "))
|
||||
(append append-directories
|
||||
prepend-directories))
|
||||
"-unit "
|
||||
,unit
|
||||
" "
|
||||
"&&"
|
||||
" "
|
||||
"ar"
|
||||
" "
|
||||
"rcs"
|
||||
" "
|
||||
,static-out
|
||||
" "
|
||||
,out)))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append `("csc -R r7rs -X r7rs"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_CHICKEN")
|
||||
" "
|
||||
"-static"
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-I " item " "))
|
||||
(append append-directories prepend-directories))
|
||||
,@(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?)
|
||||
(apply string-append
|
||||
`("cyclone"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_CYCLONE")
|
||||
" "
|
||||
,@(map (lambda (item) (string-append "-I " item " ")) prepend-directories)
|
||||
,@(map (lambda (item) (string-append "-A " item " ")) append-directories)
|
||||
,(search-library-file (append prepend-directories
|
||||
append-directories)
|
||||
library-file)))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append
|
||||
`("cyclone "
|
||||
,(util-getenv "COMPILE_R7RS_CYCLONE")
|
||||
" "
|
||||
,@(map (lambda (item) (string-append "-I " item " ")) prepend-directories)
|
||||
,@(map (lambda (item) (string-append "-A " item " ")) append-directories)
|
||||
,input-file
|
||||
,(if (not (string=? (string-cut-from-end input-file 4) output-file))
|
||||
(string-append
|
||||
" && "
|
||||
"mv "
|
||||
(string-cut-from-end input-file 4)
|
||||
" "
|
||||
output-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)
|
||||
" "
|
||||
,input-file)))))
|
||||
(gambit
|
||||
(type . compiler)
|
||||
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
|
||||
(apply string-append `("gsc -:r7rs -obj "
|
||||
,@(map (lambda (item)
|
||||
(string-append item "/ "))
|
||||
(append prepend-directories
|
||||
append-directories))
|
||||
,(search-library-file (append append-directories
|
||||
prepend-directories)
|
||||
library-file)))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(let ((real
|
||||
(string-append (string-cut-from-end input-file 4)
|
||||
"-real")))
|
||||
(apply
|
||||
string-append
|
||||
`("gsc -o " ,real
|
||||
" -exe -nopreload "
|
||||
,@(map (lambda (item)
|
||||
(string-append item "/ "))
|
||||
(append prepend-directories
|
||||
append-directories))
|
||||
,input-file
|
||||
" && "
|
||||
"printf '#!/bin/sh\\n./" ,real
|
||||
" -:r7rs,search="
|
||||
,@(map (lambda (item)
|
||||
(string-append item "/ "))
|
||||
(append prepend-directories
|
||||
append-directories))
|
||||
""
|
||||
"\\n"
|
||||
"'"
|
||||
" > " ,output-file
|
||||
" && "
|
||||
"chmod +x " ,output-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)))))
|
||||
(guile
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append
|
||||
`("guile"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_GUILE")
|
||||
" "
|
||||
,(if r6rs? "--r6rs" "--r7rs")
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-L" " " item " "))
|
||||
(append prepend-directories
|
||||
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
|
||||
`("export IKARUS_LIBRARY_PATH="
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
append-directories)
|
||||
"\n"
|
||||
"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 r6rs?)
|
||||
(apply string-append
|
||||
`("kawa"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_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 "
|
||||
"-Dkawa.import.path=\""
|
||||
,@(map (lambda (item)
|
||||
(string-append item "/*.sld:"))
|
||||
(append prepend-directories
|
||||
append-directories
|
||||
(list "/usr/local/share/kawa/lib")))
|
||||
"\" "
|
||||
"--r7rs"
|
||||
" "
|
||||
,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"
|
||||
" "
|
||||
"-quiet"
|
||||
" "
|
||||
"-utf8"
|
||||
" "
|
||||
,(if r6rs? "-r6rs" "-r7rs")
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-I " item " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A " item " "))
|
||||
append-directories)
|
||||
" "
|
||||
"-program"
|
||||
" "
|
||||
,input-file)))))
|
||||
(loko
|
||||
(type . compiler)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(let ((out (string-cut-from-end input-file 4)))
|
||||
(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
|
||||
" "
|
||||
"&&"
|
||||
" "
|
||||
"mv"
|
||||
" "
|
||||
,out
|
||||
" "
|
||||
,output-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 "-I" " " item " "))
|
||||
prepend-directories)
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A" " " 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")
|
||||
" "
|
||||
,@(map
|
||||
(lambda (item)
|
||||
(string-append "--load "
|
||||
(search-library-file (append append-directories
|
||||
prepend-directories)
|
||||
item)
|
||||
" "))
|
||||
library-files)
|
||||
" "
|
||||
"--load"
|
||||
" "
|
||||
,input-file
|
||||
" "
|
||||
"--eval \"(exit 0)\"")))))
|
||||
(mosh
|
||||
(type . interpreter)
|
||||
(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 " "))
|
||||
(append append-directories prepend-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 . 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?
|
||||
(apply string-append
|
||||
`("plt-r6rs"
|
||||
" "
|
||||
"--compile"
|
||||
" "
|
||||
,library-file))
|
||||
(apply string-append
|
||||
`("printf"
|
||||
" "
|
||||
"'#lang r7rs\\n"
|
||||
"(import (except (scheme base) let let-values let*-values string-copy string-copy! string-for-each string-map string-fill! string->list))\\n"
|
||||
"(include \""
|
||||
,(path->filename library-file)
|
||||
"\")\\n"
|
||||
"'"
|
||||
" "
|
||||
">"
|
||||
" "
|
||||
,library-rkt-file))))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(let ((rkt-input-file (if (string=? input-file "")
|
||||
""
|
||||
(change-file-suffix input-file ".rkt"))))
|
||||
(when (not r6rs?)
|
||||
(when (not (string=? rkt-input-file ""))
|
||||
(when (file-exists? rkt-input-file)
|
||||
(delete-file rkt-input-file))
|
||||
(with-output-to-file
|
||||
rkt-input-file
|
||||
(lambda ()
|
||||
(display "#lang r7rs")
|
||||
(newline)
|
||||
(display "(import (except (scheme base) let let-values let*-values string-copy string-copy! string-for-each string-map string-fill! string->list))")
|
||||
(newline)
|
||||
(display "(include \"")
|
||||
(display (path->filename input-file))
|
||||
(display "\")")
|
||||
(newline)))))
|
||||
(apply string-append
|
||||
`("racket "
|
||||
,(util-getenv "COMPILE_R7RS_RACKET")
|
||||
" "
|
||||
;"-I " ,(if r6rs? "r6rs " "r7rs ")
|
||||
,@(map (lambda (item)
|
||||
(string-append "-S " item " "))
|
||||
(append prepend-directories
|
||||
append-directories))
|
||||
" "
|
||||
,(if r6rs? input-file rkt-input-file)))))))
|
||||
(sagittarius
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append
|
||||
`("sash "
|
||||
,(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)
|
||||
" "
|
||||
,input-file)))))
|
||||
(skint
|
||||
(type . interpreter)
|
||||
(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 "/ "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A " item "/ "))
|
||||
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 r6rs?)
|
||||
(apply string-append
|
||||
`("stklos"
|
||||
" "
|
||||
,(util-getenv "COMPILE_R7RS_STKLOS")
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-I " item " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "-A " item " "))
|
||||
append-directories)
|
||||
" "
|
||||
,input-file)))))
|
||||
(tr7
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
|
||||
(apply string-append
|
||||
`("TR7_LIB_PATH="
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
append-directories)
|
||||
" "
|
||||
"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 r6rs?)
|
||||
(apply string-append
|
||||
`("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"
|
||||
" "
|
||||
,input-file)))))))))
|
||||
(include "data.scm"))
|
||||
|
||||
@@ -0,0 +1,84 @@
|
||||
|
||||
(define (get-number text)
|
||||
(let
|
||||
((result
|
||||
(trim
|
||||
(string-reverse
|
||||
(string-copy (string-reverse text) 0 4)))))
|
||||
(if (not result)
|
||||
""
|
||||
result)))
|
||||
|
||||
(define (srfi-64-output-read text)
|
||||
(let ((result (list)))
|
||||
(for-each
|
||||
(lambda (line)
|
||||
(cond
|
||||
((not (string? line)) #f)
|
||||
((string-starts-with? line "# of expected passes")
|
||||
(set! result (append result
|
||||
(list (cons 'expected-passes
|
||||
(get-number line))))))
|
||||
((string-starts-with? line "# of unexpected passes")
|
||||
(set! result (append result
|
||||
(list (cons 'unexpected-passes
|
||||
(get-number line))))))
|
||||
((string-starts-with? line "# of expected failures")
|
||||
(set! result (append result
|
||||
(list (cons 'expected-failures
|
||||
(get-number line))))))
|
||||
((string-starts-with? line "# of failures")
|
||||
(set! result (append result
|
||||
(list (cons 'failures
|
||||
(get-number line))))))
|
||||
((string-starts-with? line "# of skipped")
|
||||
(set! result (append result
|
||||
(list (cons 'skipped
|
||||
(get-number line))))))))
|
||||
(string-split text #\newline))
|
||||
(when (not (assoc 'expected-passes result))
|
||||
(set! result (append result (list (cons 'expected-passes "")))))
|
||||
(when (not (assoc 'unexpected-passes result))
|
||||
(set! result (append result (list (cons 'unexpected-passes "")))))
|
||||
(when (not (assoc 'expected-failures result))
|
||||
(set! result (append result (list (cons 'expected-failures "")))))
|
||||
(when (not (assoc 'failures result))
|
||||
(set! result (append result (list (cons 'failures "")))))
|
||||
(when (not (assoc 'skipped result))
|
||||
(set! result (append result (list (cons 'skipped "")))))
|
||||
result))
|
||||
|
||||
(define (line->data line)
|
||||
(let ((pair (apply cons (map trim-both (string-split line #\:)))))
|
||||
(cons (string->symbol (car pair)) (cdr pair))))
|
||||
|
||||
(define (read-test-data)
|
||||
(letrec
|
||||
((looper
|
||||
(lambda (results line count)
|
||||
(if (>= count 7)
|
||||
results
|
||||
(looper (append results
|
||||
(if (string-starts-with? line "Test end")
|
||||
(list)
|
||||
(list (line->data line))))
|
||||
(read-line)
|
||||
(+ count 1))))))
|
||||
(looper (list) (read-line) 0)))
|
||||
|
||||
(define (srfi-64-log-results path)
|
||||
(letrec
|
||||
((looper
|
||||
(lambda (results group line)
|
||||
(cond
|
||||
((eof-object? line) results)
|
||||
((string-starts-with? line "Group begin:")
|
||||
(looper results `(group . ,(cdr (line->data line))) (read-line)))
|
||||
((string-starts-with? line "Test begin:")
|
||||
(looper (append results (list (append (list group) (read-test-data))))
|
||||
group
|
||||
(read-line)))
|
||||
(else (looper results group (read-line)))))))
|
||||
(with-input-from-file
|
||||
path
|
||||
(lambda () (looper (list) '(group . "") (read-line))))))
|
||||
@@ -0,0 +1,10 @@
|
||||
(define-library
|
||||
(libs srfi-64-util)
|
||||
(import (scheme base)
|
||||
(scheme read)
|
||||
(scheme write)
|
||||
(scheme file)
|
||||
(libs util))
|
||||
(export srfi-64-output-read
|
||||
srfi-64-log-results)
|
||||
(include "srfi-64-util.scm"))
|
||||
+213
@@ -0,0 +1,213 @@
|
||||
(define (echo text) (display text) (newline))
|
||||
(define (cat path) (for-each (lambda (line) (echo line)) (file->list path)))
|
||||
(define r6rs-schemes '(chezscheme
|
||||
guile
|
||||
ikarus
|
||||
ironscheme
|
||||
larceny
|
||||
loko
|
||||
mosh
|
||||
racket
|
||||
sagittarius
|
||||
ypsilon))
|
||||
|
||||
(define r7rs-schemes '(chibi
|
||||
chicken
|
||||
cyclone
|
||||
gambit
|
||||
foment
|
||||
gauche
|
||||
guile
|
||||
kawa
|
||||
larceny
|
||||
loko
|
||||
meevax
|
||||
mit-scheme
|
||||
mosh
|
||||
racket
|
||||
sagittarius
|
||||
skint
|
||||
stklos
|
||||
tr7
|
||||
ypsilon))
|
||||
|
||||
(define all-schemes (append r6rs-schemes r7rs-schemes))
|
||||
|
||||
|
||||
(define util-getenv
|
||||
(lambda (name)
|
||||
(if (get-environment-variable name)
|
||||
(get-environment-variable name)
|
||||
"")))
|
||||
|
||||
(define dirname
|
||||
(lambda (path)
|
||||
(letrec ((looper (lambda (dirpath)
|
||||
(cond ((= (string-length dirpath) 0) dirpath)
|
||||
((char=? (string-ref dirpath 0) #\/) (string-copy dirpath 1))
|
||||
(else (looper (string-copy dirpath 1)))))))
|
||||
(string-reverse (looper (string-reverse path))))))
|
||||
|
||||
(define string-replace
|
||||
(lambda (string-content replace with)
|
||||
(string-map (lambda (c)
|
||||
(if (char=? c replace)
|
||||
with c))
|
||||
string-content)))
|
||||
|
||||
(define string-replace-one
|
||||
(lambda (string-content replace with)
|
||||
(let ((replaced? #f))
|
||||
(string-map (lambda (c)
|
||||
(if (and (not replaced?)
|
||||
(char=? c replace))
|
||||
with c))
|
||||
string-content))))
|
||||
|
||||
(define string-replace-one-from-end
|
||||
(lambda (string-content replace with)
|
||||
(let ((replaced? #f))
|
||||
(list->string (reverse (map (lambda (c)
|
||||
(if (and (not replaced?)
|
||||
(char=? c replace))
|
||||
with c))
|
||||
(reverse (string->list string-content))))))))
|
||||
|
||||
(define string-ends-with?
|
||||
(lambda (string-content end)
|
||||
(if (and (>= (string-length string-content) (string-length end))
|
||||
(string=? (string-copy string-content
|
||||
(- (string-length string-content)
|
||||
(string-length end)))
|
||||
end))
|
||||
#t
|
||||
#f)))
|
||||
|
||||
(define string-starts-with?
|
||||
(lambda (string-content start)
|
||||
(if (and (>= (string-length string-content) (string-length start))
|
||||
(string=? (string-copy string-content
|
||||
0
|
||||
(string-length start))
|
||||
start))
|
||||
#t
|
||||
#f)))
|
||||
|
||||
(define string-cut-from-end
|
||||
(lambda (string-content cut-length)
|
||||
(string-copy string-content
|
||||
0
|
||||
(- (string-length string-content) cut-length))))
|
||||
|
||||
|
||||
(define string-find
|
||||
(lambda (string-content character)
|
||||
(letrec* ((string-list (string->list string-content))
|
||||
(looper (lambda (c rest index)
|
||||
(cond ((null? rest) #f)
|
||||
((char=? c character) index)
|
||||
(else (looper (car rest)
|
||||
(cdr rest)
|
||||
(+ index 1)))))))
|
||||
(looper (car string-list)
|
||||
(cdr string-list)
|
||||
0))))
|
||||
|
||||
(define string-reverse
|
||||
(lambda (string-content)
|
||||
(list->string (reverse (string->list string-content)))))
|
||||
|
||||
(define (string-split text c)
|
||||
(letrec* ((looper (lambda (previous rest result)
|
||||
(if (null? rest)
|
||||
(append result (list previous))
|
||||
(if (char=? (car rest) c)
|
||||
(looper (list)
|
||||
(cdr rest)
|
||||
(append result (list previous)))
|
||||
(looper (append previous (list (car rest)))
|
||||
(cdr rest)
|
||||
result)))))
|
||||
(chars (string->list text)))
|
||||
(map list->string (looper (list) chars (list)))))
|
||||
|
||||
(define path->filename
|
||||
(lambda (path)
|
||||
(let ((last-slash-index (string-find (string-reverse path) #\/)))
|
||||
(cond ((not last-slash-index) path)
|
||||
(else (string-copy path (- (string-length path)
|
||||
last-slash-index)))))))
|
||||
|
||||
(define change-file-suffix
|
||||
(lambda (path new-suffix)
|
||||
(let ((last-dot-index (string-find (string-reverse path) #\.)))
|
||||
(cond ((not last-dot-index) path)
|
||||
(else (string-append (string-copy path 0
|
||||
(- (string-length path)
|
||||
last-dot-index
|
||||
1))
|
||||
new-suffix))))))
|
||||
|
||||
(define string-join
|
||||
(lambda (string-list between)
|
||||
(apply string-append
|
||||
(let ((index 0)
|
||||
(size (length string-list)))
|
||||
(map
|
||||
(lambda (item)
|
||||
(cond ((= index 0) item)
|
||||
((= index size) item)
|
||||
(else (string-append item between))))
|
||||
string-list)))))
|
||||
|
||||
(define search-library-file
|
||||
(lambda (directories path)
|
||||
(let ((result path))
|
||||
(for-each
|
||||
(lambda (directory)
|
||||
(let ((full-path (string-append directory "/" path)))
|
||||
(when (file-exists? full-path)
|
||||
(set! result full-path))))
|
||||
directories)
|
||||
result)))
|
||||
|
||||
(define (slurp path)
|
||||
(letrec* ((looper (lambda (result line)
|
||||
(if (eof-object? line)
|
||||
result
|
||||
(looper (append result (list line)) (read-line))))))
|
||||
(with-input-from-file
|
||||
path
|
||||
(lambda ()
|
||||
(apply string-append
|
||||
(map (lambda (line)
|
||||
(string-append line (string #\newline)))
|
||||
(looper (list) (read-line))))))))
|
||||
|
||||
(define (file->list path)
|
||||
(letrec* ((looper (lambda (result line)
|
||||
(if (eof-object? line)
|
||||
result
|
||||
(looper (append result (list line)) (read-line))))))
|
||||
(with-input-from-file
|
||||
path
|
||||
(lambda ()
|
||||
(looper (list) (read-line))))))
|
||||
|
||||
(define (trim text)
|
||||
(cond ((not (string? text)) "")
|
||||
((string=? text "") "")
|
||||
(else
|
||||
(letrec* ((looper (lambda (text)
|
||||
(if (or (null? text)
|
||||
(not (char-whitespace? (car text))))
|
||||
(list->string text)
|
||||
(looper (cdr text))))))
|
||||
(looper (string->list text))))))
|
||||
|
||||
(define (trim-end text)
|
||||
(string-reverse (trim (string-reverse text))))
|
||||
|
||||
(define (trim-both text)
|
||||
(let ((trimmed (trim text)))
|
||||
(string-reverse (trim (string-reverse trimmed)))))
|
||||
+15
-126
@@ -3,141 +3,30 @@
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme file)
|
||||
(scheme char)
|
||||
(scheme process-context)
|
||||
(foreign c))
|
||||
(export string-replace
|
||||
(export echo
|
||||
cat
|
||||
r6rs-schemes
|
||||
r7rs-schemes
|
||||
all-schemes
|
||||
string-replace
|
||||
string-ends-with?
|
||||
string-starts-with?
|
||||
string-cut-from-end
|
||||
string-find
|
||||
string-reverse
|
||||
string-split
|
||||
path->filename
|
||||
change-file-suffix
|
||||
string-join
|
||||
util-getenv
|
||||
dirname
|
||||
search-library-file)
|
||||
(begin
|
||||
|
||||
(define util-getenv
|
||||
(lambda (name)
|
||||
(if (get-environment-variable name)
|
||||
(get-environment-variable name)
|
||||
"")))
|
||||
|
||||
(define dirname
|
||||
(lambda (path)
|
||||
(letrec ((looper (lambda (dirpath)
|
||||
(cond ((= (string-length dirpath) 0) dirpath)
|
||||
((char=? (string-ref dirpath 0) #\/) (string-copy dirpath 1))
|
||||
(else (looper (string-copy dirpath 1)))))))
|
||||
(string-reverse (looper (string-reverse path))))))
|
||||
|
||||
(define string-replace
|
||||
(lambda (string-content replace with)
|
||||
(string-map (lambda (c)
|
||||
(if (char=? c replace)
|
||||
with c))
|
||||
string-content)))
|
||||
|
||||
(define string-replace-one
|
||||
(lambda (string-content replace with)
|
||||
(let ((replaced? #f))
|
||||
(string-map (lambda (c)
|
||||
(if (and (not replaced?)
|
||||
(char=? c replace))
|
||||
with c))
|
||||
string-content))))
|
||||
|
||||
(define string-replace-one-from-end
|
||||
(lambda (string-content replace with)
|
||||
(let ((replaced? #f))
|
||||
(list->string (reverse (map (lambda (c)
|
||||
(if (and (not replaced?)
|
||||
(char=? c replace))
|
||||
with c))
|
||||
(reverse (string->list string-content))))))))
|
||||
|
||||
(define string-ends-with?
|
||||
(lambda (string-content end)
|
||||
(if (and (>= (string-length string-content) (string-length end))
|
||||
(string=? (string-copy string-content
|
||||
(- (string-length string-content)
|
||||
(string-length end)))
|
||||
end))
|
||||
#t
|
||||
#f)))
|
||||
|
||||
(define string-starts-with?
|
||||
(lambda (string-content start)
|
||||
(if (and (>= (string-length string-content) (string-length start))
|
||||
(string=? (string-copy string-content
|
||||
0
|
||||
(string-length start))
|
||||
start))
|
||||
#t
|
||||
#f)))
|
||||
|
||||
(define string-cut-from-end
|
||||
(lambda (string-content cut-length)
|
||||
(string-copy string-content
|
||||
0
|
||||
(- (string-length string-content) cut-length))))
|
||||
|
||||
|
||||
(define string-find
|
||||
(lambda (string-content character)
|
||||
(letrec* ((string-list (string->list string-content))
|
||||
(looper (lambda (c rest index)
|
||||
(cond ((null? rest) #f)
|
||||
((char=? c character) index)
|
||||
(else (looper (car rest)
|
||||
(cdr rest)
|
||||
(+ index 1)))))))
|
||||
(looper (car string-list)
|
||||
(cdr string-list)
|
||||
0))))
|
||||
|
||||
(define string-reverse
|
||||
(lambda (string-content)
|
||||
(list->string (reverse (string->list string-content)))))
|
||||
|
||||
(define path->filename
|
||||
(lambda (path)
|
||||
(let ((last-slash-index (string-find (string-reverse path) #\/)))
|
||||
(cond ((not last-slash-index) path)
|
||||
(else (string-copy path (- (string-length path)
|
||||
last-slash-index)))))))
|
||||
|
||||
(define change-file-suffix
|
||||
(lambda (path new-suffix)
|
||||
(let ((last-dot-index (string-find (string-reverse path) #\.)))
|
||||
(cond ((not last-dot-index) path)
|
||||
(else (string-append (string-copy path 0
|
||||
(- (string-length path)
|
||||
last-dot-index
|
||||
1))
|
||||
new-suffix))))))
|
||||
|
||||
(define string-join
|
||||
(lambda (string-list between)
|
||||
(apply string-append
|
||||
(let ((index 0)
|
||||
(size (length string-list)))
|
||||
(map
|
||||
(lambda (item)
|
||||
(cond ((= index 0) item)
|
||||
((= index size) item)
|
||||
(else (string-append item between))))
|
||||
string-list)))))
|
||||
|
||||
(define search-library-file
|
||||
(lambda (directories path)
|
||||
(let ((result path))
|
||||
(for-each
|
||||
(lambda (directory)
|
||||
(let ((full-path (string-append directory "/" path)))
|
||||
(when (file-exists? full-path)
|
||||
(set! result full-path))))
|
||||
directories)
|
||||
result)))))
|
||||
search-library-file
|
||||
slurp
|
||||
file->list
|
||||
trim
|
||||
trim-end
|
||||
trim-both)
|
||||
(include "util.scm"))
|
||||
|
||||
Reference in New Issue
Block a user