From 6985bb2c4a808d1d76faf3d71eefd44dc6244f02 Mon Sep 17 00:00:00 2001 From: retropikzel Date: Sat, 26 Apr 2025 09:04:31 +0300 Subject: [PATCH] Chicken fixes --- README.md | 50 ++++++++++++++++++++++++++++ compile-r7rs.scm | 84 ++++++++++++++++++++++++++++++------------------ libs/data.sld | 47 ++++++++++++++++----------- libs/util.sld | 21 +++++++++++- 4 files changed, 151 insertions(+), 51 deletions(-) diff --git a/README.md b/README.md index eedb109..7d1e814 100644 --- a/README.md +++ b/README.md @@ -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 + + +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 + + +Only allows one loadpath. No workarounds exist currently in compile-r7rs. + +### mit-scheme + + +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 + + +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= 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= compile-r7rs -I . foo/bar.sld + ### Environment variables diff --git a/compile-r7rs.scm b/compile-r7rs.scm index aa92c8d..f53c884 100644 --- a/compile-r7rs.scm +++ b/compile-r7rs.scm @@ -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) diff --git a/libs/data.sld b/libs/data.sld index 43ac6f3..216d1c4 100644 --- a/libs/data.sld +++ b/libs/data.sld @@ -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 diff --git a/libs/util.sld b/libs/util.sld index e679fb7..e88409f 100644 --- a/libs/util.sld +++ b/libs/util.sld @@ -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))