Compare commits

..

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

15 changed files with 906 additions and 1087 deletions

1
.gitignore vendored
View File

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

View File

@ -1,24 +1,12 @@
FROM debian:trixie-slim AS build
RUN apt-get update && apt-get install -y make gcc chicken-bin git
RUN chicken-install r7rs
WORKDIR /build
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1 chibi
WORKDIR /build/chibi
RUN make
RUN make install
WORKDIR /build
RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
RUN snow-chibi install --always-yes --impls=chicken "(foreign c)"
RUN snow-chibi install --always-yes --impls=chicken "(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 PREFIX=/opt/compile-r7rs build-chicken
RUN make PREFIX=/opt/compile-r7rs install
FROM debian:trixie-slim
COPY --from=build /opt/compile-r7rs /opt/compile-r7rs
ENV PATH=/opt/compile-r7rs/bin:${PATH}
COPY libs/ libs/
RUN make && make install
WORKDIR /workdir
RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm

View File

@ -1,24 +0,0 @@
FROM alpine AS build
RUN apk add make gcc chicken git
RUN chicken-install r7rs
WORKDIR /build
RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1 chibi
WORKDIR /build/chibi
RUN make
RUN make install
WORKDIR /build
RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
RUN snow-chibi install --always-yes --impls=chicken "(foreign c)"
RUN snow-chibi install --always-yes --impls=chicken "(srfi 170)"
COPY Makefile .
COPY compile-r7rs.scm .
COPY libs ./libs
RUN make PREFIX=/opt/compile-r7rs build-chicken
RUN make PREFIX=/opt/compile-r7rs install
FROM alpine
COPY --from=build /opt/compile-r7rs /opt/compile-r7rs
ENV PATH=/opt/compile-r7rs/bin:${PATH}

12
Dockerfile.jenkins Normal file
View File

