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)))))) append-directories))))))
(kawa (kawa
(type . interpreter) (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?) (command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(let ((dirs (append prepend-directories (apply string-append
append-directories `(,"sh"
(list "/usr/local/share/kawa/lib")))) ,(string #\newline)
(string-append "CLASSPATH=" "filename=\"$(basename ${0})\""
(apply string-append ,(string #\newline)
(map (lambda (item) "tmpfile=\"/tmp/kawa.${filename}\""
(string-append item ":")) ,(string #\newline)
dirs)) "tail -n+8 \"${0}\" > \"${tmpfile}\""
" kawa --r7rs --full-tailcalls " ,(string #\newline)
(util-getenv "COMPILE_R7RS_KAWA") "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="
" -Dkawa.import.path=" ,(apply string-append
(apply string-append (map
(map (lambda (item) (lambda (item)
(string-append item "/*.sld:")) (string-append item "/*.sld:"))
dirs)) (append prepend-directories
" "))))) append-directories)))
" --r7rs --full-tailcalls "
" -f \"${tmpfile}\" \"$@\""
,(string #\newline)
"rm -rf \"${tmpfile}\""
,(string #\newline)
"exit"
,(string #\newline))))))
(larceny (larceny
(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?)

52
libs/library-util.sld
View File

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