Retropikzel
/
compile-r7rs
1
0
Fork 0
Code Issues

Kawa fixes

This commit is contained in:
retropikzel 2025-10-23 06:02:57 +03:00
parent 289a6c22cb
commit 9661a5a6a4
2 changed files with 50 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
libs/data.sld
View File

@ -238,60 +238,30 @@
append-directories))))))
(kawa
(type . interpreter)
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
(let* ((load-paths (apply string-append
(append (list "-Dkawa.import.path=")
(map (lambda (item)
(string-append item "/*.sld:"))
(append prepend-directories
append-directories)))))
(library-file-path (search-library-file (append prepend-directories
append-directories)
library-file))
(output-dir
(let ((output-dir "."))
(for-each
(lambda (dir)
(when (string-starts-with? library-file-path
dir)
(set! output-dir dir)))
(append prepend-directories
append-directories))
output-dir))
(classpath
(apply
string-append
(map (lambda (dir)
(string-append dir ":"))
(append prepend-directories append-directories)))))
`(,(string-append
"CLASSPATH=" classpath
" kawa -J--add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED -J--enable-native-access=ALL-UNNAMED -J--enable-preview "
(util-getenv "COMPILE_R7RS_KAWA")
" "
load-paths
" -d " output-dir
" "
load-paths
" -C "
library-file-path)))))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(let ((dirs (append prepend-directories
append-directories
(list "/usr/local/share/kawa/lib"))))
(string-append "CLASSPATH="
(apply string-append
(map (lambda (item)
(string-append item ":"))
dirs))
" kawa --r7rs --full-tailcalls "
(util-getenv "COMPILE_R7RS_KAWA")
" -Dkawa.import.path="
(apply string-append
(map (lambda (item)
(string-append item "/*.sld:"))
dirs))
" ")))))
(apply string-append
`(,"sh"
,(string #\newline)
"filename=\"$(basename ${0})\""
,(string #\newline)
"tmpfile=\"/tmp/kawa.${filename}\""
,(string #\newline)
"tail -n+8 \"${0}\" > \"${tmpfile}\""
,(string #\newline)
"kawa -J--add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED -J--enable-native-access=ALL-UNNAMED -J--enable-preview -Dkawa.import.path="
,(apply string-append
(map
(lambda (item)
(string-append item "/*.sld:"))
(append prepend-directories
append-directories)))
" --r7rs --full-tailcalls "
" -f \"${tmpfile}\" \"$@\""
,(string #\newline)
"rm -rf \"${tmpfile}\""
,(string #\newline)
"exit"
,(string #\newline))))))
(larceny
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)

52
libs/library-util.sld
View File

@ -48,23 +48,24 @@
(define get-imports
(lambda (result implementation rest)
(cond ((null? rest) result)
((equal? (car rest) 'import) (cdr rest))
((member 'cond-expand (car rest))
(if (assoc implementation (cdr (car rest)))
(get-imports result
implementation
(cdr (assoc implementation
(cdr (car rest)))))
(get-imports result
implementation
(cdr (assoc 'else
(cdr (car rest)))))))
((member 'import (car rest))
(get-imports (append result (list) (cdr (car rest)))
implementation
(cdr rest)))
(else (get-imports result implementation (cdr rest))))))
(cond
((null? rest) result)
((equal? (car rest) 'import) (cdr rest))
((member 'cond-expand (car rest))
(if (assoc implementation (cdr (car rest)))
(get-imports result
implementation
(cdr (assoc implementation
(cdr (car rest)))))
(get-imports result
implementation
(cdr (assoc 'else
(cdr (car rest)))))))
((member 'import (car rest))
(get-imports (append result (list) (cdr (car rest)))
implementation
(cdr rest)))
(else (get-imports result implementation (cdr rest))))))
(define remove-nonexistent
(lambda (directories paths)
@ -83,14 +84,15 @@
(lambda (path)
(letrec
((looper (lambda (c)
(cond ((char=? c #\()
(read))
((char=? c #\;)
(read-line)
(looper (peek-char)))
(else
(read-char)
(looper (peek-char)))))))
(cond
((char=? c #\()
(read))
((char=? c #\;)
(read-line)
(looper (peek-char)))
(else
(read-char)
(looper (peek-char)))))))
(with-input-from-file
path
(lambda ()