Updated Makefile
This commit is contained in:
parent
b0d6757be7
commit
598ac64ba0
46
Makefile
46
Makefile
|
|
@ -1,30 +1,8 @@
|
|||
.PHONY: snow
|
||||
PREFIX=/usr/local
|
||||
CC=gcc
|
||||
CHICKEN_FLAGS=-optimize-level 3
|
||||
|
||||
build:
|
||||
${CC} -o compile-r7rs \
|
||||
-Os \
|
||||
-fomit-frame-pointer \
|
||||
-DHAVE_CHICKEN_CONFIG_H \
|
||||
src/*.c \
|
||||
chicken/src/*.c \
|
||||
-lm \
|
||||
-Ichicken/include
|
||||
|
||||
test-sagittarius:
|
||||
cd test && sash -r7 -L ${PWD}/snow ../compile-r7rs.scm -I ./libs
|
||||
cd test && sash -r7 -L ${PWD}/snow ../compile-r7rs.scm -I ./libs foo.scm
|
||||
chmod +x test/foo
|
||||
cd test && ./foo
|
||||
|
||||
test-guile:
|
||||
cd test && guile --r7rs -L ${PWD}/snow ../compile-r7rs.scm -I ./libs
|
||||
cd test && guile --r7rs -L ${PWD}/snow ../compile-r7rs.scm -I ./libs foo.scm
|
||||
chmod +x test/foo
|
||||
cd test && ./foo
|
||||
|
||||
printf "#!/bin/sh\nash -r7 -L ${PREFIX}/lib/compile-r7rs/snow ${PREFIX}/lib/compile-r7rs/main.scm \"\$$@\"\n" > compile-r7rs
|
||||
|
||||
snow:
|
||||
rm -rf snow
|
||||
|
|
@ -32,23 +10,17 @@ snow:
|
|||
cp -r ../r7rs-pffi/retropikzel snow/
|
||||
cp -r ../pffi-srfi-170/srfi snow/
|
||||
|
||||
c-files: src
|
||||
csc -t snow/retropikzel/pffi.sld -J ${CHICKEN_FLAGS} -output-file src/retropikzel.pffi.c
|
||||
csc -t snow/srfi/170.sld -J ${CHICKEN_FLAGS} -output-file src/srfi.170.c
|
||||
csc -t compile-r7rs.scm ${CHICKEN_FLAGS} -output-file src/compile-r7rs.c
|
||||
|
||||
test:
|
||||
cd test && ../compile-r7rs -I ./libs
|
||||
cd test && ../compile-r7rs -I ./libs foo.scm
|
||||
cd test && ./foo
|
||||
|
||||
src:
|
||||
mkdir -p src
|
||||
|
||||
install:
|
||||
mkdir -p ${PREFIX}/bin
|
||||
mkdir -p ${PREFIX}/lib/compile-r7rs/snow
|
||||
cp -r snow/* ${PREFIX}/lib/compile-r7rs/snow
|
||||
cp -r libs ${PREFIX}/lib/compile-r7rs/snow/libs
|
||||
cp compile-r7rs.scm ${PREFIX}/lib/compile-r7rs/main.scm
|
||||
install compile-r7rs ${PREFIX}/bin/compile-r7rs
|
||||
|
||||
uninstall:
|
||||
rm -rf ${PREFIX}/lib/compile-r7rs/snow
|
||||
rm -rf ${PREFIX}/bin/compile-r7rs
|
||||
|
||||
clean:
|
||||
rm -rf test/foo
|
||||
rm -rf test/libs/bar/baz
|
||||
|
|
|
|||
51
README.md
51
README.md
|
|
@ -18,20 +18,61 @@ with [SRFI-138](https://srfi.schemers.org/srfi-138/srfi-138.html).
|
|||
|
||||
## Dependencies
|
||||
|
||||
C toolchain and libuv, on Debian/Ubuntu/Mint run
|
||||
|
||||
apt install build-essential libuv1-dev
|
||||
|
||||
You need to install each Scheme implementation yourself.
|
||||
## Getting started
|
||||
|
||||
## Build and install
|
||||
### Install Sagittarius scheme
|
||||
|
||||
#### Linux
|
||||
|
||||
On Debian/Ubuntu/Mint:
|
||||
|
||||
apt-get install -y build-essential cmake libgc-dev zlib1g-dev libffi-dev libssl-dev
|
||||
wget https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/sagittarius-0.9.12.tar.gz
|
||||
tar -xf sagittarius-0.9.12.tar.gz
|
||||
cd sagittarius-0.9.12.tar.gz
|
||||
mkdir build
|
||||
cd build
|
||||
cmake ..
|
||||
make
|
||||
make install
|
||||
|
||||
#### Windows
|
||||
|
||||
Download the installer from
|
||||
[https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/](https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/)
|
||||
and install it.
|
||||
|
||||
### Install libuv
|
||||
|
||||
#### Linux
|
||||
|
||||
On Debian/Ubuntu/Mint run:
|
||||
|
||||
apt install libuv1
|
||||
|
||||
#### Windows
|
||||
|
||||
dll is included, no need to install anything.
|
||||
|
||||
### Build on Linux
|
||||
|
||||
./configure
|
||||
make
|
||||
install
|
||||
make install
|
||||
|
||||
### Build on Windows
|
||||
|
||||
In command prompt run:
|
||||
|
||||
build.bat
|
||||
install.bat
|
||||
|
||||
## Usage
|
||||
|
||||
You need to install each Scheme implementation yourself.
|
||||
|
||||
The environment variable SCHEME must be set to the name of the implementation
|
||||
as specified in the support list.
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
echo @echo off > compile-r7rs.bat
|
||||
echo sash.exe -r7 -L %PROGRAMFILES%/compile-r7rs/snow %PROGRAMFILES%compile-r7rs/main.scm %%^* >> compile-r7rs.bat
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
@echo off
|
||||
sash.exe -r7 -L C:\Program Files (x86)/compile-r7rs/snow C:\Program Files (x86)compile-r7rs/main.scm %*
|
||||
|
|
@ -4,10 +4,28 @@
|
|||
(scheme write)
|
||||
(scheme process-context)
|
||||
(retropikzel pffi)
|
||||
(libs util)
|
||||
(libs data)
|
||||
(srfi 170))
|
||||
|
||||
(include "src/util.scm")
|
||||
(include "src/data.scm")
|
||||
(when (member "--list-schemes" (command-line))
|
||||
(for-each
|
||||
(lambda (scheme)
|
||||
(display scheme)
|
||||
(newline))
|
||||
'(chibi
|
||||
cyclone
|
||||
gauche
|
||||
guile
|
||||
kawa
|
||||
loko
|
||||
mosh
|
||||
sagittarius
|
||||
skint
|
||||
stklos
|
||||
tr7
|
||||
ypsilon))
|
||||
(exit 0))
|
||||
|
||||
(define scheme (if (get-environment-variable "SCHEME")
|
||||
(string->symbol (get-environment-variable "SCHEME"))
|
||||
|
|
@ -88,7 +106,9 @@
|
|||
(apply append
|
||||
(map
|
||||
(lambda (directory)
|
||||
(search-library-files directory))
|
||||
(if (file-exists? directory)
|
||||
(search-library-files directory)
|
||||
(list)))
|
||||
(append prepend-directories append-directories))))
|
||||
|
||||
(define scheme-type (cdr (assoc 'type (cdr (assoc scheme data)))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,274 @@
|
|||
(define-library
|
||||
(libs data)
|
||||
(import (scheme base))
|
||||
(export data)
|
||||
(begin
|
||||
(define data
|
||||
`((chibi
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("chibi-scheme"
|
||||
" "
|
||||
,@(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)
|
||||
(string-append "csc -J "
|
||||
" "
|
||||
library-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 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)
|
||||
(apply string-append
|
||||
`("guile --r7rs"
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-L" " " item " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "-L" " " item " "))
|
||||
append-directories)
|
||||
" "
|
||||
,input-file)))))
|
||||
(kawa
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("kawa --r7rs --full-tailcalls"
|
||||
" "
|
||||
"-Dkawa.import.path="
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":" item "/*.sld:" " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":" item "/*.sld:" " "))
|
||||
append-directories)
|
||||
" "
|
||||
,input-file)))))
|
||||
(mosh
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("mosh"
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "--loadpath=" item " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "--loadpath=" 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)))))))))
|
||||
|
|
@ -0,0 +1,81 @@
|
|||
(define-library
|
||||
(libs util)
|
||||
(import (scheme base))
|
||||
(export string-replace
|
||||
string-ends-with?
|
||||
string-starts-with?
|
||||
string-find
|
||||
string-reverse
|
||||
path->filename
|
||||
change-file-suffix
|
||||
string-join)
|
||||
(begin
|
||||
(define string-replace
|
||||
(lambda (string-content replace with)
|
||||
(string-map (lambda (c) (char=? c replace) with c) 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-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)))))))
|
||||
Binary file not shown.
|
|
@ -59,7 +59,8 @@
|
|||
(scheme process-context)
|
||||
(rnrs bytevectors)
|
||||
(system foreign)
|
||||
(system foreign-library)))
|
||||
(system foreign-library)
|
||||
(only (guile) include-from-path)))
|
||||
(kawa
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
|
|
@ -133,8 +134,7 @@
|
|||
(scheme process-context)
|
||||
(ypsilon c-ffi)
|
||||
(ypsilon c-types)
|
||||
(only (core) define-macro syntax-case)))
|
||||
(else (error "Unsupported implementation")))
|
||||
(only (core) define-macro syntax-case))))
|
||||
(export pffi-init
|
||||
pffi-size-of
|
||||
pffi-type?
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@
|
|||
(native-type (sizeof native-type))
|
||||
(else #f)))))
|
||||
|
||||
(define pffi-pointer-allocate
|
||||
#;(define pffi-pointer-allocate
|
||||
(lambda (size)
|
||||
(bytevector->pointer (make-bytevector size 0))))
|
||||
|
||||
|
|
@ -74,10 +74,10 @@
|
|||
(pointer->string pointer)))
|
||||
|
||||
(define pffi-shared-object-load
|
||||
(lambda (header path . options)
|
||||
(lambda (path options)
|
||||
(load-foreign-library path)))
|
||||
|
||||
(define pffi-pointer-free
|
||||
#;(define pffi-pointer-free
|
||||
(lambda (pointer)
|
||||
#t))
|
||||
|
||||
|
|
@ -132,6 +132,6 @@
|
|||
((equal? type 'pointer) (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type))))
|
||||
((equal? type 'string) (pffi-pointer->string (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type)))))))))
|
||||
|
||||
(define pffi-struct-dereference
|
||||
#;(define pffi-struct-dereference
|
||||
(lambda (struct)
|
||||
(dereference-pointer (pffi-struct-pointer struct))))
|
||||
|
|
|
|||
269
src/data.scm
269
src/data.scm
|
|
@ -1,269 +0,0 @@
|
|||
(define data
|
||||
`((chibi
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("chibi-scheme"
|
||||
" "
|
||||
,@(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)
|
||||
(string-append "csc -J "
|
||||
" "
|
||||
library-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 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)
|
||||
(apply string-append
|
||||
`("guile --r7rs"
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "-L" " " item " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "-L" " " item " "))
|
||||
append-directories)
|
||||
" "
|
||||
,input-file)))))
|
||||
(kawa
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("kawa --r7rs --full-tailcalls"
|
||||
" "
|
||||
"-Dkawa.import.path="
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":" item "/*.sld:" " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append item ":" item "/*.sld:" " "))
|
||||
append-directories)
|
||||
" "
|
||||
,input-file)))))
|
||||
(mosh
|
||||
(type . interpreter)
|
||||
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files)
|
||||
(apply string-append
|
||||
`("mosh"
|
||||
" "
|
||||
,@(map (lambda (item)
|
||||
(string-append "--loadpath=" item " "))
|
||||
prepend-directories)
|
||||
,@(map (lambda (item)
|
||||
(string-append "--loadpath=" 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)))))))
|
||||
69
src/util.scm
69
src/util.scm
|
|
@ -1,69 +0,0 @@
|
|||
(define string-replace
|
||||
(lambda (strin-content replace with)
|
||||
(string-map (lambda (c) (char=? c replace) with c))))
|
||||
|
||||
(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-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