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

Some Kawa fixes

This commit is contained in:
retropikzel 2025-04-30 20:34:05 +03:00
parent 6985bb2c4a
commit 311eefc961
2 changed files with 21 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
libs/data.sld
View File

@ -187,12 +187,10 @@
,input-file))))) ,input-file)))))
(gerbil (gerbil
(type . compiler) (type . compiler)
(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?) #;(library-command . ,(lambda (library-file prepend-directories append-directories r6rs?)
(apply string-append (apply string-append
`("gxc" `("gxc"
" " " "
"-O"
" "
,(util-getenv "COMPILE_R7RS_GERBIL") ,(util-getenv "COMPILE_R7RS_GERBIL")
" " " "
,library-file)))) ,library-file))))
@ -202,8 +200,12 @@
" " " "
,(util-getenv "COMPILE_R7RS_GERBIL") ,(util-getenv "COMPILE_R7RS_GERBIL")
" " " "
"-prelude \":scheme/r7rs\""
" "
"-exe" "-exe"
" " " "
"-static"
" "
,@(map (lambda (item) (string-append item "/ ")) prepend-directories) ,@(map (lambda (item) (string-append item "/ ")) prepend-directories)
,@(map (lambda (item) (string-append item "/ ")) append-directories) ,@(map (lambda (item) (string-append item "/ ")) append-directories)
" " " "
@ -294,7 +296,7 @@
" " " "
,(util-getenv "COMPILE_R7RS_KAWA") ,(util-getenv "COMPILE_R7RS_KAWA")
" " " "
"-Dkawa.import.path=" "-Dkawa.import.path=.:"
,@(map (lambda (item) ,@(map (lambda (item)
(string-append item "/*.sld:")) (string-append item "/*.sld:"))
(append prepend-directories append-directories)) (append prepend-directories append-directories))
@ -378,20 +380,16 @@
(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?)
(apply string-append (apply string-append
`("MOSH_LOAD_PATH=" `(;"MOSH_LOAD_PATH="
,@(map (lambda (item) ;,@(map (lambda (item) (string-append item ":")) prepend-directories)
(string-append item ":")) ;,@(map (lambda (item) (string-append item ":")) append-directories)
prepend-directories)
,@(map (lambda (item)
(string-append item ":"))
append-directories)
" " " "
"mosh" "mosh"
" " " "
,(util-getenv "COMPILE_R7RS_MOSH") ,(util-getenv "COMPILE_R7RS_MOSH")
" " " "
;,@(map (lambda (item) (string-append "--loadpath=" item " ")) prepend-directories) ,@(map (lambda (item) (string-append "--loadpath=" item " ")) prepend-directories)
;,@(map (lambda (item) (string-append "--loadpath=" item " ")) append-directories) ,@(map (lambda (item) (string-append "--loadpath=" item " ")) append-directories)
" " " "
,input-file))))) ,input-file)))))
(picrin (picrin

11
libs/util.sld
View File

@ -12,7 +12,8 @@
path->filename path->filename
change-file-suffix change-file-suffix
string-join string-join
util-getenv) util-getenv
dirname)
(begin (begin
(define util-getenv (define util-getenv
@ -21,6 +22,14 @@
(get-environment-variable name) (get-environment-variable name)
""))) "")))
(define dirname
(lambda (path)
(letrec ((looper (lambda (dirpath)
(cond ((= (string-length dirpath) 0) dirpath)
((char=? (string-ref dirpath 0) #\/) (string-copy dirpath 1))
(else (looper (string-copy dirpath 1)))))))
(string-reverse (looper (string-reverse path))))))
(define string-replace (define string-replace
(lambda (string-content replace with) (lambda (string-content replace with)
(string-map (lambda (c) (string-map (lambda (c)