Merging and fixing

lib/chibi/snow/commands.scm

@@ -1407,13 +1407,11 @@
                    "(begin (display (getenv \"LARCENY_ROOT\")) (exit))"))
         char-whitespace?)
        "lib/Snow")))
-    ((racket)
+     ((racket)
-     (list (process->string
+      (list
-            '(racket -e "(display (find-system-path 'collects-dir))"))))
+       (make-path
-    ((stklos)
+        (process->string
-     (list (make-path
+         '(racket -I racket/base -e "(display (find-system-path 'collects-dir))")))))
-            (process->string
-             '(stklos -e "(display (install-path #:libdir))")))))
     (else
      (list (make-path (or (conf-get cfg 'install-prefix) "/usr/local")
                       "share/snow"
@@ -1953,60 +1951,42 @@
          (library-shared-include-files
           impl cfg (make-path dir source-scm-file))))))))
 
+;; Racket can only load files with .rkt suffix. So for each library we create
+;; a file that sets language to r7rs and includes the .sld file
 (define (racket-installer impl cfg library dir)
-  (let* ((library-file (get-library-file cfg library))
+  (let* ((source-rkt-file
-         (rkt-file (path-replace-extension library-file "rkt"))
+           (string-append dir
-         (library-file-name (path-strip-directory library-file))
+                          "/"
-         (ext (get-library-extension impl cfg))
+                          (path-strip-extension (get-library-file cfg library))
-         (dest-library-file
+                          ".rkt"))
-          (string-append (library->path cfg library) "." ext))
-         (dest-rkt-file (path-replace-extension dest-library-file "rkt"))
-         (include-files
-          (library-include-files impl cfg (make-path dir library-file)))
          (install-dir (get-install-source-dir impl cfg))
-         (install-lib-dir (get-install-library-dir impl cfg)))
+         (dest-rkt-file
+           (string-append install-dir
+                          "/"
+                          (library->path cfg library) ".rkt"))
+         (path (make-path install-dir dest-rkt-file))
+         (include-filename (string-append
+                             (path-strip-directory
+                               (path-strip-extension path))
+                             ".sld")))
     (display "HERE: ")
-    (display dir)
+    (display source-rkt-file)
     (newline)
-    (display "HERE1: ")
+    (display dest-rkt-file)
-    (display rkt-file)
     (newline)
-    ;; Create .rkt file
+
     (with-output-to-file
-      (string-append dir "/" rkt-file)
+      source-rkt-file
       (lambda ()
         (map display
-             `("#lang r7rs" #\newline
+             (list "#lang r7rs"
-              "(import (scheme base))" #\newline
+                   #\newline
-              "(include \"" ,library-file-name "\")" #\newline))))
+                   "(import (scheme base))"
-    ;; install the library file
+                   #\newline
-    (let ((path (make-path install-dir dest-library-file))
+                   "(include \"" include-filename "\")"
-          (rkt-path (make-path install-dir dest-rkt-file)))
+                   #\newline))))
-      (install-directory cfg (path-directory path))
+    (default-installer impl cfg library dir)
-      (install-file cfg (make-path dir library-file) path)
+    (install-file cfg source-rkt-file dest-rkt-file)))
-      (install-file cfg (make-path dir rkt-file) rkt-path)
-      ;; install any includes
-      (cons
-       path
-       (append
-        (map
-         (lambda (x)
-           (let ((dest-file (make-path install-dir (path-relative x dir))))
-             (install-directory cfg (path-directory dest-file))
-             (install-file cfg x dest-file)
-             dest-file))
-         include-files)
-        (map
-         (lambda (x)
-           (let* ((so-file (string-append x (cond-expand (macosx ".dylib")
-                                                         (else ".so"))))
-                  (dest-file (make-path install-lib-dir
-                                        (path-relative so-file dir))))
-             (install-directory cfg (path-directory dest-file))
-             (install-file cfg so-file dest-file)
-             dest-file))
-         (library-shared-include-files
-          impl cfg (make-path dir library-file))))))))
 
 ;; installers should return the list of installed files
 (define (lookup-installer installer)

lib/chibi/snow/utils.scm

@@ -70,6 +70,7 @@
   (case impl
     ((chibi) (cond-expand (chibi #t) (else #f)))
     ((gauche) (cond-expand (gauche #t) (else #f)))
+    ((racket) (cond-expand (racket #t) (else #f)))
     ((sagittarius) (cond-expand (sagittarius #t) (else #f)))
     ((stklos) (cond-expand (stklos #t) (else #f)))
     (else #f)))