Retropikzel
/
compile-r7rs
1
0
Fork 0
Code Issues 4 Pull Requests Releases Activity

Fix Racket R6RS support

This commit is contained in:
retropikzel 2025-04-19 16:12:45 +03:00
parent 3e6d37c746
commit 8fb6592aa4
2 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@ -36,8 +36,8 @@ test-r6rs:
mkdir -p test mkdir -p test
mkdir -p test/snow mkdir -p test/snow
mkdir -p test/snow/foo mkdir -p test/snow/foo
echo "(library (foo bar) (export baz) (import (rnrs)) (define baz (lambda () (display \"Test successfull\") (newline))))" > test/snow/foo/bar.sls printf "#!r6rs\n(library (foo bar) (export baz) (import (rnrs)) (define baz (lambda () (display \"Test successfull\") (newline))))" > test/snow/foo/bar.sls
echo "(import (rnrs) (foo bar)) (baz)" > test/main.sps printf "#!r6rs\n(import (rnrs) (foo bar)) (baz)" > test/main.sps
cd test && COMPILE_R7RS=${COMPILE_R7RS} compile-r7rs -I ./snow -o main main.sps cd test && COMPILE_R7RS=${COMPILE_R7RS} compile-r7rs -I ./snow -o main main.sps
-cd test && ./main > /tmp/compile-r7rs-test-result.txt 2>&1 -cd test && ./main > /tmp/compile-r7rs-test-result.txt 2>&1
@grep "Test successfull" /tmp/compile-r7rs-test-result.txt || (echo "Test failed, output: " && cat /tmp/compile-r7rs-test-result.txt && exit 1) @grep "Test successfull" /tmp/compile-r7rs-test-result.txt || (echo "Test failed, output: " && cat /tmp/compile-r7rs-test-result.txt && exit 1)

7
libs/data.sld
View File

@ -417,6 +417,8 @@
(let ((rkt-input-file (if (string=? input-file "") (let ((rkt-input-file (if (string=? input-file "")
"" ""
(change-file-suffix input-file ".rkt")))) (change-file-suffix input-file ".rkt"))))
(if r6rs?
#t
(when (not (string=? rkt-input-file "")) (when (not (string=? rkt-input-file ""))
(when (file-exists? rkt-input-file) (when (file-exists? rkt-input-file)
(delete-file rkt-input-file)) (delete-file rkt-input-file))
@ -430,7 +432,7 @@
(display "(include \"") (display "(include \"")
(display (path->filename input-file)) (display (path->filename input-file))
(display "\")") (display "\")")
(newline)))) (newline)))))
(apply string-append (apply string-append
`("racket" `("racket"
" " " "
@ -447,7 +449,8 @@
(string-append "-S " item " ")) (string-append "-S " item " "))
append-directories) append-directories)
" " " "
,(if r6rs? input-file rkt-input-file))))))) ,(if r6rs? input-file rkt-input-file)
))))))
(sagittarius (sagittarius
(type . interpreter) (type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?) (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)