From a48123bd44c34d75b55f9c91a55a0b4a278550b6 Mon Sep 17 00:00:00 2001
From: retropikzel <retropikzel@iki.fi>
Date: Sun, 6 Jul 2025 16:44:50 +0300
Subject: [PATCH] Add support for Ypsilon in snow-chibi

---
 doc/chibi.scrbl             |  1 +
 lib/chibi/snow/commands.scm | 17 +++++++++++++++++
 lib/chibi/snow/utils.scm    | 13 ++++++++++++-
 lib/chibi/snow/utils.sld    |  1 +
 4 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl
index ed5af52c..a344411f 100755
--- a/doc/chibi.scrbl
+++ b/doc/chibi.scrbl
@@ -1670,4 +1670,5 @@ installed. The following are currently supported:
 \item{racket - version >= 8.16 with the \scheme{r7rs} pkg}
 \item{sagittarius - version >= 0.98}
 \item{stklos - version > 2.10}
+\item{ypsilon - version > 2.0.8}
 ]
diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm
index e6213d50..db534981 100644
--- a/lib/chibi/snow/commands.scm
+++ b/lib/chibi/snow/commands.scm
@@ -1423,6 +1423,15 @@
        (make-path
         (process->string
          '(racket -I racket/base -e "(display (find-system-path 'collects-dir))")))))
+     ((ypsilon)
+      (call-with-temp-file "snow-ypsilon.scm"
+       (lambda (tmp-path out preserve)
+         (with-output-to-file tmp-path
+                              (lambda ()
+                                (display "(import (core))")
+                                (newline)
+                                (display "(display (car (scheme-library-paths)))")))
+         (list (make-path (process->string `(ypsilon --r7rs ,tmp-path)))))))
     (else
      (list (make-path (or (conf-get cfg 'install-prefix) "/usr/local")
                       "share/snow"
@@ -1527,6 +1536,10 @@
          (if lib-path
              `(stklos -A ,install-dir -A ,lib-path ,file)
              `(stklos -A ,install-dir ,file)))
+        ((ypsilon)
+         (if lib-path
+             `(ypsilon --sitelib ,install-dir --sitelib ,lib-path ,file)
+             `(ypsilon --sitelib ,install-dir ,file)))
         (else
          #f))))))
 
@@ -1738,6 +1751,7 @@
    ((eq? impl 'sagittarius) (get-install-library-dir impl cfg))
    ((eq? impl 'racket) (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))
    ((conf-get cfg 'install-prefix)
     => (lambda (prefix) (make-path prefix "share/snow" impl)))
@@ -1752,6 +1766,7 @@
    ((eq? impl 'sagittarius) (get-install-library-dir impl cfg))
    ((eq? impl 'racket) (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))
    ((conf-get cfg 'install-prefix)
     => (lambda (prefix) (make-path prefix "share/snow" impl)))
@@ -1781,6 +1796,8 @@
     (car (get-install-dirs impl cfg)))
    ((eq? impl 'stklos)
     (car (get-install-dirs impl cfg)))
+   ((eq? impl 'ypsilon)
+    (car (get-install-dirs impl cfg)))
    ((conf-get cfg 'install-prefix)
     => (lambda (prefix) (make-path prefix "lib" impl)))
    (else snow-binary-module-directory)))
diff --git a/lib/chibi/snow/utils.scm b/lib/chibi/snow/utils.scm
index 90fa7456..78905262 100644
--- a/lib/chibi/snow/utils.scm
+++ b/lib/chibi/snow/utils.scm
@@ -56,7 +56,18 @@
     (stklos "stklos" (stklos --version) #f
                  ,(delay
                     (process->sexp
-                     '(stklos -e "(write (features))"))))))
+                     '(stklos -e "(write (features))"))))
+    (ypsilon "ypsilon" (ypsilon --version) #f
+             ,(delay
+                (call-with-temp-file "snow-ypsilon"
+                 (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
+                    `(ypsilon --r7rs ,tmp-path))))))))
 
 (define (impl->version impl cmd)
   (let* ((lines (process->string-list cmd))
diff --git a/lib/chibi/snow/utils.sld b/lib/chibi/snow/utils.sld
index e62d3cd0..45584967 100644
--- a/lib/chibi/snow/utils.sld
+++ b/lib/chibi/snow/utils.sld
@@ -20,6 +20,7 @@
           (chibi pathname)
           (chibi process)
           (chibi string)
+          (chibi temp-file)
           (chibi uri))
   (cond-expand
    (chibi (import (chibi io)))