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

Chicken fixes

This commit is contained in:
retropikzel 2025-04-26 09:04:31 +03:00
parent f8411cca6c
commit 6985bb2c4a
4 changed files with 151 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
README.md
View File

@ -15,6 +15,10 @@ Despite it's name it also supports R6RS. Schemers, unite! <3
- [Linux](#installation-linux)
- [Windows](#installation-windows)
- [Usage](#usage)
- [Chicken](#usage-chicken)
- [Mosh](#usage-mosh)
- [mit-scheme](#usage-mit-scheme)
- [Compiling a single library](#usage-compiling-single-library)
- [Environment variables](#usage-environment-variables)
- [Usage with docker](#usage-with-docker)
- [Usual RnRS project](#usual-rnrs-project)
@ -245,6 +249,52 @@ No other file suffixes are supported at the moment.
Setting value of COMPILE\_R7RS to implementation name that supports only r7rs
and input file to .sps file and other way around is undefined behaviour.
### Chicken
<a name="#usage-chicken"></a>
To run executable at place set LD\_LIBRARY\_PATH=. (executable directory)
before running it. For example:
LD\_LIBRARY\_PATH=. ./test
If you are using Chicken you should propably read the next section too, you
will most propably run into it soon.
### Mosh
<a name="#usage-mosh"></a>
Only allows one loadpath. No workarounds exist currently in compile-r7rs.
### mit-scheme
<a name="#usage-mit-scheme"></a>
Only allows one loadpath. Workaround in compile-r7rs is that each library is
loaded individually, like so:
mit-scheme --load foo/bar.sld --load foo/baz.sld ... main.scm
This does not require actions from the user and is done automatically.
### Compiling a single library
<a name="#usage-compiling-a-single-library"></a>
Sometimes implementations need the libraries compiled in certain order,
specially the compilers. Since doing analysing from the files about which
library depends on which library I've decided to outsource it to you. :)
To compile single library run the same command (including all the arguments
other than -o)
you would run for executable, except change the input file to the library.
Example of compiling main program:
COMPILE_R7RS=<implementation name> compile-r7rs -I . -o main main.scm
And if the main program needed library called foo/bar.sld, and the compile-r7rs
tried to compile them in wrong order you would run:
COMPILE_R7RS=<implementation name> compile-r7rs -I . foo/bar.sld
### Environment variables
<a name="#usage-environment-variables"></a>

84
compile-r7rs.scm
View File

@ -64,10 +64,22 @@
(list-tail (command-line) 1))
input-file))
(define r6rs? (if (and input-file
(string-ends-with? input-file ".sps"))
#t
#f))
(define single-library-input-file
(let ((input-file #f))
(for-each
(lambda (item)
(when (or (string-ends-with? item ".sld")
(string-ends-with? item ".sls"))
(set! input-file item)))
(list-tail (command-line) 1))
input-file))
(define r6rs?
(if (and input-file
(or (string-ends-with? input-file ".sps")
(string-ends-with? input-file ".sls")))
#t
#f))
(define output-file
(if (member "-o" (command-line))
@ -126,13 +138,15 @@
result)))
(define library-files
(apply append
(map
(lambda (directory)
(if (file-exists? directory)
(search-library-files directory)
(list)))
(append prepend-directories append-directories))))
(cond (single-library-input-file (list single-library-input-file))
(else
(apply append
(map
(lambda (directory)
(if (file-exists? directory)
(search-library-files directory)
(list)))
(append prepend-directories append-directories))))))
(define scheme-type (cdr (assoc 'type (cdr (assoc scheme data)))))
@ -171,27 +185,33 @@
(newline)
; Compile libraries
(cond ((assoc 'library-command (cdr (assoc scheme data)))
(for-each
(lambda (file)
(let* ((library-command (scheme-library-command file)))
(display "Compiling library ")
(display file)
(newline)
(display "With command ")
(display library-command)
(newline)
(display "Exit code ")
(let ((output (c-system (pffi-string->pointer library-command))))
(when (not (= output 0))
(error "Problem compiling libraries, exiting" output))
(display output))
(newline)
(newline)))
library-files))
(else
(display "Implementation has no library build command, skipping library compilation.")
(newline)))
(when (not (null? library-files))
(if single-library-input-file
(display "Given library file: ")
(display "Found library files: "))
(display library-files)
(newline)
(cond ((assoc 'library-command (cdr (assoc scheme data)))
(for-each
(lambda (file)
(let* ((library-command (scheme-library-command file)))
(display "Compiling library ")
(display file)
(newline)
(display "With command ")
(display library-command)
(newline)
(display "Exit code ")
(let ((output (c-system (pffi-string->pointer library-command))))
(when (not (= output 0))
(error "Problem compiling libraries, exiting" output))
(display output))
(newline)
(newline)))
library-files))
(else
(display "Implementation has no library build command, skipping library compilation.")
(newline))))
; Create executable file
(when (and (equal? scheme-type 'interpreter) input-file)

47
libs/data.sld
View File

@ -4,8 +4,8 @@
(scheme write)
(scheme file)
(scheme process-context)
(libs util)
(srfi 170))
(srfi 170)
(libs util))
(export data)
(begin
(define data
@ -51,15 +51,22 @@
" "
"-o"
" "
,@(map (lambda (item)
(if (string-starts-with? library-file item)
(string-append (string-replace (string-copy (string-cut-from-end library-file 4)
(+ (string-length item) 1))
#\/
#\.)
".so")
""))
(append prepend-directories append-directories))
,(let ((result #f))
(map (lambda (item)
(when (and (not result)
(string-starts-with? (real-path library-file)
(real-path item)))
(set! result (string-append (string-replace (string-copy (string-cut-from-end library-file 4)
(+ (string-length item) 1))
#\/
#\.)
".so"))))
(append prepend-directories append-directories))
(write result)
(newline)
(if result
result
(error "Could not deduct library output path" library-file)))
" "
,library-file))))
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
@ -371,16 +378,20 @@
(type . interpreter)
(command . ,(lambda (input-file output-file prepend-directories append-directories library-files r6rs?)
(apply string-append
`("mosh"
`("MOSH_LOAD_PATH="
,@(map (lambda (item)
(string-append item ":"))
prepend-directories)
,@(map (lambda (item)
(string-append item ":"))
append-directories)
" "
"mosh"
" "
,(util-getenv "COMPILE_R7RS_MOSH")
" "
,@(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 " ")) prepend-directories)
;,@(map (lambda (item) (string-append "--loadpath=" item " ")) append-directories)
" "
,input-file)))))
(picrin

21
libs/util.sld
View File

@ -1,7 +1,8 @@
(define-library
(libs util)
(import (scheme base)
(scheme process-context))
(scheme process-context)
(retropikzel pffi))
(export string-replace
string-ends-with?
string-starts-with?
@ -27,6 +28,24 @@
with c))
string-content)))
(define string-replace-one
(lambda (string-content replace with)
(let ((replaced? #f))
(string-map (lambda (c)
(if (and (not replaced?)
(char=? c replace))
with c))
string-content))))
(define string-replace-one-from-end
(lambda (string-content replace with)
(let ((replaced? #f))
(list->string (reverse (map (lambda (c)
(if (and (not replaced?)
(char=? c replace))
with c))
(reverse (string->list string-content))))))))
(define string-ends-with?
(lambda (string-content end)
(if (and (>= (string-length string-content) (string-length end))