Compare commits
No commits in common. "main" and "chicken-6" have entirely different histories.
|
@ -2,7 +2,6 @@
|
|||
*.swo
|
||||
*.link
|
||||
compile-r7rs
|
||||
test-r7rs
|
||||
test
|
||||
*.c
|
||||
*.o
|
||||
|
|
24
Dockerfile
24
Dockerfile
|
@ -1,16 +1,12 @@
|
|||
FROM debian:trixie-slim
|
||||
RUN apt-get update && apt-get install -y gcc make git libffi-dev docker.io
|
||||
WORKDIR /cache
|
||||
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1
|
||||
WORKDIR /cache/chibi-scheme
|
||||
RUN make
|
||||
RUN make install
|
||||
WORKDIR /cache
|
||||
RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
|
||||
RUN snow-chibi install --always-yes "(foreign c)"
|
||||
RUN snow-chibi install --always-yes "(srfi 170)"
|
||||
FROM schemers/chibi:head
|
||||
RUN apt-get update && apt-get install -y \
|
||||
build-essential ca-certificates git make libffi-dev
|
||||
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1 \
|
||||
&& cd chibi-scheme && make -j 16 && make -j 16 install
|
||||
WORKDIR /builddir
|
||||
COPY Makefile .
|
||||
COPY compile-r7rs.scm .
|
||||
COPY libs libs
|
||||
RUN make build-chibi
|
||||
RUN make install
|
||||
COPY libs/ libs/
|
||||
RUN make && make install
|
||||
WORKDIR /workdir
|
||||
RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
|
||||
|
|
|
@ -1,4 +1,12 @@
|
|||
FROM schemers/chibi:head
|
||||
RUN apt-get update && apt-get install -y make libffi-dev build-essential docker.io
|
||||
RUN snow-chibi install --always-yes "(foreign c)"
|
||||
RUN snow-chibi install --always-yes "(srfi 170)"
|
||||
RUN apt-get update && apt-get install -y \
|
||||
build-essential ca-certificates git make docker.io libffi-dev
|
||||
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1 \
|
||||
&& cd chibi-scheme && make -j 16 && make -j 16 install
|
||||
WORKDIR /builddir
|
||||
COPY Makefile .
|
||||
COPY compile-r7rs.scm .
|
||||
COPY libs/ libs/
|
||||
RUN make && make install
|
||||
WORKDIR /workdir
|
||||
RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
|
||||
|
|
|
@ -1,23 +1,14 @@
|
|||
ARG SCHEME=chibi
|
||||
ARG IMAGE=chibi:head
|
||||
FROM debian:bookworm AS cache
|
||||
RUN apt-get update && apt-get install -y gcc make git
|
||||
WORKDIR /cache
|
||||
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1
|
||||
WORKDIR /cache/chibi-scheme
|
||||
RUN make
|
||||
|
||||
FROM schemers/${SCHEME}:head
|
||||
RUN apt-get update && apt-get install -y \
|
||||
build-essential \
|
||||
make \
|
||||
libffi-dev \
|
||||
ca-certificates \
|
||||
git
|
||||
ENV PATH=${PATH}:/usr/local-other/bin
|
||||
ARG SCHEME=chibi
|
||||
ARG IMAGE=chibi:head
|
||||
FROM schemers/${IMAGE}
|
||||
RUN apt-get update && apt-get install -y make gcc libffi-dev unzip
|
||||
COPY --from=cache /cache /cache
|
||||
WORKDIR /cache/chibi-scheme
|
||||
RUN make install
|
||||
WORKDIR /
|
||||
RUN snow-chibi install --always-yes "(foreign c)"
|
||||
RUN snow-chibi install --always-yes "(srfi 170)"
|
||||
COPY Makefile .
|
||||
COPY libs libs/
|
||||
COPY compile-r7rs.scm .
|
||||
RUN make build-chibi && make install
|
||||
ENV COMPILE_R7RS=${SCHEME}
|
||||
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1 \
|
||||
&& cd chibi-scheme && make -j 16 && make -j 16 install
|
||||
RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
|
||||
|
|
|
@ -1,54 +1,50 @@
|
|||
pipeline {
|
||||
|
||||
agent {
|
||||
dockerfile {
|
||||
label 'docker-x86_64'
|
||||
filename 'Dockerfile.jenkins'
|
||||
args '--user=root --privileged -v /var/run/docker.sock:/var/run/docker.sock'
|
||||
args '--user=root -v /var/run/docker.sock:/var/run/docker.sock'
|
||||
}
|
||||
}
|
||||
|
||||
options {
|
||||
disableConcurrentBuilds()
|
||||
buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
|
||||
buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
|
||||
}
|
||||
|
||||
stages {
|
||||
stage('Build and install') {
|
||||
steps {
|
||||
sh "make build-chibi"
|
||||
sh "make install"
|
||||
}
|
||||
}
|
||||
|
||||
stage('Test R6RS') {
|
||||
stage('Test R6RS implementations') {
|
||||
steps {
|
||||
script {
|
||||
def SCHEMES = "chezscheme guile ikarus ironscheme larceny loko mosh racket sagittarius ypsilon"
|
||||
SCHEMES.split().each { SCHEME ->
|
||||
stage("${SCHEME} R6RS") {
|
||||
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
|
||||
sh "make SCHEME=${SCHEME} test-r6rs-docker"
|
||||
def r6rs_implementations = sh(script: 'chibi-scheme -I ./snow -I . compile-r7rs.scm --list-r6rs-schemes', returnStdout: true).split()
|
||||
parallel r6rs_implementations.collectEntries { implementation->
|
||||
[(implementation): {
|
||||
stage("${implementation} R6RS") {
|
||||
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
|
||||
sh "make test-r6rs-docker SCHEME=${implementation}"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
stage('Test R7RS') {
|
||||
stage('Test R7RS implementations') {
|
||||
steps {
|
||||
script {
|
||||
def SCHEMES = "chibi chicken cyclone gambit foment gauche guile kawa larceny loko meevax mit-scheme mosh racket sagittarius skint stklos tr7 ypsilon"
|
||||
SCHEMES.split().each { SCHEME ->
|
||||
stage("${SCHEME} R7RS") {
|
||||
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
|
||||
sh "make SCHEME=${SCHEME} test-r7rs-docker"
|
||||
def r7rs_implementations = sh(script: 'chibi-scheme -I ./snow -I . compile-r7rs.scm --list-r7rs-schemes', returnStdout: true).split()
|
||||
parallel r7rs_implementations.collectEntries { implementation->
|
||||
[(implementation): {
|
||||
stage("${implementation} R7RS") {
|
||||
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
|
||||
sh "make test-r7rs-docker SCHEME=${implementation}"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
|
107
Makefile
107
Makefile
|
@ -2,72 +2,27 @@ PREFIX=/usr/local
|
|||
SCHEME=chibi
|
||||
R6RSTMP=tmp/${SCHEME}-r6rs
|
||||
R7RSTMP=tmp/${SCHEME}-r7rs
|
||||
DOCKERIMG=${SCHEME}:head
|
||||
ifeq "${SCHEME}" "chicken"
|
||||
DOCKERIMG="chicken:5"
|
||||
endif
|
||||
STATIC_LIBS=libs.util.a libs.library-util.a libs.data.a libs.srfi-64-util.a
|
||||
|
||||
all: build-chibi
|
||||
all: build
|
||||
|
||||
build-chibi:
|
||||
container:
|
||||
docker build -f Dockerfile.test --tag=compile-r7rs
|
||||
|
||||
build: deps
|
||||
echo "#!/bin/sh" > compile-r7rs
|
||||
echo "chibi-scheme -A ${PREFIX}/lib/compile-r7rs ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm \"\$$@\"" >> compile-r7rs
|
||||
chmod +x compile-r7rs
|
||||
echo "chibi-scheme -A ${PREFIX}/lib/compile-r7rs ${PREFIX}/lib/compile-r7rs/main.scm \"\$$@\"" >> compile-r7rs
|
||||
|
||||
build-chicken:
|
||||
csc -R r7rs -X r7rs -static -c -J -unit libs.util -o libs.util.o libs/util.sld
|
||||
ar rcs libs.util.a libs.util.o
|
||||
csc -R r7rs -X r7rs -static -c -J -unit libs.library-util -o libs.library-util.o libs/library-util.sld
|
||||
ar rcs libs.library-util.a libs.library-util.o
|
||||
csc -R r7rs -X r7rs -static -c -J -unit libs.data -o libs.data.o libs/data.sld
|
||||
ar rcs libs.data.a libs.data.o
|
||||
csc -R r7rs -X r7rs -static \
|
||||
-o compile-r7rs \
|
||||
-uses libs.util \
|
||||
-uses libs.library-util \
|
||||
-uses libs.data \
|
||||
-uses foreign.c \
|
||||
-uses srfi-170 \
|
||||
compile-r7rs.scm
|
||||
|
||||
# FIXME
|
||||
#build-gauche:
|
||||
#echo "#!/bin/sh" > compile-r7rs
|
||||
#echo "gosh -r -I ${PREFIX}/lib/compile-r7rs -I ${PREFIX}/lib/compile-r7rs/libs ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm \"\$$@\"" >> compile-r7rs
|
||||
#chmod +x compile-r7rs
|
||||
|
||||
build-guile:
|
||||
echo "#!/bin/sh" > compile-r7rs
|
||||
echo "guile --r7rs --auto-compile -I -q -L ${PREFIX}/lib/compile-r7rs ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm \"\$$@\" 2> /dev/null" >> compile-r7rs
|
||||
chmod +x compile-r7rs
|
||||
|
||||
# FIXME
|
||||
#build-kawa:
|
||||
#echo "#!/bin/sh" > compile-r7rs
|
||||
#echo "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=/usr/local/share/kawa/lib/*.sld:${PREFIX}/lib/compile-r7rs/*.sld --r7rs ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm \"\$$@\" 2> /dev/null" >> compile-r7rs
|
||||
#chmod +x compile-r7rs
|
||||
|
||||
# FIXME
|
||||
#build-racket:
|
||||
#echo "#!/bin/sh" > compile-r7rs
|
||||
#echo "racket -I r7rs -S ${PREFIX}/lib/compile-r7rs --script ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm \"\$$@\"" >> compile-r7rs
|
||||
|
||||
build-sagittarius:
|
||||
echo "#!/bin/sh" > compile-r7rs
|
||||
echo "sash -A ${PREFIX}/lib/compile-r7rs ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm \"\$$@\"" >> compile-r7rs
|
||||
chmod +x compile-r7rs
|
||||
|
||||
build-stklos:
|
||||
echo "#!/bin/sh" > compile-r7rs
|
||||
echo "stklos -I ${PREFIX}/lib/compile-r7rs ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm \"\$$@\"" >> compile-r7rs
|
||||
chmod +x compile-r7rs
|
||||
deps:
|
||||
mkdir -p deps
|
||||
git clone https://git.sr.ht/~retropikzel/foreign-c deps/foreign-c --depth=1
|
||||
git clone https://git.sr.ht/~retropikzel/foreign-c-srfi-170 deps/foreign-c-srfi-170 --depth=1
|
||||
|
||||
install:
|
||||
mkdir -p ${PREFIX}/bin
|
||||
cd deps/foreign-c && make all install
|
||||
cd deps/foreign-c-srfi-170 && make all install
|
||||
mkdir -p ${PREFIX}/lib/compile-r7rs
|
||||
cp -r libs ${PREFIX}/lib/compile-r7rs/
|
||||
cp compile-r7rs.scm ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm
|
||||
cp compile-r7rs.scm ${PREFIX}/lib/compile-r7rs/main.scm
|
||||
install compile-r7rs ${PREFIX}/bin/compile-r7rs
|
||||
|
||||
uninstall:
|
||||
|
@ -77,30 +32,41 @@ uninstall:
|
|||
test-r6rs:
|
||||
rm -rf ${R6RSTMP}
|
||||
mkdir -p ${R6RSTMP}
|
||||
cp -r r6rs-testfiles/* ${R6RSTMP}/
|
||||
mkdir -p ${R6RSTMP}/libs
|
||||
mkdir -p ${R6RSTMP}/libs/foo
|
||||
printf "#!r6rs\n(library (foo bar) (export baz) (import (rnrs)) (define baz (lambda () (display \"Test successfull\") (newline))))" > ${R6RSTMP}/libs/foo/bar.sls
|
||||
printf "#!r6rs\n(import (rnrs) (foo bar)) (baz)" > ${R6RSTMP}/main.sps
|
||||
cd ${R6RSTMP} && COMPILE_R7RS=${SCHEME} compile-r7rs -I ./libs -o main main.sps
|
||||
cd ${R6RSTMP} && ./main 1 2 3 > test-result.txt
|
||||
@grep "Test successfull (\"1\" \"2\" \"3\")" ${R6RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R6RSTMP}/test-result.txt && exit 1)
|
||||
-cd ${R6RSTMP} && timeout 60 ./main > compile-r7rs-test-result.txt 2>&1
|
||||
@grep "Test successfull" ${R6RSTMP}/compile-r7rs-test-result.txt || (echo "Test failed, output: " && cat ${R6RSTMP}/compile-r7rs-test-result.txt && exit 1)
|
||||
|
||||
test-r6rs-docker:
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c "make SCHEME=${SCHEME} test-r6rs"
|
||||
docker build -f Dockerfile.test --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c "make && make install && make SCHEME=${SCHEME} test-r6rs"
|
||||
|
||||
test-r7rs:
|
||||
rm -rf ${R7RSTMP}
|
||||
mkdir -p ${R7RSTMP}
|
||||
cp -r r7rs-testfiles/* ${R7RSTMP}/
|
||||
mkdir -p ${R7RSTMP}/libs
|
||||
mkdir -p ${R7RSTMP}/libs/foo
|
||||
mkdir -p ${R7RSTMP}/libs/hello
|
||||
echo "(import (scheme base) (foo bar) (hello world) (srfi 9001)) (baz) (hello-word) (over-9000)" > ${R7RSTMP}/main.scm
|
||||
echo "(define baz (lambda () (display \"Test successfull\") (newline)))" > ${R7RSTMP}/libs/foo/bar.scm
|
||||
echo "(define-library (foo bar) (import (scheme base) (scheme write) (hello world)) (export baz) (include \"bar.scm\"))" > ${R7RSTMP}/libs/foo/bar.sld
|
||||
echo "(define hello-world (lambda () (+ 1 1)))" > ${R7RSTMP}/libs/hello/world.scm
|
||||
echo "(define-library (hello world) (import (scheme base) (scheme write)) (export hello-world) (include \"world.scm\"))" > ${R7RSTMP}/libs/hello/world.sld
|
||||
mkdir -p ${R7RSTMP}/libs/srfi
|
||||
echo "(define over-9000 (lambda () (+ 1 1)))" > ${R7RSTMP}/libs/srfi/9001.scm
|
||||
echo "(define-library (srfi 9001) (import (scheme base) (scheme write)) (export over-9000) (include \"9001.scm\"))" > ${R7RSTMP}/libs/srfi/9001.sld
|
||||
cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} compile-r7rs -I ./libs -o main main.scm
|
||||
-cd ${R7RSTMP} && ./main 1 2 3 > test-result.txt 2>&1
|
||||
@grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
|
||||
-cd ${R7RSTMP} && timeout 60 ./main > compile-r7rs-test-result.txt 2>&1
|
||||
@grep "Test successfull" ${R7RSTMP}/compile-r7rs-test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/compile-r7rs-test-result.txt && exit 1)
|
||||
|
||||
test-r7rs-docker:
|
||||
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c "make SCHEME=${SCHEME} test-r7rs"
|
||||
docker build -f Dockerfile.test --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c "make && make install && make SCHEME=${SCHEME} test-r7rs"
|
||||
|
||||
clean:
|
||||
rm -rf test-r7rs
|
||||
rm -rf compile-r7rs
|
||||
find . -name "*.so" -delete
|
||||
find . -name "*.o*" -delete
|
||||
find . -name "*.a*" -delete
|
||||
|
@ -108,7 +74,6 @@ clean:
|
|||
find . -name "*.link" -delete
|
||||
find . -name "*.meta" -delete
|
||||
find . -name "*.import.*" -delete
|
||||
rm -rf libs.library-util.c
|
||||
rm -rf dist
|
||||
rm -rf deps
|
||||
|
||||
|
|
384
README.md
384
README.md
|
@ -5,71 +5,41 @@ Despite it's name it also supports R6RS. Schemers, unite! <3
|
|||
|
||||
[Jenkins](https://jenkins.scheme.org/job/retropikzel/job/compile-r7rs/)
|
||||
|
||||
- [Notes](#notes)
|
||||
- [Supported implementations](#supported-implementations)
|
||||
- [Roadmap](#roadmap)
|
||||
- [Dependencies](#dependencies)
|
||||
- [Linux](#dependencies-linux)
|
||||
- [Windows](#dependencies-windows)
|
||||
- [Installation](#installation)
|
||||
- [Linux](#installation-linux)
|
||||
- [Windows](#installation-windows)
|
||||
- [Usage](#usage)
|
||||
- [Chicken](#usage-chicken)
|
||||
- [Mosh](#usage-mosh)
|
||||
- [mit-scheme](#usage-mit-scheme)
|
||||
- [Compiling a single library](#usage-compiling-single-library)
|
||||
- [Environment variables](#usage-environment-variables)
|
||||
- [Usage with docker](#usage-with-docker)
|
||||
- [Usual RnRS project](#usual-rnrs-project)
|
||||
- [File structure](#usual-rnrs-project-file-structure)
|
||||
- [Installation of your project](#usual-rnrs-project-installation-of-your-project)
|
||||
- [How it works](#how-it-works)
|
||||
- [Gambit](#how-it-works-gambit)
|
||||
- [Racket](#how-it-works-racket)
|
||||
- [Development](#development)
|
||||
- [Adding new implementations](#development-adding-new-implementations)
|
||||
- [Misc notes](#development-misc-notes)
|
||||
|
||||
## Notes
|
||||
<a name="#notes"></a>
|
||||
|
||||
- No support for -D flag yet.
|
||||
- Not all implementations support adding to beginning or end o load path so
|
||||
-I and -A might work the same
|
||||
|
||||
## Build and install
|
||||
|
||||
You can run compile-r7rs on Chibi, Chicken, Gauche, Guile, Kawa, Sagittarius or
|
||||
STklos.
|
||||
|
||||
snow-chibi --impls=SCHEME "(foreign c)"
|
||||
snow-chibi --impls=SCHEME "(srfi 170)"
|
||||
make build-SCHEME
|
||||
make install
|
||||
|
||||
## Usage
|
||||
|
||||
You need to install each Scheme implementation yourself.
|
||||
|
||||
The environment variable COMPILE\_R7RS must be set to the **name** of the
|
||||
implementation as specified in the support list.
|
||||
**This differs from the SRFI** as the SRFI excepts a path.
|
||||
|
||||
To get the list of supported R6RS implementations run:
|
||||
|
||||
compile-r7rs --list-r6rs-schemes
|
||||
|
||||
To get the list of supported R7RS implementations run:
|
||||
|
||||
compile-r7rs --list-r7rs-schemes
|
||||
|
||||
To get the list of all supported implementations run:
|
||||
|
||||
compile-r7rs --list-schemes
|
||||
|
||||
Then run it with the .scm file for r7rs, or .sps file for r6rs.
|
||||
|
||||
COMPILE_R7RS=<implementation name> compile-r7rs -I . -o main main.scm
|
||||
|
||||
Which produces file called main, which you can run. Note that when given Scheme
|
||||
is interpreter the file contains commands that run the script, and even when
|
||||
the file is combiled binary it might need the compiled libraries.
|
||||
|
||||
No other file suffixes are supported at the moment.
|
||||
|
||||
Setting value of COMPILE\_R7RS to implementation name that supports only r7rs
|
||||
and input file to .sps file and other way around is undefined behaviour.
|
||||
|
||||
### Environment variables
|
||||
|
||||
- COMPILE\_R7RS
|
||||
- **Name** of the implementation you want to compile with
|
||||
- **This differs from the SRFI** as it excepts a path
|
||||
- COMPILE\_R7RS\_SCHEME_NAME
|
||||
- Additional string to insert right after the command and it's arguments
|
||||
can be used for example to pass C compiler flags on implementations that
|
||||
compile to C or anything or otherwise as backdoor
|
||||
- For example for Chicken to link with libcurl you would set
|
||||
COMPILE\_R7RS\_CHICKEN="-L -lcurl"
|
||||
- If implementation has - it is changed to \_, for example mit-scheme ->
|
||||
MIT\_SCHEME
|
||||
- **This differs from the SRFI** as it's not in there
|
||||
|
||||
## Supported implementations
|
||||
<a name="#supported-implementations"></a>
|
||||
|
||||
Some implementations support both compiling and interpreting, in that
|
||||
case only the compiler functionality is used and the implementation is marked
|
||||
|
@ -87,6 +57,9 @@ as compiler.
|
|||
- cyclone
|
||||
- compiler
|
||||
- R7RS
|
||||
- gambit
|
||||
- compiler
|
||||
- R7RS
|
||||
- foment
|
||||
- interpreter
|
||||
- R7RS
|
||||
|
@ -117,8 +90,6 @@ as compiler.
|
|||
- compiler
|
||||
- R6RS
|
||||
- R7RS
|
||||
- meevax
|
||||
- r7rs
|
||||
- mit-scheme
|
||||
- interpreter
|
||||
- R7RS
|
||||
|
@ -150,13 +121,18 @@ as compiler.
|
|||
- R7RS
|
||||
|
||||
## Roadmap
|
||||
<a name="#roadmap"></a>
|
||||
|
||||
- Support for more implementations
|
||||
- gambit
|
||||
- husk
|
||||
- Dont know how to add directories to load path yet, might not be
|
||||
implemented
|
||||
- r7rs
|
||||
- meevax
|
||||
- Asked how to add directory to load path
|
||||
https://github.com/yamacir-kit/meevax/issues/494, might not be
|
||||
implemented yet
|
||||
- r7rs
|
||||
- picrin
|
||||
- Might not be possible, seems to not have (include...) that works like
|
||||
others
|
||||
|
@ -188,4 +164,290 @@ as compiler.
|
|||
- Since for example for interpreters the program produces .bat file with
|
||||
command to run the interpreter "cross compiling" is easy.
|
||||
|
||||
## Dependencies
|
||||
<a name="#dependencies"></a>
|
||||
|
||||
### Linux
|
||||
<a name="#dependencies-linux"></a>
|
||||
|
||||
#### Chicken Scheme and R7RS library
|
||||
|
||||
On Debian/Ubuntu/Mint:
|
||||
|
||||
apt-get install -y chicken-bin
|
||||
chicken-install r7rs
|
||||
|
||||
### Windows
|
||||
<a name="#dependencies-windows"></a>
|
||||
|
||||
### Sagittarius Scheme
|
||||
Download the installer from
|
||||
[https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/](https://bitbucket.org/ktakashi/sagittarius-scheme/downloads/)
|
||||
and install it into **default location**.
|
||||
|
||||
### libuv
|
||||
|
||||
Libuv is distributed with compile-r7rs on Windows.
|
||||
|
||||
## Installation
|
||||
<a name="#Installation"></a>
|
||||
|
||||
You will need Chibi scheme and snow-chibi installed.
|
||||
|
||||
First install linux dependencies:
|
||||
|
||||
apt-get install build-essential make libffi-dev
|
||||
|
||||
And then run:
|
||||
|
||||
make
|
||||
make install
|
||||
|
||||
## Usage
|
||||
<a name="#usage"></a>
|
||||
|
||||
You need to install each Scheme implementation yourself.
|
||||
|
||||
The environment variable COMPILE\_R7RS must be set to the **name** of the
|
||||
implementation as specified in the support list.
|
||||
**This differs from the SRFI** as the SRFI excepts a path.
|
||||
|
||||
To get the list of supported R6RS implementations run:
|
||||
|
||||
compile-r7rs --list-r6rs-schemes
|
||||
|
||||
To get the list of supported R7RS implementations run:
|
||||
|
||||
compile-r7rs --list-r7rs-schemes
|
||||
|
||||
To get the list of all supported implementations run:
|
||||
|
||||
compile-r7rs --list-schemes
|
||||
|
||||
Then run it with the .scm file for r7rs, or .sps file for r6rs.
|
||||
|
||||
COMPILE_R7RS=<implementation name> compile-r7rs -I . -o main main.scm
|
||||
|
||||
Which produces file called main, which you can run. Note that when given Scheme
|
||||
is interpreter the file contains commands that run the script, and even when
|
||||
the file is combiled binary it might need the compiled libraries.
|
||||
|
||||
No other file suffixes are supported at the moment.
|
||||
|
||||
Setting value of COMPILE\_R7RS to implementation name that supports only r7rs
|
||||
and input file to .sps file and other way around is undefined behaviour.
|
||||
|
||||
### Chicken
|
||||
<a name="#usage-chicken"></a>
|
||||
|
||||
By default Chicken 6 is assumed, for Chicken 5 use environment variable to
|
||||
add R7RS libraries:
|
||||
|
||||
COMPILE_R7RS_CHIKEN="-X r7r -R r7rs"
|
||||
|
||||
### mit-scheme
|
||||
<a name="#usage-mit-scheme"></a>
|
||||
|
||||
Only allows one loadpath. Workaround in compile-r7rs is that each library is
|
||||
loaded individually, like so:
|
||||
|
||||
mit-scheme --load foo/bar.sld --load foo/baz.sld ... main.scm
|
||||
|
||||
This does not require actions from the user and is done automatically.
|
||||
|
||||
### Compiling a single library
|
||||
<a name="#usage-compiling-a-single-library"></a>
|
||||
|
||||
Sometimes implementations need the libraries compiled in certain order,
|
||||
specially the compilers. Since doing analysing from the files about which
|
||||
library depends on which library I've decided to outsource it to you. :)
|
||||
|
||||
To compile single library run the same command (including all the arguments
|
||||
other than -o)
|
||||
you would run for executable, except change the input file to the library.
|
||||
|
||||
Example of compiling main program:
|
||||
|
||||
COMPILE_R7RS=<implementation name> compile-r7rs -I . -o main main.scm
|
||||
|
||||
And if the main program needed library called foo/bar.sld, and the compile-r7rs
|
||||
tried to compile them in wrong order you would run:
|
||||
|
||||
COMPILE_R7RS=<implementation name> compile-r7rs -I . foo/bar.sld
|
||||
|
||||
### Environment variables
|
||||
<a name="#usage-environment-variables"></a>
|
||||
|
||||
- COMPILE\_R7RS
|
||||
- **Name** of the implementation you want to compile with
|
||||
- **This differs from the SRFI** as it excepts a path
|
||||
- COMPILE\_R7RS\_SCHEME_NAME
|
||||
- Additional string to insert right after the command and it's arguments
|
||||
can be used for example to pass C compiler flags on implementations that
|
||||
compile to C or anything or otherwise as backdoor
|
||||
- For example for Chicken to link with libcurl you would set
|
||||
COMPILE\_R7RS\_CHICKEN="-L -lcurl"
|
||||
- If implementation has - it is changed to \_, for example mit-scheme ->
|
||||
MIT\_SCHEME
|
||||
- **This differs from the SRFI** as it's not in there
|
||||
|
||||
## Usage with Docker
|
||||
<a name="#usage-with-docker"></a>
|
||||
|
||||
Here is a sample Dockerfile to get you started.
|
||||
|
||||
ARG COMPILE_R7RS=chibi
|
||||
FROM schemers/${COMPILE_R7RS}
|
||||
RUN apt-get update && apt-get install -y make git chicken-bin
|
||||
RUN chicken-install r7rs
|
||||
ARG COMPILE_R7RS=chibi
|
||||
ENV COMPILE_R7RS=${COMPILE_R7RS}
|
||||
RUN git clone https://git.sr.ht/~retropikzel/compile-r7rs && cd compile-r7rs && make && make install
|
||||
|
||||
To use this run:
|
||||
|
||||
export COMPILE_R7RS=<your scheme>
|
||||
docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=compile-r7rs-${COMPILE_R7RS} .
|
||||
docker run -v "${PWD}":/workdir -w /workdir -t compile-r7rs-${COMPILE_R7RS} sh -c "compile-r7rs -I -o main ./snow main.scm"
|
||||
|
||||
## Usual RnRS projects
|
||||
<a name="#usual-rnrs-projects"></a>
|
||||
|
||||
The reports do not say much, if anything, about the file structure of your
|
||||
project. However in practice certain patterns will repeat a lot. Here we use
|
||||
R7RS .sld and .scm files as example but for R6RS .sld = .sld and .scm = .sps.
|
||||
|
||||
### File structure
|
||||
<a name="#usual-rnrs-projects-file-structure"></a>
|
||||
|
||||
The implementations most often expect library named (foo bar) to be in file
|
||||
foo/bar.sld. Some implementations add the current directory to the load path
|
||||
implicitly, some do not. If you store your libraries directly in your projects
|
||||
root it's propably best to always pass . as load path to compile-r7rs.
|
||||
|
||||
For example if your projects file structure is:
|
||||
|
||||
foo/bar.sld
|
||||
main.scm
|
||||
|
||||
The command to compile and run this project is:
|
||||
|
||||
compile-r7rs -I . -o myproject main.scm
|
||||
./myproject
|
||||
|
||||
If your project has more than one library then you propably want to store the
|
||||
libraries in one directory. For example:
|
||||
|
||||
snow/foo/bar.sld
|
||||
main.scm
|
||||
|
||||
This is the case the compile-r7rs is tested against, main.scm imports (foo bar).
|
||||
The command to compile and run this project is:
|
||||
|
||||
compile-r7rs -I ./snow -o myproject main.scm
|
||||
./myproject
|
||||
|
||||
### Installation of your project
|
||||
<a name="#usual-rnrs-projects-installation-of-your-project"></a>
|
||||
|
||||
compile-r7rs (that is, this project) does not install your project files
|
||||
anywhere, that is left for you to do. I will update this section as I use this
|
||||
project more but here are some ideas. Basically each implementation might need
|
||||
it's own specific way and is outside of scope of this project.
|
||||
|
||||
#### Interpreters
|
||||
|
||||
The interpreters, that is for example Sagittarius, Gauche, Chibi and STklos,
|
||||
produce an executable that contains the command to run the main .scm file
|
||||
and add given paths to the implementations load paths. So if you run this:
|
||||
|
||||
compile-r7rs -I ./snow -o main main.scm
|
||||
|
||||
the resulting main file will only work in this directory, as the load path is
|
||||
relative. For system wide installation the paths would need to be more like this:
|
||||
|
||||
compile-r7rs -I /usr/local/lib/myproject/snow -o myproject main.scm
|
||||
|
||||
and then in makefile you would have:
|
||||
|
||||
install:
|
||||
mkdir -p /usr/local/lib/myproject
|
||||
cp -r snow /usr/local/lib/myproject/
|
||||
install myproject /usr/local/bin/
|
||||
|
||||
#### Compilers
|
||||
|
||||
Compilers, that is for example Chicken, Gambit, Cyclone either produce static
|
||||
executable or shared libraries. Cyclone produces static executable so
|
||||
if you run this:
|
||||
|
||||
compile-r7rs -I /usr/local/lib/myproject/snow -o myproject main.scm
|
||||
|
||||
and then in makefile you would have:
|
||||
|
||||
install:
|
||||
install myproject /usr/local/bin/
|
||||
|
||||
Chicken compiles shared object files and is different from that, like I said I
|
||||
hope to update this section when I get more experience with installing stuff
|
||||
compiled by using this project. :)
|
||||
|
||||
## How it works
|
||||
<a name="#how-it-works"></a>
|
||||
|
||||
### Gambit
|
||||
<a name="#how-it-works-gambit"></a>
|
||||
|
||||
To add library path into executables load path you need to compile Gambit
|
||||
script, not code. The script needs to be shebang and then the code:
|
||||
|
||||
#!/usr/bin/env gsi -:search=./snow
|
||||
(import (scheme base)
|
||||
(scheme write))
|
||||
(display "Hello world")
|
||||
(newline)
|
||||
|
||||
So in order to do this compile-r7rs creates a main.tmp file that contains the
|
||||
shebang line, library directories you want and then your input files code.
|
||||
|
||||
### Racket
|
||||
<a name="#how-it-works-racket"></a>
|
||||
|
||||
#### r7rs
|
||||
|
||||
Racket only supports .rkt files, so the transformer creates .rkt file for each
|
||||
.sld file and the given .scm file. This file only needs to contain:
|
||||
|
||||
#!lang r7rs
|
||||
(import (scheme base))
|
||||
(include "file.scm/.sld")
|
||||
|
||||
## Development
|
||||
<a name="#development"></a>
|
||||
|
||||
The program relies on two projects,
|
||||
[r7rs-pffi](https://sr.ht/~retropikzel/r7rs-pffi/) and
|
||||
[pffi-srfi-170](https://git.sr.ht/~retropikzel/pffi-srfi-170). They both are
|
||||
stil work in progress so best way to help this project is to help on those
|
||||
projects. That said bug fixes for this projects are also welcome. Pull requests
|
||||
that add more SRFI-138 support are also welcome, but lets keep the scope on
|
||||
that.
|
||||
|
||||
The program itself is a quite straighforward transformer of SRFI-138 inputs to
|
||||
implementation specific inputs. It stands on the shoulders of giants and relies
|
||||
on the implementations to have all the needed features, then unifies the
|
||||
interface to use them.
|
||||
|
||||
### Adding new implementations
|
||||
<a name="#development-adding-new-implementations"></a>
|
||||
|
||||
The main program reads the flags and other inputs and passes them to a
|
||||
transformer functions. So to add support for new implementations you need
|
||||
to add the transformer functions and other data for it in libs/data.scm. You
|
||||
should be able to deduct how they work from other transformers. If you need to
|
||||
make utility functions add them into libs/util.scm and export them in
|
||||
libs/util.sld.
|
||||
|
||||
If the transformer has to go trough hoops, that is is little or much unusual
|
||||
then it is a good idea to explain how it works in this readmes how it works
|
||||
section.
|
||||
|
|
152
compile-r7rs.scm
152
compile-r7rs.scm
|
@ -9,29 +9,67 @@
|
|||
(libs library-util)
|
||||
(srfi 170))
|
||||
|
||||
(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
|
||||
mit-scheme
|
||||
mosh
|
||||
racket
|
||||
sagittarius
|
||||
skint
|
||||
stklos
|
||||
tr7
|
||||
ypsilon))
|
||||
|
||||
(define all-schemes (append r6rs-schemes r7rs-schemes))
|
||||
|
||||
(when (member "--list-r6rs-schemes" (command-line))
|
||||
(for-each (lambda (scheme) (display scheme) (display " ")) r6rs-schemes)
|
||||
(newline)
|
||||
(for-each
|
||||
(lambda (scheme)
|
||||
(display scheme)
|
||||
(newline))
|
||||
r6rs-schemes)
|
||||
(exit 0))
|
||||
|
||||
(when (member "--list-r7rs-schemes" (command-line))
|
||||
(for-each (lambda (scheme) (display scheme) (display " ")) r7rs-schemes)
|
||||
(newline)
|
||||
(for-each
|
||||
(lambda (scheme)
|
||||
(display scheme)
|
||||
(newline))
|
||||
r7rs-schemes)
|
||||
(exit 0))
|
||||
|
||||
(when (member "--list-schemes" (command-line))
|
||||
(for-each (lambda (scheme) (display scheme) (display " ")) all-schemes)
|
||||
(newline)
|
||||
(for-each
|
||||
(lambda (scheme)
|
||||
(display scheme)
|
||||
(newline))
|
||||
all-schemes)
|
||||
(exit 0))
|
||||
|
||||
(define scheme (if (get-environment-variable "COMPILE_R7RS")
|
||||
(string->symbol (get-environment-variable "COMPILE_R7RS"))
|
||||
#f))
|
||||
(when (not scheme)
|
||||
(display "Environment variable COMPILE_R7RS not set." (current-error-port))
|
||||
(newline (current-error-port))
|
||||
(exit 1))
|
||||
(when (not (assoc scheme data)) (error "Unsupported implementation" scheme))
|
||||
(when (not scheme) (error "Environment variable COMPILE_R7RS not set."))
|
||||
(when (not (assoc scheme data))
|
||||
(error "Unsupported implementation" scheme))
|
||||
(define compilation-target (if (get-environment-variable "TARGET")
|
||||
(get-environment-variable "TARGET")
|
||||
(cond-expand (windows "windows")
|
||||
|
@ -151,13 +189,14 @@
|
|||
(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
|
||||
r6rs?)))
|
||||
(string-append (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
|
||||
r6rs?))
|
||||
(string #\newline)))
|
||||
|
||||
(define scheme-library-command
|
||||
(lambda (library-file)
|
||||
|
@ -198,18 +237,16 @@
|
|||
(display "Compiling library ")
|
||||
(display file)
|
||||
(newline)
|
||||
(for-each
|
||||
(lambda (command)
|
||||
(display "Running ")
|
||||
(write command)
|
||||
(newline)
|
||||
(display "Exit code ")
|
||||
(let ((exit-code (c-system (string->c-utf8 command))))
|
||||
(display exit-code)
|
||||
(newline)
|
||||
(when (not (= exit-code 0))
|
||||
(exit exit-code))))
|
||||
library-command)))
|
||||
(display "With command ")
|
||||
(display library-command)
|
||||
(newline)
|
||||
(display "Exit code ")
|
||||
(let ((output (c-system (string->c-utf8 library-command))))
|
||||
(when (not (= output 0))
|
||||
(error "Problem compiling libraries, exiting" output))
|
||||
(display output))
|
||||
(newline)
|
||||
(newline)))
|
||||
library-files))
|
||||
(else
|
||||
(display "Implementation has no library build command, skipping library compilation.")
|
||||
|
@ -219,33 +256,27 @@
|
|||
(when (and (equal? scheme-type 'interpreter) input-file)
|
||||
(when (and output-file (file-exists? output-file))
|
||||
(delete-file output-file))
|
||||
(let ((shebang-line (string-append
|
||||
(cond ((string=? compilation-target "unix")
|
||||
"#!/usr/bin/env -S ")
|
||||
((string=? compilation-target "windows")
|
||||
(string-append
|
||||
"@echo off"
|
||||
(string #\newline)
|
||||
"start")))
|
||||
scheme-command))
|
||||
(scheme-program (slurp input-file)))
|
||||
(display "Creating startup script ")
|
||||
(display output-file)
|
||||
(newline)
|
||||
(display "Starting with ")
|
||||
(display shebang-line)
|
||||
(display "Containing command ")
|
||||
(display scheme-command)
|
||||
(newline)
|
||||
(with-output-to-file
|
||||
(if (string=? compilation-target "windows")
|
||||
(string-append output-file ".bat")
|
||||
output-file)
|
||||
(lambda ()
|
||||
(display shebang-line)
|
||||
(newline)
|
||||
(display scheme-program)
|
||||
(newline)))
|
||||
(cond ((string=? compilation-target "unix")
|
||||
(c-system (string->c-utf8 (string-append "chmod +x " output-file)))))))
|
||||
(if (string=? compilation-target "windows")
|
||||
(string-append output-file ".bat")
|
||||
output-file)
|
||||
(lambda ()
|
||||
(cond ((string=? compilation-target "unix")
|
||||
(display "#!/bin/sh")
|
||||
(newline))
|
||||
((string=? compilation-target "windows")
|
||||
(display "@echo off")
|
||||
(newline)
|
||||
(display "start")))
|
||||
(display scheme-command)))
|
||||
(cond ((string=? compilation-target "unix")
|
||||
(c-system (string->c-utf8 (string-append "chmod +x " output-file))))))
|
||||
|
||||
(when (and (equal? scheme-type 'compiler) input-file)
|
||||
(when (and output-file (file-exists? output-file))
|
||||
|
@ -253,17 +284,10 @@
|
|||
(display "Compiling file ")
|
||||
(display input-file)
|
||||
(newline)
|
||||
(for-each
|
||||
(lambda (command)
|
||||
(display "Running ")
|
||||
(write command)
|
||||
(newline)
|
||||
(display "Exit code ")
|
||||
(let ((exit-code (c-system (string->c-utf8 command))))
|
||||
(display exit-code)
|
||||
(newline)
|
||||
(when (not (= exit-code 0))
|
||||
(exit exit-code))))
|
||||
scheme-command)
|
||||
(display "With command ")
|
||||
(display scheme-command)
|
||||
(newline)
|
||||
(display "Exit code ")
|
||||
(display (c-system (string->c-utf8 scheme-command)))
|
||||
(newline))
|
||||
|
||||
|
|
Binary file not shown.
968
libs/data.sld
968
libs/data.sld
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,122 @@
|
|||
(define filter-out-scheme-dependencies
|
||||
(lambda (dependencies)
|
||||
(let ((result (list)))
|
||||
(for-each
|
||||
(lambda (dependency)
|
||||
(when (not (equal? (car dependency) 'scheme))
|
||||
(set! result (append result (list dependency)))))
|
||||
dependencies)
|
||||
result)))
|
||||
|
||||
(define flatten-dependencies
|
||||
(lambda (result dependencies)
|
||||
(if (null? dependencies)
|
||||
result
|
||||
(flatten-dependencies (append result
|
||||
(list
|
||||
(if (or (equal? (car (car dependencies)) 'only)
|
||||
(equal? (car (car dependencies)) 'except)
|
||||
(equal? (car (car dependencies)) 'prefix)
|
||||
(equal? (car (car dependencies)) 'rename))
|
||||
(car (cdr (car dependencies)))
|
||||
(car dependencies))))
|
||||
(cdr dependencies)))))
|
||||
|
||||
(define library-name->path
|
||||
(lambda (name)
|
||||
(string-append
|
||||
(string-cut-from-end
|
||||
(apply string-append
|
||||
(map (lambda (item)
|
||||
(string-append
|
||||
(if (symbol? item)
|
||||
(symbol->string item)
|
||||
(number->string item))
|
||||
"/"))
|
||||
name))
|
||||
1)
|
||||
".sld")))
|
||||
|
||||
(define get-imports
|
||||
(lambda (result implementation rest)
|
||||
(cond ((null? rest) result)
|
||||
((equal? (car rest) 'import) (cdr rest))
|
||||
((member 'cond-expand (car rest))
|
||||
(if (assoc implementation (cdr (car rest)))
|
||||
(get-imports result
|
||||
implementation
|
||||
(cdr (assoc implementation
|
||||
(cdr (car rest)))))
|
||||
(get-imports result
|
||||
implementation
|
||||
(cdr (assoc 'else
|
||||
(cdr (car rest)))))))
|
||||
((member 'import (car rest))
|
||||
(get-imports (append result (list) (cdr (car rest)))
|
||||
implementation
|
||||
(cdr rest)))
|
||||
(else (get-imports result implementation (cdr rest))))))
|
||||
|
||||
(define remove-nonexistent
|
||||
(lambda (directories paths)
|
||||
(apply append
|
||||
(map
|
||||
(lambda (path)
|
||||
(if (file-exists? (search-library-file directories path))
|
||||
(list path)
|
||||
(list)))
|
||||
paths))))
|
||||
|
||||
;; To get dependencies from R7RS and R6RS libraries we need to read trough all
|
||||
;; the nonportable stuff first and then when encountering first ( not in
|
||||
;; comments, read from that
|
||||
(define read-until-library
|
||||
(lambda (path)
|
||||
(letrec
|
||||
((looper (lambda (c)
|
||||
(cond ((char=? c #\()
|
||||
(read))
|
||||
((char=? c #\;)
|
||||
(read-line)
|
||||
(looper (peek-char)))
|
||||
(else
|
||||
(read-char)
|
||||
(looper (peek-char)))))))
|
||||
(with-input-from-file
|
||||
path
|
||||
(lambda ()
|
||||
(looper (peek-char)))))))
|
||||
|
||||
(define library-dependencies
|
||||
(lambda (implementation directories path previous-indent indent)
|
||||
(for-each (lambda (item) (display " ")) indent)
|
||||
(display path)
|
||||
(let ((full-path (search-library-file directories path)))
|
||||
(if (not (file-exists? full-path))
|
||||
(begin
|
||||
(display #\space)
|
||||
(display "not found, ignoring")
|
||||
(newline)
|
||||
(list))
|
||||
(begin
|
||||
(newline)
|
||||
(letrec* ((raw-data (read-until-library full-path))
|
||||
(data (if (equal? (car raw-data) 'define-library)
|
||||
(cdr raw-data)
|
||||
raw-data))
|
||||
(imports (flatten-dependencies (list)
|
||||
(get-imports (list)
|
||||
implementation
|
||||
data)))
|
||||
(filtered-imports (filter-out-scheme-dependencies imports))
|
||||
(paths (map library-name->path filtered-imports))
|
||||
(flat-tree (apply append
|
||||
(map (lambda (dependency-path)
|
||||
(append (list dependency-path)
|
||||
(reverse (library-dependencies implementation
|
||||
directories
|
||||
dependency-path
|
||||
indent
|
||||
(append indent (list #\space #\space))))))
|
||||
paths))))
|
||||
(remove-nonexistent directories (reverse flat-tree))))))))
|
|
@ -6,127 +6,5 @@
|
|||
(scheme file)
|
||||
(libs util))
|
||||
(export library-dependencies)
|
||||
(begin
|
||||
(define filter-out-scheme-dependencies
|
||||
(lambda (dependencies)
|
||||
(let ((result (list)))
|
||||
(for-each
|
||||
(lambda (dependency)
|
||||
(when (not (equal? (car dependency) 'scheme))
|
||||
(set! result (append result (list dependency)))))
|
||||
dependencies)
|
||||
result)))
|
||||
|
||||
(define flatten-dependencies
|
||||
(lambda (result dependencies)
|
||||
(if (null? dependencies)
|
||||
result
|
||||
(flatten-dependencies (append result
|
||||
(list
|
||||
(if (or (equal? (car (car dependencies)) 'only)
|
||||
(equal? (car (car dependencies)) 'except)
|
||||
(equal? (car (car dependencies)) 'prefix)
|
||||
(equal? (car (car dependencies)) 'rename))
|
||||
(car (cdr (car dependencies)))
|
||||
(car dependencies))))
|
||||
(cdr dependencies)))))
|
||||
|
||||
(define library-name->path
|
||||
(lambda (name)
|
||||
(string-append
|
||||
(string-cut-from-end
|
||||
(apply string-append
|
||||
(map (lambda (item)
|
||||
(string-append
|
||||
(if (symbol? item)
|
||||
(symbol->string item)
|
||||
(number->string item))
|
||||
"/"))
|
||||
name))
|
||||
1)
|
||||
".sld")))
|
||||
|
||||
(define get-imports
|
||||
(lambda (result implementation rest)
|
||||
(cond ((null? rest) result)
|
||||
((equal? (car rest) 'import) (cdr rest))
|
||||
((member 'cond-expand (car rest))
|
||||
(if (assoc implementation (cdr (car rest)))
|
||||
(get-imports result
|
||||
implementation
|
||||
(cdr (assoc implementation
|
||||
(cdr (car rest)))))
|
||||
(get-imports result
|
||||
implementation
|
||||
(cdr (assoc 'else
|
||||
(cdr (car rest)))))))
|
||||
((member 'import (car rest))
|
||||
(get-imports (append result (list) (cdr (car rest)))
|
||||
implementation
|
||||
(cdr rest)))
|
||||
(else (get-imports result implementation (cdr rest))))))
|
||||
|
||||
(define remove-nonexistent
|
||||
(lambda (directories paths)
|
||||
(apply append
|
||||
(map
|
||||
(lambda (path)
|
||||
(if (file-exists? (search-library-file directories path))
|
||||
(list path)
|
||||
(list)))
|
||||
paths))))
|
||||
|
||||
;; To get dependencies from R7RS and R6RS libraries we need to read trough all
|
||||
;; the nonportable stuff first and then when encountering first ( not in
|
||||
;; comments, read from that
|
||||
(define read-until-library
|
||||
(lambda (path)
|
||||
(letrec
|
||||
((looper (lambda (c)
|
||||
(cond ((char=? c #\()
|
||||
(read))
|
||||
((char=? c #\;)
|
||||
(read-line)
|
||||
(looper (peek-char)))
|
||||
(else
|
||||
(read-char)
|
||||
(looper (peek-char)))))))
|
||||
(with-input-from-file
|
||||
path
|
||||
(lambda ()
|
||||
(looper (peek-char)))))))
|
||||
|
||||
(define library-dependencies
|
||||
(lambda (implementation directories path previous-indent indent)
|
||||
(for-each (lambda (item) (display " ")) indent)
|
||||
(display path)
|
||||
(let ((full-path (search-library-file directories path)))
|
||||
(if (not (file-exists? full-path))
|
||||
(begin
|
||||
(display #\space)
|
||||
(display "not found, ignoring")
|
||||
(newline)
|
||||
(list))
|
||||
(begin
|
||||
(newline)
|
||||
(letrec* ((raw-data (read-until-library full-path))
|
||||
(data (if (equal? (car raw-data) 'define-library)
|
||||
(cdr raw-data)
|
||||
raw-data))
|
||||
(imports (flatten-dependencies (list)
|
||||
(get-imports (list)
|
||||
implementation
|
||||
data)))
|
||||
(filtered-imports (filter-out-scheme-dependencies imports))
|
||||
(paths (map library-name->path filtered-imports))
|
||||
(flat-tree (apply append
|
||||
(map (lambda (dependency-path)
|
||||
(append (list dependency-path)
|
||||
(reverse (library-dependencies implementation
|
||||
directories
|
||||
dependency-path
|
||||
indent
|
||||
(append indent (list #\space #\space))))))
|
||||
paths))))
|
||||
(remove-nonexistent directories (reverse flat-tree))))))))))
|
||||
(include "library-util.scm"))
|
||||
|
||||
|
|
108
libs/util.sld
108
libs/util.sld
|
@ -3,68 +3,21 @@
|
|||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme file)
|
||||
(scheme char)
|
||||
(scheme process-context)
|
||||
(foreign c))
|
||||
(export echo
|
||||
cat
|
||||
r6rs-schemes
|
||||
r7rs-schemes
|
||||
all-schemes
|
||||
string-replace
|
||||
(export 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
|
||||
slurp
|
||||
file->list
|
||||
trim
|
||||
trim-end
|
||||
trim-both)
|
||||
search-library-file)
|
||||
(begin
|
||||
(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)
|
||||
|
@ -149,20 +102,6 @@
|
|||
(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) #\/)))
|
||||
|
@ -201,45 +140,4 @@
|
|||
(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)))))))
|
||||
result)))))
|
||||
|
|
|
@ -1,2 +0,0 @@
|
|||
#!r6rs
|
||||
(library (foo bar) (export baz) (import (rnrs)) (define baz (lambda () (display "Test successfull "))))
|
|
@ -1,6 +0,0 @@
|
|||
#!r6rs
|
||||
(import (rnrs)
|
||||
(rnrs programs)
|
||||
(foo bar))
|
||||
(baz)
|
||||
(write (list-tail (command-line) 1))
|
|
@ -1 +0,0 @@
|
|||
(define baz (lambda () (display "Test successfull ")))
|
|
@ -1 +0,0 @@
|
|||
(define-library (foo bar) (import (scheme base) (scheme write) (hello world)) (export baz) (include "bar.scm"))
|
|
@ -1 +0,0 @@
|
|||
(define hello-world (lambda () (+ 1 1)))
|
|
@ -1 +0,0 @@
|
|||
(define-library (hello world) (import (scheme base) (scheme write)) (export hello-world) (include "world.scm"))
|
|
@ -1 +0,0 @@
|
|||
(define over-9000 (lambda () (+ 1 1)))
|
|
@ -1 +0,0 @@
|
|||
(define-library (other hellolib) (import (scheme base) (scheme write)) (export over-9000) (include "hellolib.scm"))
|
|
@ -1,23 +0,0 @@
|
|||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme process-context)
|
||||
(foo bar)
|
||||
(hello world)
|
||||
(other hellolib))
|
||||
(baz)
|
||||
(hello-world)
|
||||
|
||||
(define l (list "1" "2" "3"))
|
||||
(cond-expand
|
||||
;; Meevax gives too much args
|
||||
;; For this test for now this is okay
|
||||
(meevax (when (> (length (command-line)) 3) (write l)))
|
||||
;; mit-scheme gives too much args
|
||||
;; For this test for now this is okay
|
||||
(mit (when (> (length (command-line)) 3) (write l)))
|
||||
;; tr7 gives too much args
|
||||
;; For this test for now this is okay
|
||||
(tr7 (when (> (length (command-line)) 3) (write l)))
|
||||
(else (write (list-tail (command-line) 1))))
|
||||
|
||||
(over-9000)
|
Loading…
Reference in New Issue