Retropikzel
/
compile-scheme
1
0
Fork 0
Code Issues

tr7 fixes

This commit is contained in:
retropikzel 2025-12-01 19:32:13 +02:00
parent da0265e7d6
commit 59240f04b0
3 changed files with 81 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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 --debug main.scm
cd ${R7RSTMP} && COMPILE_R7RS=${SCHEME} compile-scheme -I ./libs --debug 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)

22
compile-scheme.scm
View File

@ -26,12 +26,34 @@
(newline)
(exit 0))
(when (member "--list-r6rs-except" (command-line))
(for-each
(lambda (scheme)
(when (not (member (symbol->string scheme)
(cdr (member "--list-r6rs-except" (command-line)))))
(display scheme)
(display " ")))
r6rs-schemes)
(newline)
(exit 0))
(when (or (member "--list-r7rs" (command-line))
(member "--list-r7rs-schemes" (command-line)))
(for-each (lambda (scheme) (display scheme) (display " ")) r7rs-schemes)
(newline)
(exit 0))
(when (member "--list-r7rs-except" (command-line))
(for-each
(lambda (scheme)
(when (not (member (symbol->string scheme)
(cdr (member "--list-r7rs-except" (command-line)))))
(display scheme)
(display " ")))
r7rs-schemes)
(newline)
(exit 0))
(when (or (member "--list-all" (command-line))
(member "--list-schemes" (command-line)))
(for-each (lambda (scheme) (display scheme) (display " ")) all-schemes)

67
libs/data.sld
View File

@ -189,13 +189,13 @@
,script-file
" "
,args)))))
#;(gambit
(gambit
(type . compiler)
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
`(,(string-append "gsc "
#;(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
`(,(string-append "gsc -:search="
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(string-append item "/, "))
(append prepend-directories
append-directories)))
(search-library-file (append append-directories
@ -211,24 +211,61 @@
library-files
r6rs?
compilation-target)
(let ((output-tmp-file (string-append output-file ".tmp")))
`(,(string-append "echo \"#!/usr/bin/env gsi -:r7rs,search="
(let ((library-files-paths
(map (lambda (item)
(search-library-file (append prepend-directories
append-directories)
item))
library-files))
(link-file
(string-append
(string-cut-from-end input-file 4) "_.c")))
`(,(string-append "gsc -:search="
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(string-append item ","))
(append prepend-directories
append-directories)))
"\" > " output-tmp-file)
,(string-append "cat " input-file " >> " output-tmp-file)
,(string-append "gsc "
1)
" -link -flat -nopreload "
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item "/ "))
(string-append item " "))
library-files-paths))
1)
" "
input-file)
,(string-append "gsc -:search="
(string-cut-from-end
(apply string-append
(map (lambda (item)
(string-append item ","))
(append prepend-directories
append-directories)))
" -o " output-file
" -exe -nopreload "
output-tmp-file))))))
1)
" -obj "
(apply string-append
(map (lambda (item)
(string-append (string-cut-from-end item 4) ".c "))
library-files-paths))
" "
(string-append (string-cut-from-end input-file 4) ".c")
" "
(string-append (string-cut-from-end input-file 4) "_.c"))
,(string-append "gcc -o "
output-file
" "
(apply string-append
(map (lambda (item)
(string-append (string-cut-from-end item 4) ".o "))
library-files-paths))
" "
(string-append (string-cut-from-end input-file 4) ".o")
" "
(string-append (string-cut-from-end input-file 4) "_.o"))
)))))
(gauche
(type . interpreter)
(command . ,(lambda (exec-cmd
@ -666,7 +703,7 @@
append-directories)
" "
,exec-cmd
" tr7i -1 "
" tr7i "
,(util-getenv "COMPILE_R7RS_TR7")
,script-file
" "