Retropikzel
/
compile-r7rs
1
0
Fork 0
Code Issues

Debug additions

This commit is contained in:
retropikzel 2025-11-27 09:38:35 +02:00
parent 168d749d6d
commit 320e32d393
4 changed files with 49 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Dockerfile.test
View File

@ -1,26 +1,9 @@
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
ARG SCHEME=chibi
ARG IMAGE=chibi:head
FROM schemers/${IMAGE}
RUN apt-get update && apt-get install -y \
--no-install-recommends \
build-essential libffi-dev unzip php libreadline-dev
COPY --from=cache /cache /cache
WORKDIR /cache/chibi-scheme
RUN make install
WORKDIR /
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)"
RUN apt-get update && apt-get install -y gauche make
COPY Makefile .
COPY libs libs/
COPY compile-r7rs.scm .
RUN make build-chibi && make install
COPY compile-scheme.scm .
COPY doc doc/
RUN make build-gauche && make install

2
Makefile
View File

@ -124,7 +124,7 @@ test-r7rs:
rm -rf ${R7RSTMP}
mkdir -p ${R7RSTMP}
cp -r r7rs-testfiles/* ${R7RSTMP}/
cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I ./libs main.scm
cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I --debug ./libs 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)

5
compile-scheme.scm
View File

@ -216,6 +216,11 @@
(apply (cdr (assoc 'library-command (cdr (assoc scheme data))))
(list library-file prepend-directories append-directories r6rs?))))
(when debug?
(display "[debug] scheme-library-command: ")
(write scheme-library-command)
(newline))
(define list-of-features
(letrec ((looper (lambda (rest result)

69
libs/data.sld
View File

@ -190,36 +190,45 @@
" "
,args)))))
#;(gambit
(type . compiler)
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
`(,(string-append "gsc "
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(append prepend-directories
append-directories)))
(search-library-file (append append-directories
prepend-directories)
library-file)))))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(let ((output-tmp-file (string-append output-file ".tmp")))
`(,(string-append "echo \"#!/usr/bin/env gsi -:r7rs,search="
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(append prepend-directories
append-directories)))
"\" > " output-tmp-file)
,(string-append "cat " input-file " >> " output-tmp-file)
,(string-append "gsc "
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(append prepend-directories
append-directories)))
" -o " output-file
" -exe -nopreload "
output-tmp-file))))))
(type . compiler)
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
`(,(string-append "gsc "
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(append prepend-directories
append-directories)))
(search-library-file (append append-directories
prepend-directories)
library-file)))))
(command . ,(lambda (exec-cmd
script-file
args
input-file
output-file
prepend-directories
append-directories
library-files
r6rs?
compilation-target)
(let ((output-tmp-file (string-append output-file ".tmp")))
`(,(string-append "echo \"#!/usr/bin/env gsi -:r7rs,search="
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(append prepend-directories
append-directories)))
"\" > " output-tmp-file)
,(string-append "cat " input-file " >> " output-tmp-file)
,(string-append "gsc "
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(append prepend-directories
append-directories)))
" -o " output-file
" -exe -nopreload "
output-tmp-file))))))
(gauche
(type . interpreter)
(command . ,(lambda (exec-cmd