Merge remote-tracking branch 'origin/master' into snow-chibi-ypsilon

doc/chibi.scrbl

@@ -1664,11 +1664,11 @@ installed. The following are currently supported:
 \item{gambit - version >= 4.9.3}
 \item{generic; By default libraries are installed into /usr/local/lib/snow or %LOCALAPPDATA%/lib/snow on windows}
 \item{gauche - version >= 0.9.4}
-\item{kawa - version >= 2.0; you need to add the install dir to the search path, e.g. \scheme{-Dkawa.import.path=/usr/local/share/kawa}}
+\item{kawa - version >= 2.0; you need to add the install dir to the search path, e.g. \scheme{-Dkawa.import.path=/usr/local/share/kawa/lib/*.sld}}
 \item{larceny - version 0.98; you need to add "lib/Snow" to the paths in startup.sch}
-\item{sagittarius - version >= 0.9.13}
+\item{mosh - version >= 0.29-rc1}
 \item{racket - version >= 8.16 with the \scheme{r7rs} pkg}
-\item{sagittarius - version >= 0.98}
+\item{sagittarius - version >= 0.9.13}
 \item{stklos - version > 2.10}
 \item{ypsilon - version > 2.0.8}
 ]

lib/chibi/snow/commands.scm

@@ -1401,6 +1401,8 @@
         (if (string? path)
             path
             "/usr/local/share/guile/"))))
+    ((kawa)
+     (list "/usr/local/share/kawa/lib"))
     ((larceny)
      (list
       (make-path
@@ -1410,6 +1412,20 @@
                    "(begin (display (getenv \"LARCENY_ROOT\")) (exit))"))
         char-whitespace?)
        "lib/Snow")))
+    ((mosh)
+     (call-with-temp-file "snow-mosh.scm"
+      (lambda (tmp-path out preserve)
+       (with-output-to-file tmp-path
+        (lambda ()
+         (display "(import (scheme base) (scheme write) (mosh config))")
+         (newline)
+         (display "(display (get-config \"library-path\"))")))
+       (list (make-path (process->string `(mosh ,tmp-path)) "lib")))))
+    ((racket)
+     (list
+      (make-path
+       (process->string
+        '(racket -I racket/base -e "(display (find-system-path 'collects-dir))")))))
     ((sagittarius)
      (list (make-path
             (process->string
@@ -1519,6 +1535,10 @@
                  --r7rs --script ,file)
                `(kawa ,(string-append "-Dkawa.import.path=" install-dir)
                       --r7rs --script ,file))))
+        ((mosh)
+         (if lib-path
+             `(mosh --loadpath= ,install-dir --loadpath= ,lib-path ,file)
+             `(mosh --loadpath= ,install-dir ,file)))
         ((larceny)
          (if lib-path
              `(larceny -r7rs -path ,(string-append install-dir ":" lib-path)
@@ -1748,8 +1768,10 @@
    ((eq? impl 'gambit) (get-install-library-dir impl cfg))
    ((eq? impl 'generic) (get-install-library-dir impl cfg))
    ((eq? impl 'guile) (get-guile-site-dir))
-   ((eq? impl 'sagittarius) (get-install-library-dir impl cfg))
+   ((eq? impl 'kawa) (get-install-library-dir impl cfg))
+   ((eq? impl 'mosh) (get-install-library-dir impl cfg))
    ((eq? impl 'racket) (get-install-library-dir impl cfg))
+   ((eq? impl 'sagittarius) (get-install-library-dir impl cfg))
    ((eq? impl 'stklos) (get-install-library-dir impl cfg))
    ((eq? impl 'ypsilon) (get-install-library-dir impl cfg))
    ((conf-get cfg 'install-source-dir))
@@ -1763,8 +1785,10 @@
    ((eq? impl 'cyclone) (get-install-library-dir impl cfg))
    ((eq? impl 'gambit) (get-install-library-dir impl cfg))
    ((eq? impl 'generic) (get-install-library-dir impl cfg))
-   ((eq? impl 'sagittarius) (get-install-library-dir impl cfg))
+   ((eq? impl 'kawa) (get-install-library-dir impl cfg))
+   ((eq? impl 'mosh) (get-install-library-dir impl cfg))
    ((eq? impl 'racket) (get-install-library-dir impl cfg))
+   ((eq? impl 'sagittarius) (get-install-library-dir impl cfg))
    ((eq? impl 'stklos) (get-install-library-dir impl cfg))
    ((eq? impl 'ypsilon) (get-install-library-dir impl cfg))
    ((conf-get cfg 'install-data-dir))
@@ -1790,10 +1814,14 @@
     (car (get-install-dirs impl cfg)))
    ((eq? impl 'guile)
     (get-guile-site-ccache-dir))
-   ((eq? impl 'sagittarius)
+   ((eq? impl 'kawa)
+    (car (get-install-dirs impl cfg)))
+   ((eq? impl 'mosh)
     (car (get-install-dirs impl cfg)))
    ((eq? impl 'racket)
     (car (get-install-dirs impl cfg)))
+   ((eq? impl 'sagittarius)
+    (car (get-install-dirs impl cfg)))
    ((eq? impl 'stklos)
     (car (get-install-dirs impl cfg)))
    ((eq? impl 'ypsilon)
@@ -1812,7 +1840,7 @@
 (define (get-library-extension impl cfg)
   (or (conf-get cfg 'library-extension)
       (case impl
-        ((gauche kawa) "scm")
+        ((gauche) "scm")
         (else "sld"))))
 
 (define (install-with-sudo? cfg path)
@@ -2020,6 +2048,19 @@
          (library-shared-include-files
           impl cfg (make-path dir source-scm-file))))))))
 
+(define (kawa-installer impl cfg library dir)
+  (let* ((class-file (path-replace-extension
+                       (get-library-file cfg library) "class"))
+         (source-class-file (make-path dir class-file))
+         (install-dir (get-install-source-dir impl cfg))
+         (dest-class-file (make-path install-dir class-file))
+         (path (make-path install-dir dest-class-file))
+         (installed-files (default-installer impl cfg library dir)))
+    (cond ((file-exists? source-class-file)
+           (install-file cfg source-class-file dest-class-file)
+           (cons dest-class-file installed-files))
+          (else installed-files))))
+
 ;; 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)
@@ -2053,6 +2094,7 @@
     ((cyclone) cyclone-installer)
     ((gambit) gambit-installer)
     ((guile) guile-installer)
+    ((kawa) kawa-installer)
     ((racket) racket-installer)
     (else default-installer)))
 
@@ -2062,6 +2104,7 @@
     ((cyclone) 'cyclone)
     ((gambit) 'gambit)
     ((guile) 'guile)
+    ((kawa) 'kawa)
     ((racket) 'racket)
     (else 'default)))
 
@@ -2267,6 +2310,17 @@
        (and (system 'guild 'compile '-O0 '--r7rs '-o dest-library-file src-library-file)
             library)))))
 
+(define (kawa-builder impl cfg library dir)
+  (let* ((src-library-file (make-path dir (get-library-file cfg library)))
+         (res (system 'kawa
+                      '-d dir
+                      '-C src-library-file)))
+    (and (or (and (pair? res) (zero? (cadr res)))
+             (yes-or-no? cfg ".class file failed to build: "
+                         (library-name library)
+                         " - install anyway?"))
+         library)))
+
 (define (lookup-builder builder)
   (case builder
     ((chibi) chibi-builder)
@@ -2274,11 +2328,12 @@
     ((cyclone) cyclone-builder)
     ((gambit) gambit-builder)
     ((guile) guile-builder)
+    ((kawa) kawa-builder)
     (else default-builder)))
 
 (define (builder-for-implementation impl cfg)
   (case impl
-    ((chibi chicken cyclone gambit guile) impl)
+    ((chibi chicken cyclone gambit guile kawa) impl)
     (else 'default)))
 
 (define (build-library impl cfg library dir)

lib/chibi/snow/utils.scm

@@ -43,6 +43,17 @@
           ,(delay
              (process->sexp
               '(kawa -e "(write (features))"))))
+    (mosh "mosh" (mosh -v) #f
+          ,(delay
+           (call-with-temp-file "snow-mosh.scm"
+            (lambda (tmp-path out preserve)
+             (with-output-to-file tmp-path
+              (lambda ()
+               (display "(import (scheme base) (scheme write) (mosh config))")
+               (newline)
+               (display "(display (features))")))
+             (process->sexp
+              `(mosh ,tmp-path))))))
     (larceny "larceny" (larceny --version) "v0.98"
              ,(delay '()))
     (racket "racket" (racket --version) #f