Compare commits

..

No commits in common. "main" and "chicken-6" have entirely different histories.

23 changed files with 1140 additions and 984 deletions

1
.gitignore vendored
View File

@ -2,7 +2,6 @@
*.swo
*.link
compile-r7rs
test-r7rs
test
*.c
*.o

View File

@ -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

View File

@ -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

View File

@ -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

50
Jenkinsfile vendored
View File

@ -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
View File

@ -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
View File

@ -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.

View File

@ -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))

0
configure vendored Executable file → Normal file
View File

BIN
dist/setup-compile-r7rs.exe vendored Executable file

Binary file not shown.

File diff suppressed because it is too large Load Diff

122
libs/library-util.scm Normal file
View File

@ -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))))))))

View File

@ -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"))

View File

@ -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)))))

View File

@ -1,2 +0,0 @@
#!r6rs
(library (foo bar) (export baz) (import (rnrs)) (define baz (lambda () (display "Test successfull "))))

View File

@ -1,6 +0,0 @@
#!r6rs
(import (rnrs)
(rnrs programs)
(foo bar))
(baz)
(write (list-tail (command-line) 1))

View File

@ -1 +0,0 @@
(define baz (lambda () (display "Test successfull ")))

View File

@ -1 +0,0 @@
(define-library (foo bar) (import (scheme base) (scheme write) (hello world)) (export baz) (include "bar.scm"))

View File

@ -1 +0,0 @@
(define hello-world (lambda () (+ 1 1)))

View File

@ -1 +0,0 @@
(define-library (hello world) (import (scheme base) (scheme write)) (export hello-world) (include "world.scm"))

View File

@ -1 +0,0 @@
(define over-9000 (lambda () (+ 1 1)))

View File

@ -1 +0,0 @@
(define-library (other hellolib) (import (scheme base) (scheme write)) (export over-9000) (include "hellolib.scm"))

View File

@ -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)