1
0
Fork 0

Compare commits

..

2 Commits

Author SHA1 Message Date
retropikzel 49503db2c6 Clean up code 2025-12-07 08:17:19 +02:00
retropikzel 6459c6e149 Update readme 2025-12-07 06:48:47 +02:00
5 changed files with 51 additions and 108 deletions

View File

@ -1,3 +1,4 @@
.SILENT: test-r6rs test-r6rs-docker test-r7rs test-r7rs-docker
PREFIX=/usr/local PREFIX=/usr/local
SCHEME=chibi SCHEME=chibi
VERSION=1.0.0 VERSION=1.0.0
@ -100,26 +101,14 @@ test-r6rs:
rm -rf ${R6RSTMP} rm -rf ${R6RSTMP}
mkdir -p ${R6RSTMP} mkdir -p ${R6RSTMP}
cp -r r6rs-testfiles/* ${R6RSTMP}/ cp -r r6rs-testfiles/* ${R6RSTMP}/
cd ${R6RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I ./libs -o main main.sps cd ${R6RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I ./libs -o main --debug main.sps
cd ${R6RSTMP} && ./main 1 2 3 > test-result.txt 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) @grep "Test successfull (\"1\" \"2\" \"3\")" ${R6RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R6RSTMP}/test-result.txt && exit 1)
test-r6rs-docker: test-r6rs-docker:
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} . docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} --quiet . > /dev/null
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r6rs" docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r6rs"
test-r6rs-php:
rm -rf ${R6RSTMP}
mkdir -p ${R6RSTMP}
cp -r r6rs-php-testfiles/* ${R6RSTMP}/
cd ${R6RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -t php -o main.php main.sps
-cd ${R6RSTMP} && php main.php > test-result.txt 2>&1
@grep "Test successfull" ${R6RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R6RSTMP}/test-result.txt && exit 1)
test-r6rs-php-docker:
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r6rs-php"
test-r7rs: test-r7rs:
rm -rf ${R7RSTMP} rm -rf ${R7RSTMP}
mkdir -p ${R7RSTMP} mkdir -p ${R7RSTMP}
@ -129,7 +118,7 @@ test-r7rs:
@grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1) @grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
test-r7rs-docker: test-r7rs-docker:
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} . docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} --quiet . > /dev/null
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs" docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs"
test-r7rs-wine: test-r7rs-wine:
@ -141,20 +130,8 @@ test-r7rs-wine:
@grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1) @grep "Test successfull (\"1\" \"2\" \"3\")" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
test-r7rs-wine-docker: test-r7rs-wine-docker:
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} . docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} --quiet . > /dev/null
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs-wine" docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs-wine"
test-r7rs-php:
rm -rf ${R7RSTMP}
mkdir -p ${R7RSTMP}
cp -r r7rs-php-testfiles/* ${R7RSTMP}/
cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} COMPILE_R7RS_TARGET=php compile-scheme -o main.php main.scm
-cd ${R7RSTMP} && php main.php > test-result.txt 2>&1
@grep "Test successfull" ${R7RSTMP}/test-result.txt || (echo "Test failed, output: " && cat ${R7RSTMP}/test-result.txt && exit 1)
test-r7rs-php-docker:
docker build -f Dockerfile.test --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=${DOCKERTAG} .
docker run -v "${PWD}":/workdir -w /workdir -t ${DOCKERTAG} sh -c "make SCHEME=${SCHEME} test-r7rs-php"
clean: clean:
git clean -X -f git clean -X -f

View File

@ -53,12 +53,8 @@ OPTIONS
--list-r6rs List supported R6RS implementations. --list-r6rs List supported R6RS implementations.
--list-r6rs-except List supported R6RS implementations, except ones given.
--list-r7rs List supported R7RS implementations. --list-r7rs List supported R7RS implementations.
--list-r7rs-except List supported R7RS implementations, except ones given.
--list-all List all supported implementations. --list-all List all supported implementations.
--version Show the software version. --version Show the software version.
@ -91,29 +87,29 @@ CAVEATS
EXAMPLES EXAMPLES
Compile R6RS file with all dependencies in the same directory. Compile R6RS file with all dependencies in the same directory.
COMPILE_SCHEME=<SCHEME> compile-scheme main.sps COMPILE_SCHEME=SCHEME compile-scheme main.sps
Compile R7RS file with all dependencies in the same directory. Compile R7RS file with all dependencies in the same directory.
COMPILE_SCHEME=<SCHEME> compile-scheme main.scm COMPILE_SCHEME=SCHEME compile-scheme main.scm
Compile R6RS file with dependencies in libs directory. Compile R6RS file with dependencies in libs directory.
COMPILE_SCHEME=<SCHEME> compile-scheme -I ./libs main.sps COMPILE_SCHEME=SCHEME compile-scheme -I ./libs main.sps
Compile R7RS file with dependencies in libs directory. Compile R7RS file with dependencies in libs directory.
COMPILE_SCHEME=<SCHEME> compile-scheme -I ./libs main.scm COMPILE_SCHEME=SCHEME compile-scheme -I ./libs main.scm
Compile R6RS file with dependencies in libs directory, to output named Compile R6RS file with dependencies in libs directory, to output named
foo. foo.
COMPILE_SCHEME=<SCHEME> compile-scheme -I ./libs -o foo main.sps COMPILE_SCHEME=SCHEME compile-scheme -I ./libs -o foo main.sps
Compile R7RS file with dependencies in libs directory, to output named Compile R7RS file with dependencies in libs directory, to output named
foo. foo.
COMPILE_SCHEME=<SCHEME> compile-scheme -I ./libs -o foo main.scm COMPILE_SCHEME=SCHEME compile-scheme -I ./libs -o foo main.scm
compile-scheme(1) compile-scheme(1)
</pre> </pre>

View File

@ -8,7 +8,11 @@
(libs library-util) (libs library-util)
(srfi 170)) (srfi 170))
(define debug? (if (member "--debug" (command-line)) #t #f)) (define debug?
(if (or (member "--debug" (command-line))
(get-environment-variable "SCHEME_COMPILE_DEBUG"))
#t
#f))
(when (member "--help" (command-line)) (when (member "--help" (command-line))
(display "For help see: man compile-scheme") (display "For help see: man compile-scheme")
@ -67,10 +71,12 @@
((get-environment-variable "COMPILE_SCHEME") ((get-environment-variable "COMPILE_SCHEME")
(string->symbol (get-environment-variable "COMPILE_SCHEME"))) (string->symbol (get-environment-variable "COMPILE_SCHEME")))
(else #f))) (else #f)))
(when (not scheme) (when (not scheme)
(display "Either environment variable COMPILE_R7RS or COMPILE_SCHEME is not set." (current-error-port)) (display "Either environment variable COMPILE_R7RS or COMPILE_SCHEME is not set." (current-error-port))
(newline (current-error-port)) (newline (current-error-port))
(exit 1)) (exit 1))
(when (not (assoc scheme data)) (error "Unsupported implementation" scheme)) (when (not (assoc scheme data)) (error "Unsupported implementation" scheme))
(define input-file (define input-file
@ -163,42 +169,14 @@
(newline) (newline)
(exit 0)) (exit 0))
#;(define search-library-files (define library-files
(lambda (directory) (library-dependencies scheme
(let ((result (list))) (append prepend-directories append-directories)
(for-each (if input-file
(lambda (file) input-file
(let* ((path (string-append directory "/" file)) single-library-input-file)
(info (file-info path #f))) (list)
(when (and (not r6rs?) (list)))
(string-ends-with? path ".sld"))
(set! result (append result (list path))))
(when (and r6rs?
(string-ends-with? path ".sls"))
(set! result (append result (list path))))
(if (file-info-directory? info)
(set! result (append result (search-library-files path))))))
(directory-files directory))
result)))
#;(define library-files
(cond (single-library-input-file (list single-library-input-file))
(else
(apply append
(map
(lambda (directory)
(if (file-exists? directory)
(search-library-files directory)
(list)))
(append prepend-directories append-directories))))))
(define library-files (library-dependencies scheme
(append prepend-directories append-directories)
(if input-file
input-file
single-library-input-file)
(list)
(list)))
(define scheme-command (define scheme-command
(apply (cdr (assoc 'command (cdr (assoc scheme data)))) (apply (cdr (assoc 'command (cdr (assoc scheme data))))
@ -220,22 +198,11 @@
r6rs? r6rs?
compilation-target))) compilation-target)))
(when debug?
(display "[debug] scheme-command: ")
(write scheme-command)
(newline))
(define scheme-library-command (define scheme-library-command
(lambda (library-file) (lambda (library-file)
(apply (cdr (assoc 'library-command (cdr (assoc scheme data)))) (apply (cdr (assoc 'library-command (cdr (assoc scheme data))))
(list library-file prepend-directories append-directories r6rs?)))) (list library-file prepend-directories append-directories r6rs?))))
(when debug?
(display "[debug] scheme-library-command: ")
(write scheme-library-command)
(newline))
(define list-of-features (define list-of-features
(letrec ((looper (lambda (rest result) (letrec ((looper (lambda (rest result)
(if (null? rest) (if (null? rest)
@ -249,16 +216,25 @@
(when (not (null? library-files)) (when (not (null? library-files))
(when (assoc 'library-command (cdr (assoc scheme data))) (when (assoc 'library-command (cdr (assoc scheme data)))
(for-each (for-each
(lambda (file) (lambda (file)
(let* ((library-command (scheme-library-command file))) (let* ((library-command (scheme-library-command file)))
(for-each (when debug?
(lambda (command) (display "[DEBUG] library-command: ")
(let ((exit-code (system command))) (write library-command)
(when (not (= exit-code 0)) (newline))
(exit exit-code)))) (for-each
library-command))) (lambda (command)
library-files))) (let ((exit-code (system command)))
(when (not (= exit-code 0))
(exit exit-code))))
library-command)))
library-files)))
(when debug?
(display "[DEBUG] scheme-command: ")
(write scheme-command)
(newline))
(when (and (equal? scheme-type 'interpreter) input-file) (when (and (equal? scheme-type 'interpreter) input-file)
(when (and output-file (file-exists? output-file)) (when (and output-file (file-exists? output-file))
@ -298,4 +274,3 @@
(when (not (= exit-code 0)) (when (not (= exit-code 0))
(exit exit-code)))) (exit exit-code))))
scheme-command)) scheme-command))

View File

@ -102,24 +102,24 @@ Only supports one input-file.
.P .P
Compile R6RS file with all dependencies in the same directory. Compile R6RS file with all dependencies in the same directory.
.IP .IP
COMPILE_SCHEME=<SCHEME> compile-scheme main.sps COMPILE_SCHEME=SCHEME compile-scheme main.sps
.P .P
Compile R7RS file with all dependencies in the same directory. Compile R7RS file with all dependencies in the same directory.
.IP .IP
COMPILE_SCHEME=<SCHEME> compile-scheme main.scm COMPILE_SCHEME=SCHEME compile-scheme main.scm
.P .P
Compile R6RS file with dependencies in libs directory. Compile R6RS file with dependencies in libs directory.
.IP .IP
COMPILE_SCHEME=<SCHEME> compile-scheme -I ./libs main.sps COMPILE_SCHEME=SCHEME compile-scheme -I ./libs main.sps
.P .P
Compile R7RS file with dependencies in libs directory. Compile R7RS file with dependencies in libs directory.
.IP .IP
COMPILE_SCHEME=<SCHEME> compile-scheme -I ./libs main.scm COMPILE_SCHEME=SCHEME compile-scheme -I ./libs main.scm
.P .P
Compile R6RS file with dependencies in libs directory, to output named foo. Compile R6RS file with dependencies in libs directory, to output named foo.
.IP .IP
COMPILE_SCHEME=<SCHEME> compile-scheme -I ./libs -o foo main.sps COMPILE_SCHEME=SCHEME compile-scheme -I ./libs -o foo main.sps
.P .P
Compile R7RS file with dependencies in libs directory, to output named foo. Compile R7RS file with dependencies in libs directory, to output named foo.
.IP .IP
COMPILE_SCHEME=<SCHEME> compile-scheme -I ./libs -o foo main.scm COMPILE_SCHEME=SCHEME compile-scheme -I ./libs -o foo main.scm

View File

@ -16,8 +16,6 @@
(scheme process-context) (scheme process-context)
(foreign c)))) (foreign c))))
(export system (export system
echo
cat
r6rs-schemes r6rs-schemes
r7rs-schemes r7rs-schemes
all-schemes all-schemes
@ -53,9 +51,6 @@
(define-c-procedure c-system c-stdlib 'system 'int '(pointer)) (define-c-procedure c-system c-stdlib 'system 'int '(pointer))
(define (system cmd) (define (system cmd)
(c-system (string->c-utf8 cmd))))) (c-system (string->c-utf8 cmd)))))
(define (echo text) (display text) (newline))
(define (cat path) (for-each (lambda (line) (echo line)) (file->list path)))
(define r6rs-schemes '(capyscheme (define r6rs-schemes '(capyscheme
chezscheme chezscheme
guile guile