Chicken fixes

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
+<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>
 

compile-r7rs.scm

@@ -64,8 +64,20 @@
       (list-tail (command-line) 1))
     input-file))
 
-(define r6rs?  (if (and input-file
+(define single-library-input-file
-                        (string-ends-with? input-file ".sps"))
+  (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))
 
@@ -126,13 +138,15 @@
       result)))
 
 (define library-files
+  (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))))
+                   (append prepend-directories append-directories))))))
 
 (define scheme-type (cdr (assoc 'type (cdr (assoc scheme data)))))
 
@@ -171,7 +185,13 @@
 (newline)
 
 ; Compile libraries
-(cond ((assoc 'library-command (cdr (assoc scheme data)))
+(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)))
@@ -191,7 +211,7 @@
            library-files))
         (else
           (display "Implementation has no library build command, skipping library compilation.")
-        (newline)))
+          (newline))))
 
 ; Create executable file
 (when (and (equal? scheme-type 'interpreter) input-file)

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)
+                                                       ,(let ((result #f))
-                                                                (if (string-starts-with? library-file item)
+                                                          (map (lambda (item)
-                                                                  (string-append (string-replace (string-copy (string-cut-from-end library-file 4)
+                                                                 (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")
+                                                                                               ".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)
+                                 ;,@(map (lambda (item) (string-append "--loadpath=" item " ")) prepend-directories)
-                                          (string-append "--loadpath=" item " "))
+                                 ;,@(map (lambda (item) (string-append "--loadpath=" item " ")) append-directories)
-                                        prepend-directories)
-                                 ,@(map (lambda (item)
-                                          (string-append "--loadpath=" item " "))
-                                        append-directories)
                                  " "
                                  ,input-file)))))
         (picrin

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))