Adding support for more implementations
This commit is contained in:
parent
955f5a7373
commit
b0d6757be7
|
|
@ -5,7 +5,9 @@ test/foo
|
|||
test/libs/bar/baz
|
||||
*.c
|
||||
*.o
|
||||
*.o*
|
||||
*.so
|
||||
!chicken
|
||||
!src
|
||||
*.rkt
|
||||
|
||||
|
|
|
|||
4
Makefile
4
Makefile
|
|
@ -53,7 +53,9 @@ clean:
|
|||
rm -rf test/foo
|
||||
rm -rf test/libs/bar/baz
|
||||
find . -name "*.so" -delete
|
||||
find . -name "*.o" -delete
|
||||
find . -name "*.o*" -delete
|
||||
find . -name "*.rkt" -delete
|
||||
find ./test -name "*.c" -delete
|
||||
find . -name "*.link" -delete
|
||||
find . -name "*.meta" -delete
|
||||
find . -name "*.import.*" -delete
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ with [SRFI-138](https://srfi.schemers.org/srfi-138/srfi-138.html).
|
|||
- gauche
|
||||
- guile
|
||||
- kawa
|
||||
- loko
|
||||
- mosh
|
||||
- sagittarius
|
||||
- skint
|
||||
|
|
|
|||
|
|
@ -1,3 +0,0 @@
|
|||
#lang r7rs
|
||||
(import (scheme base))
|
||||
(include "compile-r7rs.scm")
|
||||
|
|
@ -70,20 +70,6 @@
|
|||
|
||||
(pffi-define c-system c-libstd 'system 'int '(pointer))
|
||||
|
||||
(define scheme-type (cdr (assoc 'type (cdr (assoc scheme data)))))
|
||||
|
||||
(define scheme-command
|
||||
(apply (cdr (assoc 'command (cdr (assoc scheme data))))
|
||||
(list (if input-file input-file "")
|
||||
(if output-file output-file "")
|
||||
prepend-directories
|
||||
append-directories)))
|
||||
|
||||
(define scheme-library-command
|
||||
(lambda (library-file)
|
||||
(apply (cdr (assoc 'library-command (cdr (assoc scheme data))))
|
||||
(list library-file prepend-directories append-directories))))
|
||||
|
||||
(define search-library-files
|
||||
(lambda (directory)
|
||||
(let ((result (list)))
|
||||
|
|
@ -98,6 +84,29 @@
|
|||
(directory-files directory))
|
||||
result)))
|
||||
|
||||
(define library-files
|
||||
(apply append
|
||||
(map
|
||||
(lambda (directory)
|
||||
(search-library-files directory))
|
||||
(append prepend-directories append-directories))))
|
||||
|
||||
(define scheme-type (cdr (assoc 'type (cdr (assoc scheme data)))))
|
||||
|
||||
(define scheme-command
|
||||
(apply (cdr (assoc 'command (cdr (assoc scheme data))))
|
||||
(list (if input-file input-file "")
|
||||
(if output-file output-file "")
|
||||
prepend-directories
|
||||
append-directories
|
||||
library-files)))
|
||||
|
||||
(define scheme-library-command
|
||||
(lambda (library-file)
|
||||
(apply (cdr (assoc 'library-command (cdr (assoc scheme data))))
|
||||
(list library-file prepend-directories append-directories))))
|
||||
|
||||
|
||||
(define list-of-features
|
||||
(letrec ((looper (lambda (rest result)
|
||||
(if (null? rest)
|
||||
|
|
@ -109,19 +118,19 @@
|
|||
result))))))
|
||||
(looper (command-line) (list))))
|
||||
|
||||
(display "Scheme ")
|
||||
(display "Scheme ")
|
||||
(display scheme)
|
||||
(newline)
|
||||
(display "Type ")
|
||||
(display "Type ")
|
||||
(display scheme-type)
|
||||
(newline)
|
||||
(display "Command ")
|
||||
(display "Command ")
|
||||
(display scheme-command)
|
||||
(newline)
|
||||
(display "Input file ")
|
||||
(display "Input file ")
|
||||
(display input-file)
|
||||
(newline)
|
||||
(display "Output file ")
|
||||
(display "Output file ")
|
||||
(display output-file)
|
||||
(newline)
|
||||
|
||||
|
|
@ -145,10 +154,10 @@
|
|||
|
||||
(when (and (equal? scheme-type 'compiler) input-file)
|
||||
(when (file-exists? output-file) (delete-file output-file))
|
||||
(display "Compiling file ")
|
||||
(display "Compiling file ")
|
||||
(display input-file)
|
||||
(newline)
|
||||
(display "With command ")
|
||||
(display "With command ")
|
||||
(display scheme-command)
|
||||
(newline)
|
||||
(c-system (pffi-string->pointer scheme-command)))
|
||||
|
|
@ -157,9 +166,7 @@
|
|||
(cond ((and (not input-file) (assoc 'library-command (cdr (assoc scheme data))))
|
||||
(when (and output-file (file-exists? output-file))
|
||||
(delete-file output-file))
|
||||
(for-each
|
||||
(lambda (directory)
|
||||
(for-each
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(let* ((command (scheme-library-command file)))
|
||||
(display "Compiling library ")
|
||||
|
|
@ -169,8 +176,7 @@
|
|||
(display command)
|
||||
(newline)
|
||||
(c-system (pffi-string->pointer command))))
|
||||
(search-library-files directory)))
|
||||
(append prepend-directories append-directories)))
|
||||
library-files))
|
||||
((not input-file)
|
||||
(display "Library compilation requested but no library command found. ")
|
||||
(display "Skipping...")
|
||||
|
|
|
|||
262
src/data.scm
262
src/data.scm
|
|
@ -1,7 +1,7 @@
|
|||
(define data
|
||||
`((chibi
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("chibi-scheme"
|
||||
" "
|
||||
|
|
@ -19,11 +19,54 @@
|
|||
(string-append "csc -J "
|
||||
" "
|
||||
library-file)))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories)
|
||||
(string-append "csc " input-file))))
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(string-append "csc -static " input-file))))
|
||||
(gambit
|
||||
(type . compiler)
|
||||
(library-command . ,(lambda (library-file prepend-directories append-directories)
|
||||
(apply string-append
|
||||
`("gsc -c"
|
||||
" "
|
||||
"-o"
|
||||
" "
|
||||
,(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)
|
||||
(apply string-append
|
||||
`("gsc -nopreload -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)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("cyclone "
|
||||
" "
|
||||
|
|
@ -37,7 +80,7 @@
|
|||
,input-file)))))
|
||||
(gauche
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("gosh -r7"
|
||||
" "
|
||||
|
|
@ -49,9 +92,24 @@
|
|||
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)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("guile --r7rs"
|
||||
" "
|
||||
|
|
@ -65,7 +123,7 @@
|
|||
,input-file)))))
|
||||
(kawa
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("kawa --r7rs --full-tailcalls"
|
||||
" "
|
||||
|
|
@ -80,7 +138,7 @@
|
|||
,input-file)))))
|
||||
(mosh
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("mosh"
|
||||
" "
|
||||
|
|
@ -92,74 +150,120 @@
|
|||
append-directories)
|
||||
" "
|
||||
,input-file)))))
|
||||
(sagittarius
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories)
|
||||
(apply string-append
|
||||
`("sash -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)
|
||||
(apply string-append
|
||||
`("skint"
|
||||
" "
|
||||
,@(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)
|
||||
(apply string-append
|
||||
`("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)
|
||||
(apply string-append
|
||||
`("TR7_LIB_PATH="
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
append-directories)
|
||||
" "
|
||||
"tr7i"
|
||||
" "
|
||||
,input-file)))))
|
||||
(ypsilon
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories)
|
||||
(apply string-append
|
||||
`("ypsilon --r7rs"
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "--sitelib=" item))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "--sitelib=" item))
|
||||
append-directories)
|
||||
" "
|
||||
,input-file)))))))
|
||||
(racket
|
||||
(type . compiler)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(let ((rkt-input-file (if (string=? input-file "")
|
||||
""
|
||||
(change-file-suffix input-file ".rkt"))))
|
||||
(when (not (string=? rkt-input-file ""))
|
||||
(if (file-exists? rkt-input-file)
|
||||
(delete-file rkt-input-file))
|
||||
(with-output-to-file
|
||||
rkt-input-file
|
||||
(lambda ()
|
||||
(display "#lang r7rs")
|
||||
(newline)
|
||||
(display "(import (scheme base))")
|
||||
(newline)
|
||||
(display "(include \"")
|
||||
(display (path->filename input-file))
|
||||
(display "\")")
|
||||
(newline))))
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(let ((library-rkt-file (change-file-suffix file ".rkt")))
|
||||
(if (file-exists? library-rkt-file)
|
||||
(delete-file library-rkt-file))
|
||||
(with-output-to-file
|
||||
library-rkt-file
|
||||
(lambda ()
|
||||
(display "#lang r7rs")
|
||||
(newline)
|
||||
(display "(import (scheme base))")
|
||||
(newline)
|
||||
(display "(include \"")
|
||||
(display (path->filename file))
|
||||
(display "\")")
|
||||
(newline)))))
|
||||
library-files)
|
||||
(apply string-append
|
||||
`("PLTCOLLECTS="
|
||||
,(string-join prepend-directories ":")
|
||||
,(string-join append-directories ":")
|
||||
" "
|
||||
"raco exe --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)
|
||||
(apply string-append
|
||||
`("sash -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)
|
||||
(apply string-append
|
||||
`("skint"
|
||||
" "
|
||||
,@(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)
|
||||
(apply string-append
|
||||
`("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)
|
||||
(apply string-append
|
||||
`("TR7_LIB_PATH="
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":"))
|
||||
append-directories)
|
||||
" "
|
||||
"tr7i"
|
||||
" "
|
||||
,input-file)))))
|
||||
(ypsilon
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("ypsilon --r7rs"
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "--sitelib=" item))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "--sitelib=" item))
|
||||
append-directories)
|
||||
" "
|
||||
,input-file)))))))
|
||||
|
|
|
|||
56
src/util.scm
56
src/util.scm
|
|
@ -11,3 +11,59 @@
|
|||
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-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)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue