Backup

.gitignore

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

Dockerfile

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

Dockerfile.alpine

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

Dockerfile.jenkins

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

Dockerfile.test

@@ -1,21 +1,14 @@
 ARG SCHEME=chibi
-ARG IMAGE=chibi:head
+FROM schemers/${SCHEME}:head
-FROM debian:trixie AS build
 RUN apt-get update && apt-get install -y \
-    --download-only \
-    --no-install-recommends \
-    --no-install-suggests \
     build-essential \
     make \
     libffi-dev \
     ca-certificates \
-    git \
+    git
-    cmark
+ENV PATH=${PATH}:/usr/local-other/bin
-
 ARG SCHEME=chibi
 ENV COMPILE_R7RS=${SCHEME}
-FROM schemers/${IMAGE}
+RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1 \
-COPY --from=build /var/cache/apt/archives /debs
+    && cd chibi-scheme && make -j 16 && make -j 16 install
-RUN dpkg -i /debs/*.deb
+RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
-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

Jenkinsfile

@@ -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'))
+            buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
-        timeout(time: 1, unit: 'HOURS')
     }
-
-    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()
+                    def r6rs_implementations = sh(script: 'chibi-scheme -I ./snow -I . compile-r7rs.scm --list-r6rs-schemes', returnStdout: true).split()
-                    parallel r6rs_implementations.collectEntries { SCHEME ->
+                    parallel r6rs_implementations.collectEntries { implementation->
-                        [(SCHEME): {
+                        [(implementation): {
-                                stage("${SCHEME} R6RS") {
+                                stage("${implementation} R6RS") {
                                     catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
-                                        def DOCKERIMG="${SCHEME}:head"
+                                        sh "make test-r6rs-docker SCHEME=${implementation}"
-                                        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\""
                                     }
                                 }
                             }
@@ -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()
+                    def r7rs_implementations = sh(script: 'chibi-scheme -I ./snow -I . compile-r7rs.scm --list-r7rs-schemes', returnStdout: true).split()
-                    parallel r7rs_implementations.collectEntries { SCHEME ->
+                    parallel r7rs_implementations.collectEntries { implementation->
-                        [(SCHEME): {
+                        [(implementation): {
-                                stage("${SCHEME} R7RS") {
+                                stage("${implementation} R7RS") {
                                     catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
-                                        def DOCKERIMG="${SCHEME}:head"
+                                        sh "make test-r7rs-docker SCHEME=${implementation}"
-                                        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\""
                                     }
                                 }
                             }
@@ -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'
-            }
-        }
-
     }
 }

Makefile

@@ -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:
+deps:
-	csc -R r7rs -X r7rs -static -c -J -unit libs.util -o libs.util.o libs/util.sld
+	mkdir -p deps
-	ar rcs libs.util.a libs.util.o
+	git clone https://git.sr.ht/~retropikzel/foreign-c deps/foreign-c --depth=1
-	csc -R r7rs -X r7rs -static -c -J -unit libs.library-util -o libs.library-util.o libs/library-util.sld
+	git clone https://git.sr.ht/~retropikzel/foreign-c-srfi-170 deps/foreign-c-srfi-170 --depth=1
-	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
 
 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
+test-r6rs-docker:
-	docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
+	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-world) (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/other
+	mkdir -p ${R7RSTMP}/libs/srfi
-	echo "(define over-9000 (lambda () (+ 1 1)))" > ${R7RSTMP}/libs/other/hellolib.scm
+	echo "(define over-9000 (lambda () (+ 1 1)))" > ${R7RSTMP}/libs/srfi/9001.scm
-	echo "(define-library (other hellolib) (import (scheme base) (scheme write)) (export over-9000) (include \"hellolib.scm\"))" > ${R7RSTMP}/libs/other/hellolib.sld
+	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
+test-r7rs-docker:
-	docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=compile-r7rs-test-${SCHEME} .
+	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

README.md

@@ -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)
+### Linux
-- (srfi 170)
+<a name="#dependencies-linux"></a>
 
-To install:
+#### Chicken Scheme and R7RS library
 
-    snow-chibi --impls=SCHEME "(foreign c)"
+On Debian/Ubuntu/Mint:
-    snow-chibi --impls=SCHEME "(srfi 170)"
 
-## Building
+    apt-get install -y chicken-bin
-<a name="#building"></a>
+    chicken-install r7rs
 
-The Makefile has build jobs for Schemes that compile-r7rs can be run with. The
+### Windows
-default is chibi. Run:
+<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
+Here is a sample Dockerfile to get you started.
-[docker image](https://hub.docker.com/repository/docker/retropikzel1/compile-r7rs/general).
 
-It is statically built with Chicken scheme and installed under /opt/compile-r7rs,
+    ARG COMPILE_R7RS=chibi
-so it can be copied in your Dockerfile.
+    FROM schemers/${COMPILE_R7RS}
-
+    RUN apt-get update && apt-get install -y make git chicken-bin
-Here is a sample Dockerfile to get you started:
+    RUN chicken-install r7rs
-
+    ARG COMPILE_R7RS=chibi
-    ARG SCHEME=chibi
+    ENV COMPILE_R7RS=${COMPILE_R7RS}
-    FROM schemers/${SCHEME}
+    RUN git clone https://git.sr.ht/~retropikzel/compile-r7rs && cd compile-r7rs && make && make install
-    COPY --from=retropikzel1/compile-r7rs /opt/compile-r7rs /opt/compile-r7rs
-    ENV PATH=/opt/compile-r7rs/bin:${PATH}
-    ENV COMPILE_R7RS=${SCHEME}
 
 To use this run:
 
-    docker build --build-arg SCHEME=${SCHEME} --tag=sometag .
+    export COMPILE_R7RS=<your scheme>
-    docker run -v "${PWD}":/workdir -w /workdir -t sometag sh -c "compile-r7rs -I . -o main ./snow main.scm"
+    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>

compile-r7rs.scm

@@ -3,35 +3,74 @@
         (scheme read)
         (scheme write)
         (scheme process-context)
+	(scheme cxr)
         (foreign c)
         (libs util)
         (libs data)
         (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)
+  (for-each
-  (newline)
+    (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)
+  (for-each
-  (newline)
+    (lambda (scheme)
+      (display scheme)
+      (newline))
+    r7rs-schemes)
   (exit 0))
 
 (when (member "--list-schemes" (command-line))
-  (for-each (lambda (scheme) (display scheme) (display " ")) all-schemes)
+  (for-each
-  (newline)
+    (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)
+(when (not scheme) (error "Environment variable COMPILE_R7RS not set."))
-  (display "Environment variable COMPILE_R7RS not set." (current-error-port))
+(when (not (assoc scheme data))
-  (newline (current-error-port))
+  (error "Unsupported implementation" scheme))
-  (exit 1))
-(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 +196,8 @@
                               prepend-directories
                               append-directories
                               library-files
-                              r6rs?))))
+                              r6rs?))
+                 (string #\newline)))
 
 (define scheme-library-command
   (lambda (library-file)
@@ -224,23 +264,18 @@
     (display scheme-command)
     (newline)
     (with-output-to-file
-      (if (string=? compilation-target "windows")
+    (if (string=? compilation-target "windows")
-        (string-append output-file ".bat")
+      (string-append output-file ".bat")
-        output-file)
+      output-file)
-      (lambda ()
+    (lambda ()
-        (cond ((string=? compilation-target "unix")
+      (cond ((string=? compilation-target "unix")
-               (display "#!/bin/sh")
+             (display "#!/bin/sh")
-               (newline))
+             (newline))
-              ((string=? compilation-target "windows")
+            ((string=? compilation-target "windows")
-               (display "@echo off")
+             (display "@echo off")
-               (newline)
+             (newline)
-               (display "start")))
+             (display "start")))
-        (display scheme-command)
+      (display scheme-command)))
-        (cond ((string=? compilation-target "unix")
-               (display " \"")
-               (display "$@")
-               (display "\"")))
-        (newline)))
   (cond ((string=? compilation-target "unix")
          (c-system (string->c-utf8 (string-append "chmod +x " output-file))))))
 

libs/library-util.scm

@@ -0,0 +1,123 @@
+(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))))))))

libs/library-util.sld

@@ -4,129 +4,9 @@
           (scheme read)
           (scheme write)
           (scheme file)
+	  (scheme cxr)
+	  (scheme process-context)
           (libs util))
   (export library-dependencies)
-  (begin
+  (include "library-util.scm"))
-   (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))))))))))
 

libs/util.sld

@@ -3,68 +3,21 @@
   (import (scheme base)
           (scheme write)
           (scheme file)
-          (scheme char)
           (scheme process-context)
           (foreign c))
-  (export echo
+  (export string-replace
-          cat
-          r6rs-schemes
-          r7rs-schemes
-          all-schemes
-          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
+          search-library-file)
-          slurp
-          file->list
-          trim
-          trim-end
-          trim-both)
   (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)))
+          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)))))))