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

Fixing R6RS

This commit is contained in:
retropikzel 2025-07-15 19:45:42 +03:00
parent 3edd58d75a
commit 7c16e623a7
3 changed files with 47 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Makefile
View File

@ -10,7 +10,7 @@ container:
build: deps
echo "#!/bin/sh" > compile-r7rs
echo "chibi-scheme -A ${PREFIX}/lib/compile-r7rs ${PREFIX}/lib/compile-r7rs/main.scm \$$@" >> compile-r7rs
echo "chibi-scheme -A ${PREFIX}/lib/compile-r7rs ${PREFIX}/lib/compile-r7rs/main.scm \"\$$@\"" >> compile-r7rs
deps:
mkdir -p deps
@ -34,8 +34,8 @@ test-r6rs:
mkdir -p ${R6RSTMP}
mkdir -p ${R6RSTMP}/libs
mkdir -p ${R6RSTMP}/libs/foo
printf "(library (foo bar) (export baz) (import (rnrs)) (define baz (lambda () (display \"Test successfull\") (newline))))" > ${R6RSTMP}/libs/foo/bar.sls
printf "(import (rnrs) (foo bar)) (baz)" > ${R6RSTMP}/main.sps
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} && 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)

44
libs/data.sld
View File

@ -432,25 +432,30 @@
(let* ((full-path (search-library-file (append append-directories
prepend-directories)
library-file))
(library-rkt-file (change-file-suffix full-path ".rkt"))
)
(apply string-append
`("printf"
" "
"'#lang r7rs\\n(import (scheme base))\\n(include \""
,(path->filename library-file)
"\")\\n"
"'"
" "
">"
" "
,library-rkt-file)))))
(library-rkt-file (change-file-suffix full-path ".rkt")))
(if r6rs?
(apply string-append
`("plt-r6rs"
" "
"--compile"
" "
,library-file))
(apply string-append
`("printf"
" "
"'#lang r7rs\\n(import (scheme base))\\n(include \""
,(path->filename library-file)
"\")\\n"
"'"
" "
">"
" "
,library-rkt-file))))))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(let ((rkt-input-file (if (string=? input-file "")
""
(change-file-suffix input-file ".rkt"))))
(if r6rs?
#t
(when (not r6rs?)
(when (not (string=? rkt-input-file ""))
(when (file-exists? rkt-input-file)
(delete-file rkt-input-file))
@ -476,13 +481,10 @@
" "
,@(map (lambda (item)
(string-append "-S " item " "))
prepend-directories)
,@(map (lambda (item)
(string-append "-S " item " "))
append-directories)
(append prepend-directories
append-directories))
" "
,(if r6rs? input-file rkt-input-file)
))))))
,(if r6rs? input-file rkt-input-file)))))))
(sagittarius
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)

22
libs/library-util.scm
View File

@ -67,6 +67,26 @@
(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)
@ -80,7 +100,7 @@
(list))
(begin
(newline)
(letrec* ((raw-data (with-input-from-file full-path (lambda () (read))))
(letrec* ((raw-data (read-until-library full-path))
(data (if (equal? (car raw-data) 'define-library)
(cdr raw-data)
raw-data))