@ -0,0 +1,12 @@
FROM schemers/chibi:head
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,21 +1,14 @@
ARG SCHEME=chibi
ARG IMAGE=chibi:head
FROM debian:trixie AS build
FROM schemers/${SCHEME}:head
RUN apt-get update && apt-get install -y \
--download-only \
--no-install-recommends \
--no-install-suggests \
build-essential \
make \
libffi-dev \
ca-certificates \
git \
cmark
git
ENV PATH=${PATH}:/usr/local-other/bin
ARG SCHEME=chibi
ENV COMPILE_R7RS=${SCHEME}
FROM schemers/${IMAGE}
COPY --from=build /var/cache/apt/archives /debs
RUN dpkg -i /debs/*.deb
COPY --from=local-build-compile-r7rs /opt/compile-r7rs /opt/compile-r7rs
ENV PATH=/opt/compile-r7rs/bin:${PATH}:/opt/compile-r7rs/snow-chibi/bin
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

105
Jenkinsfile vendored
View File

@ -1,46 +1,24 @@
pipeline {
agent {
label 'docker-x86_64'
dockerfile {
filename 'Dockerfile.jenkins'
args '--user=root -v /var/run/docker.sock:/var/run/docker.sock'
}
}
options {
disableConcurrentBuilds()
buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
timeout(time: 1, unit: 'HOURS')
buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
}
parameters {
booleanParam(name: 'DOCKER', defaultValue: false, description: 'Build and push docker image')
}
stages {
stage('Build') {
steps {
sh "docker build -f Dockerfile --tag=local-build-compile-r7rs ."
}
}
stage('Warm up cache') {
steps {
sh "docker build -f Dockerfile.test --build-arg IMAGE=chibi:head --build-arg SCHEME=chibi --tag=compile-r7rs-test-chibi ."
}
}
stage('Test R6RS implementations') {
steps {
script {
def r6rs_implementations = sh(script: 'docker run retropikzel1/compile-r7rs bash -c "compile-r7rs --list-r6rs-schemes"', returnStdout: true).split()
parallel r6rs_implementations.collectEntries { SCHEME ->
[(SCHEME): {
stage("${SCHEME} R6RS") {
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') {
def DOCKERIMG="${SCHEME}:head"
if("${SCHEME}" == "chicken") {
DOCKERIMG="chicken:5"
}
sh "docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} ."
sh "docker run -v ${WORKSPACE}:/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c \"make && make install && make SCHEME=${SCHEME} test-r6rs\""
sh "make test-r6rs-docker SCHEME=${implementation}"
}
}
}
@ -53,17 +31,12 @@ pipeline {
stage('Test R7RS implementations') {
steps {
script {
def r7rs_implementations = sh(script: 'docker run retropikzel1/compile-r7rs bash -c "compile-r7rs --list-r7rs-schemes"', returnStdout: true).split()
parallel r7rs_implementations.collectEntries { SCHEME ->
[(SCHEME): {
stage("${SCHEME} R7RS") {
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') {
def DOCKERIMG="${SCHEME}:head"
if("${SCHEME}" == "chicken") {
DOCKERIMG="chicken:5"
}
sh "docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} ."
sh "docker run -v ${WORKSPACE}:/workdir -w /workdir -t compile-r7rs-test-${SCHEME} sh -c \"make && make install && make SCHEME=${SCHEME} test-r7rs\""
sh "make test-r7rs-docker SCHEME=${implementation}"
}
}
}
@ -73,53 +46,5 @@ pipeline {
}
}
stage('Docker build/login/push x84-64') {
agent {
label 'linux-x86_64'
}
when {
allOf {
branch 'main'
expression {
return params.DOCKER
}
}
}
steps {
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
sh 'docker build . --tag=retropikzel1/compile-r7rs'
sh 'docker login -u ${DOCKER_HUB_USERNAME} -p ${DOCKER_HUB_TOKEN}'
sh 'docker push retropikzel1/compile-r7rs'
}
}
}
stage('Docker build/login/push arm') {
agent {
label 'linux-arm'
}
when {
allOf {
branch 'main'
expression {
return params.DOCKER
}
}
}
steps {
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
sh 'docker build . --tag=retropikzel1/compile-r7rs'
sh 'docker login -u ${DOCKER_HUB_USERNAME} -p ${DOCKER_HUB_TOKEN}'
sh 'docker push retropikzel1/compile-r7rs'
}
}
}
stage('Docker logout') {
steps {
sh 'docker logout'
}
}
}
}

View File

@ -2,76 +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
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
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
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
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
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
#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
build-stklos:
echo "#!/bin/sh" > compile-r7rs
echo "stklos -I ${PREFIX}/lib/compile-r7rs ${PREFIX}/lib/compile-r7rs/compile-r7rs.scm \"\$$@\"" >> compile-r7rs
docker-images: build-docker-image-debian build-docker-image-alpine
docker-image-debian:
docker build . -f Dockerfile --tag=retropikzel1/compile-r7rs:latest
docker-image-debian-push:
docker push retropikzel1/compile-r7rs:latest
docker-image-alpine:
docker build . -f Dockerfile.alpine --tag=retropikzel1/compile-r7rs:alpine-latest
docker-image-alpine-push:
docker push retropikzel1/compile-r7rs:alpine-latest
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:
@ -86,11 +37,11 @@ test-r6rs:
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 > compile-r7rs-test-result.txt 2>&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: build-local-docker
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
test-r6rs-docker:
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:
@ -99,25 +50,23 @@ test-r7rs:
mkdir -p ${R7RSTMP}/libs
mkdir -p ${R7RSTMP}/libs/foo
mkdir -p ${R7RSTMP}/libs/hello
echo "(import (scheme base) (foo bar) (hello world) (other hellolib)) (baz) (hello-world) (over-9000)" > ${R7RSTMP}/main.scm
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 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/other
echo "(define over-9000 (lambda () (+ 1 1)))" > ${R7RSTMP}/libs/other/hellolib.scm
echo "(define-library (other hellolib) (import (scheme base) (scheme write)) (export over-9000) (include \"hellolib.scm\"))" > ${R7RSTMP}/libs/other/hellolib.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 > compile-r7rs-test-result.txt 2>&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: build-local-docker
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
test-r7rs-docker:
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

113
README.md
View File

@ -9,8 +9,11 @@ Despite it's name it also supports R6RS. Schemers, unite! <3
- [Supported implementations](#supported-implementations)
- [Roadmap](#roadmap)
- [Dependencies](#dependencies)
- [Building](#building)
- [Linux](#dependencies-linux)
- [Windows](#dependencies-windows)
- [Installation](#installation)
- [Linux](#installation-linux)
- [Windows](#installation-windows)
- [Usage](#usage)
- [Chicken](#usage-chicken)
- [Mosh](#usage-mosh)
@ -87,8 +90,6 @@ as compiler.
- compiler
- R6RS
- R7RS
- meevax
- r7rs
- mit-scheme
- interpreter
- R7RS
@ -127,6 +128,11 @@ as compiler.
- 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
@ -161,27 +167,40 @@ as compiler.
## Dependencies
<a name="#dependencies"></a>
- (foreign c)
- (srfi 170)
### Linux
<a name="#dependencies-linux"></a>
To install:
#### Chicken Scheme and R7RS library
snow-chibi --impls=SCHEME "(foreign c)"
snow-chibi --impls=SCHEME "(srfi 170)"
On Debian/Ubuntu/Mint:
## Building
<a name="#building"></a>
apt-get install -y chicken-bin
chicken-install r7rs
The Makefile has build jobs for Schemes that compile-r7rs can be run with. The
default is chibi. Run:
### Windows
<a name="#dependencies-windows"></a>
make build-SCHEME
### 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>
<a name="#Installation"></a>
Run:
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
@ -218,6 +237,44 @@ 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>
@ -237,25 +294,21 @@ and input file to .sps file and other way around is undefined behaviour.
## Usage with Docker
<a name="#usage-with-docker"></a>
The project has
[docker image](https://hub.docker.com/repository/docker/retropikzel1/compile-r7rs/general).
Here is a sample Dockerfile to get you started.
It is statically built with Chicken scheme and installed under /opt/compile-r7rs,
so it can be copied in your Dockerfile.
Here is a sample Dockerfile to get you started:
ARG SCHEME=chibi
FROM schemers/${SCHEME}
COPY --from=retropikzel1/compile-r7rs /opt/compile-r7rs /opt/compile-r7rs
ENV PATH=/opt/compile-r7rs/bin:${PATH}
ENV COMPILE_R7RS=${SCHEME}
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:
docker build --build-arg SCHEME=${SCHEME} --tag=sometag .
docker run -v "${PWD}":/workdir -w /workdir -t sometag sh -c "compile-r7rs -I . -o main ./snow main.scm"
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>

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")
@ -157,7 +195,8 @@
prepend-directories
append-directories
library-files
r6rs?))))
r6rs?))
(string #\newline)))
(define scheme-library-command
(lambda (library-file)
@ -224,23 +263,18 @@
(display scheme-command)
(newline)
(with-output-to-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")
(display " \"")
(display "$@")
(display "\"")))
(newline)))
(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))))))

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