gauche

6 files changed, 472 insertions, 0 deletions

diff --git a/mcgoron/guix/chibi.scm b/mcgoron/guix/chibi.scm
new file mode 100644
index 0000000..beb432d
--- /dev/null
+++ b/mcgoron/guix/chibi.scm
@@ -0,0 +1,52 @@
+#| Copyright (C) 2025 Peter McGoron
+ |
+ | This program is free software: you can redistribute it and/or modify it
+ | under the terms of the GNU General Public License as published by the
+ | Free Software Foundation, either version 3 of the License, or (at your
+ | option) any later version.
+ |
+ | This program is distributed in the hope that it will be useful, but
+ | WITHOUT ANY WARRANTY; without even the implied warranty of
+ | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ | General Public License for more details.
+ |
+ | You should have received a copy of the GNU General Public License along
+ | with this program.  If not, see <https://www.gnu.org/licenses/>.
+ |#
+
+(define-module (mcgoron guix chibi)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system copy)
+  #:use-module (guix packages)
+  #:use-module (gnu packages scheme)
+  #:use-module (guix gexp))
+
+(define-public chibi-scheme-build-system
+  (let ((lower* (build-system-lower copy-build-system)))
+    (build-system
+     (name 'chibi-pure)
+     (description "Build system for copying Scheme libraries to Chibi module directory")
+     (lower
+      (lambda args
+        (apply lower*
+               (if (memq #:install-plan args)
+                   args
+                   (append
+                    args
+                    (list
+                     #:install-plan
+                     `'(("." ,(string-append chibi-lib-dir
+                                             "/"))))))))))))
+
+(define-public chibi-lib-dir "share/guix-chibi")
+(define-public chibi-binlib-dir "lib/guix-chibi")
+
+(define-public chibi-scheme-with-path
+  (package
+   (inherit chibi-scheme)
+   (name "chibi-scheme-with-path")
+   (native-search-paths
+    (list (search-path-specification
+           (variable "CHIBI_MODULE_PATH")
+           (files (list chibi-lib-dir chibi-binlib-dir)))))))
+
diff --git a/mcgoron/guix/foment.scm b/mcgoron/guix/foment.scm
new file mode 100644
index 0000000..56db217
--- /dev/null
+++ b/mcgoron/guix/foment.scm
@@ -0,0 +1,106 @@
+#| Copyright (C) 2025 Peter McGoron
+ |
+ | This program is free software: you can redistribute it and/or modify it
+ | under the terms of the GNU General Public License as published by the
+ | Free Software Foundation, either version 3 of the License, or (at your
+ | option) any later version.
+ |
+ | This program is distributed in the hope that it will be useful, but
+ | WITHOUT ANY WARRANTY; without even the implied warranty of
+ | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ | General Public License for more details.
+ |
+ | You should have received a copy of the GNU General Public License along
+ | with this program.  If not, see <https://www.gnu.org/licenses/>.
+ |#
+
+(define-module (mcgoron guix foment)
+  #:use-module (guix packages)
+  #:use-module (guix licenses)
+  #:use-module (guix git-download)
+  #:use-module (gnu packages version-control)
+  #:use-module (gnu packages bash)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system copy)
+  #:use-module (guix gexp))
+
+(define-public foment-build-system
+  (let ((lower* (build-system-lower copy-build-system)))
+    (build-system
+     (name 'foment-scheme)
+     (description "Build system for copying Scheme libraries to Foment module directory")
+     (lower
+      (lambda args
+        (apply lower*
+               (if (memq #:install-plan args)
+                   args
+                   (append
+                    args
+                    (list
+                     #:install-plan
+                     `'(("." ,(string-append foment-lib-dir
+                                             "/"))))))))))))
+
+
+(define-public foment-lib-dir "share/foment")
+
+(define-public foment
+  (package
+    (name "foment")
+    (version "0.4.1-0.6089c3c")
+    (source
+      (origin
+         (method git-fetch)
+         (uri (git-reference (url "https://github.com/leftmike/foment")
+                             (commit "6089c3c9e762875f619ef382d27943819bbe002b")))
+         (sha256 (base32 "1a6q8qfd6ggc6fl9lf1d8m20q8k498jrswc4qcn3bb7rkq4w258a"))))
+    (build-system gnu-build-system)
+    (native-search-paths (list
+                          (search-path-specification
+                           (variable "FOMENT_LIBPATH")
+                           (files (list foment-lib-dir)))))
+    (arguments 
+      (list
+       #:phases
+        #~(modify-phases %standard-phases
+            (delete 'configure)
+            (add-before 'build 'patch-makefile
+              (lambda* (#:key outputs #:allow-other-keys)
+                (substitute* "unix/makefile"
+                  (("sudo *") "")
+                  (("git rev-parse --abbrev-ref HEAD") "echo \"master\"")
+                  (("git rev-parse --short HEAD") "echo 6089c3c"))
+;; Replace hardcoded path /bin/sh with the current interpreter.
+;; This follows what racket does:
+;; https://issues.guix.gnu.org/47180
+                (substitute* "src/base.scm"
+                  (("\"/bin/sh\"")
+                   (let ((sh (which "sh")))
+                     (string-append "(if (file-exists? \"" sh "\")\n"
+                                    "    \"" sh "\"\n" 
+                                    "    \"/bin/sh\")"))))))
+            (replace 'build
+              (lambda _
+                (with-directory-excursion "unix"
+                  (invoke "make"))))
+            (replace 'check
+              (lambda* (#:key tests? #:allow-other-keys)
+                (when tests?
+                  (with-directory-excursion "unix"
+                    (invoke "make" "test")
+                    (invoke "make" "stress-test")))))
+            (replace 'install
+              (lambda* (#:key outputs #:allow-other-keys)
+                 (let ((bin (string-append (assoc-ref outputs "out")
+                                           "/bin")))
+                 (install-file "unix/release/foment" bin)
+                 (copy-recursively "unix/debug/foment"
+                                   (string-append bin "/foment-debug"))))))))
+    (home-page "https://github.com/leftmike/foment")
+    (synopsis "Foment is an implementation of R7RS Scheme.")
+    (license expat)
+    (inputs '())
+    (native-inputs (list bash))
+    (description "Foment is an implementation of Scheme.")))
+
diff --git a/mcgoron/guix/gauche-build-system.scm b/mcgoron/guix/gauche-build-system.scm
new file mode 100644
index 0000000..6a4b8f5
--- /dev/null
+++ b/mcgoron/guix/gauche-build-system.scm
@@ -0,0 +1,98 @@
+#| Copyright (C) 2025 Peter McGoron
+ |
+ | This program is free software: you can redistribute it and/or modify it
+ | under the terms of the GNU General Public License as published by the
+ | Free Software Foundation, either version 3 of the License, or (at your
+ | option) any later version.
+ |
+ | This program is distributed in the hope that it will be useful, but
+ | WITHOUT ANY WARRANTY; without even the implied warranty of
+ | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ | General Public License for more details.
+ |
+ | You should have received a copy of the GNU General Public License along
+ | with this program.  If not, see <https://www.gnu.org/licenses/>.
+ |#
+
+(define-module (mcgoron guix gauche-build-system)
+  #:use-module (guix build utils))
+
+(define-public gauche-configure
+(lambda* (#:key build target outputs
+          (configure-flags '()) out-of-source?
+          (configure-file-name "configure")
+          #:allow-other-keys)
+  ;; Copied from gnu-build-system.scm, rev. f0c0769189d11debf7b237a02695c44c9773d52a
+  ;; modified for Gauche.
+  ;; Allows for the configure file to have a different name (not tested).
+  (define (package-name)
+    (let* ((out  (assoc-ref outputs "out"))
+           (base (basename out))
+           (dash (string-rindex base #\-)))
+      ;; XXX: We'd rather use `package-name->name+version' or similar.
+      (string-drop (if dash
+                       (substring base 0 dash)
+                       base)
+                   (+ 1 (string-index base #\-)))))
+
+  (let* ((prefix     (assoc-ref outputs "out"))
+         (bindir     (assoc-ref outputs "bin"))
+         (libdir     (assoc-ref outputs "lib"))
+         (includedir (assoc-ref outputs "include"))
+         (docdir     (assoc-ref outputs "doc"))
+         (flags      `(,@(if target             ; cross building
+                             '("CC_FOR_BUILD=gcc")
+                             '())
+                       ,(string-append "--prefix=" prefix)
+                       ;; Produce multiple outputs when specific output names
+                       ;; are recognized.
+                       ,@(if bindir
+                              (list (string-append "--bindir=" bindir "/bin"))
+                              '())
+                       ,@(if libdir
+                              (cons (string-append "--libdir=" libdir "/lib")
+                                    (if includedir
+                                        '()
+                                        (list
+                                         (string-append "--includedir="
+                                                        libdir "/include"))))
+                              '())
+                       ,@(if includedir
+                             (list (string-append "--includedir="
+                                                  includedir "/include"))
+                             '())
+                       ,@(if docdir
+                             (list (string-append "--docdir=" docdir
+                                                  "/share/doc/" (package-name)))
+                             '())
+                       ,@(if build
+                             (list (string-append "--build=" build))
+                             '())
+                       ,@(if target               ; cross building
+                             (list (string-append "--host=" target))
+                             '())
+                       ,@configure-flags))
+         (abs-srcdir (getcwd))
+         (srcdir     (if out-of-source?
+                         (string-append "../" (basename abs-srcdir))
+                         ".")))
+    (format #t "source directory: ~s (relative from build: ~s)~%"
+            abs-srcdir srcdir)
+    (if out-of-source?
+        (begin
+          (mkdir "../build")
+          (chdir "../build")))
+    (format #t "build directory: ~s~%" (getcwd))
+    (format #t "configure flags: ~s~%" flags)
+
+    ;; Gauche configure scripts are written in Gauche.
+    ;;
+    ;; Call `configure' with a relative path.  Otherwise, GCC's build system
+    ;; (for instance) records absolute source file names, which typically
+    ;; contain the hash part of the `.drv' file, leading to a reference leak.
+    (apply invoke "gosh"
+           (string-append srcdir "/" configure-file-name)
+           flags))))
+
+
+
diff --git a/mcgoron/guix/gauche.scm b/mcgoron/guix/gauche.scm
new file mode 100644
index 0000000..099b6ec
--- /dev/null
+++ b/mcgoron/guix/gauche.scm
@@ -0,0 +1,52 @@
+#| Copyright (C) 2025 Peter McGoron
+ |
+ | This program is free software: you can redistribute it and/or modify it
+ | under the terms of the GNU General Public License as published by the
+ | Free Software Foundation, either version 3 of the License, or (at your
+ | option) any later version.
+ |
+ | This program is distributed in the hope that it will be useful, but
+ | WITHOUT ANY WARRANTY; without even the implied warranty of
+ | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ | General Public License for more details.
+ |
+ | You should have received a copy of the GNU General Public License along
+ | with this program.  If not, see <https://www.gnu.org/licenses/>.
+ |#
+
+(define-module (mcgoron guix gauche)
+  #:use-module (guix packages)
+  #:use-module (gnu packages scheme)
+  #:use-module (guix gexp))
+
+(define-public gauche-abi-version
+  (let* ((version (string-split (package-version gauche) #\.))
+         (major (string->number (car version)))
+         (minor (string->number (list-ref version 1)))
+         (patch (string->number (list-ref version 2))))
+    (cond
+      ((and (= major 0) (= minor 9) (= patch 10))
+       "0.97")
+      ((and (= major 0) (= minor 9) (> patch 11))
+       "0.98")
+      (else (error 'gauche-abi-version "unknown gauche version: patch me!"
+                   major minor patch)))))
+
+(define-public gauche-lib-dir
+  (string-append "share/gauche-" gauche-abi-version "/site/lib"))
+
+;;; TODO: machine triple
+(define-public gauche-binlib-dir
+  (string-append "lib/gauche-" gauche-abi-version "/site/x86_64-unknown-linux-gnu"))
+
+(define-public gauche-with-path
+  (package
+   (inherit gauche)
+   (name "gauche-with-path")
+   (native-search-paths
+    (list (search-path-specification
+           (variable "GAUCHE_LOAD_PATH")
+           (files (list gauche-lib-dir)))
+          (search-path-specification
+           (variable "GAUCHE_DTNLOAD_PATH")
+           (files (list gauche-lib-dir)))))))
diff --git a/mcgoron/guix/sagittarius.scm b/mcgoron/guix/sagittarius.scm
new file mode 100644
index 0000000..880391e
--- /dev/null
+++ b/mcgoron/guix/sagittarius.scm
@@ -0,0 +1,70 @@
+#| Copyright (C) 2025 Peter McGoron
+ |
+ | This program is free software: you can redistribute it and/or modify it
+ | under the terms of the GNU General Public License as published by the
+ | Free Software Foundation, either version 3 of the License, or (at your
+ | option) any later version.
+ |
+ | This program is distributed in the hope that it will be useful, but
+ | WITHOUT ANY WARRANTY; without even the implied warranty of
+ | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ | General Public License for more details.
+ |
+ | You should have received a copy of the GNU General Public License along
+ | with this program.  If not, see <https://www.gnu.org/licenses/>.
+ |#
+
+
+(define-module (mcgoron guix sagittarius)
+  #:use-module (guix packages)
+  #:use-module (guix licenses)
+  #:use-module (gnu packages bdw-gc)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages tls)
+  #:use-module (gnu packages libffi)
+  #:use-module (guix download)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system copy)
+  #:use-module (guix build-system cmake))
+
+(define-public sagittarius-lib-dir "share/guix-sagittarius")
+
+(define-public sagittarius-scheme
+  (package
+    (name "sagittarius-scheme")
+    (version "0.9.13")
+    (source
+      (origin
+         (method url-fetch)
+         (uri "https://github.com/ktakashi/sagittarius-scheme/releases/download/v0.9.13/sagittarius-0.9.13.tar.gz")
+         (sha256 (base32 "0wspsv7mr1lchv0lfc50s750a358534pgri1c2fqlws31hci5y4c"))))
+    (build-system cmake-build-system)
+    (arguments '(#:phases (modify-phases %standard-phases
+                            ;; Tests don't work yet. Issues with network.
+                            (delete 'check))))
+    (inputs (list libgc zlib libffi openssl))
+    (home-page "https://ktakashi.github.io/")
+    (synopsis "Script interpreter with many built-in libraries")
+    (native-search-paths (list
+                          (search-path-specification
+                            (variable "SAGITTARIUS_LOADPATH")
+                            (files (list sagittarius-lib-dir)))))
+    (license bsd-2)
+    (description "Sagittarius Scheme is a R6RS/R7RS Scheme implementation with a lot of practical libraries, especially cryptographic libraries.")))
+
+(define-public sagittarius-build-system
+  (let ((lower* (build-system-lower copy-build-system)))
+    (build-system
+     (name 'sagittarius-scheme)
+     (description "Build system for copying Scheme libraries to Sagittarius Scheme module directory")
+     (lower
+      (lambda args
+        (apply lower*
+               (if (memq #:install-plan args)
+                   args
+                   (append
+                    args
+                    (list
+                     #:install-plan
+                     `'(("." ,(string-append sagittarius-lib-dir "/"))))))))))))
+
diff --git a/mcgoron/guix/scheme-hello-world.scm b/mcgoron/guix/scheme-hello-world.scm
new file mode 100644
index 0000000..1bbef44
--- /dev/null
+++ b/mcgoron/guix/scheme-hello-world.scm
@@ -0,0 +1,94 @@
+#| Copyright (C) 2025 Peter McGoron
+ |
+ | This program is free software: you can redistribute it and/or modify it
+ | under the terms of the GNU General Public License as published by the
+ | Free Software Foundation, either version 3 of the License, or (at your
+ | option) any later version.
+ |
+ | This program is distributed in the hope that it will be useful, but
+ | WITHOUT ANY WARRANTY; without even the implied warranty of
+ | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ | General Public License for more details.
+ |
+ | You should have received a copy of the GNU General Public License along
+ | with this program.  If not, see <https://www.gnu.org/licenses/>.
+ |#
+
+(define-module (mcgoron guix scheme-hello-world)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix licenses)
+  #:use-module (guix gexp)
+  #:use-module (guix build-system gnu)
+  #:use-module (gnu packages tls)
+  #:use-module (mcgoron guix chibi)
+  #:use-module (mcgoron guix foment)
+  #:use-module (mcgoron guix sagittarius)
+  #:use-module (mcgoron guix gauche))
+
+(define (hello-world-r7rs version)
+  (origin
+    (method url-fetch)
+    (uri (string-append "https://florida.moe/ftp/hello-world-r7rs/"
+                        version ".tar.gz"))
+    (sha256 (base32 "1cx9p2mz3cmn02imp137vqmq8aw3mh5s23ybprgkc8pshgmaf8jn"))))
+
+(define-public hello-world-chibi
+  (package
+   (name "hello-world-chibi")
+   (version "1.0.0")
+   (synopsis "Prints hello world")
+   (description "Prints hello world")
+   (license asl2.0)
+   (home-page "https://example.com")
+   (source (hello-world-r7rs version))
+   (build-system chibi-scheme-build-system)
+   (inputs (list chibi-scheme-with-path))))
+
+(define-public hello-world-foment
+  (package
+   (name "hello-world-foment")
+   (version "1.0.0")
+   (synopsis "Prints hello world")
+   (description "Prints hello world")
+   (license asl2.0)
+   (home-page "https://example.com")
+   (source (hello-world-r7rs version))
+   (build-system foment-build-system)
+   (inputs (list foment))))
+
+(define-public hello-world-sagittarius
+  (package
+   (name "hello-world-sagittarius")
+   (version "1.0.0")
+   (synopsis "Prints hello world")
+   (description "Prints hello world")
+   (license asl2.0)
+   (home-page "https://example.com")
+   (source (hello-world-r7rs version))
+   (build-system sagittarius-build-system)
+   (inputs (list foment))))
+
+(define-public hello-world-gauche
+  (package
+   (name "hello-world-gauche")
+   (version "1.0.0")
+   (synopsis "Prints hello world")
+   (description "Prints hello world")
+   (license asl2.0)
+   (home-page "https://example.com")
+   (source (origin
+             (method url-fetch)
+             (uri (string-append "https://florida.moe/ftp/hello-world-gauche/"
+                                 version ".tar.gz"))
+             (sha256 (base32 "0qfjzx5kwf8c5cjh5p72fg7wiyfn6mak4h5wsrhigzn9fzakxv3b"))))
+   (build-system gnu-build-system)
+   (arguments
+     (list
+      #:imported-modules `(,@%default-gnu-imported-modules (mcgoron guix gauche-build-system))
+      #:modules '((mcgoron guix gauche-build-system) (guix build utils) (guix build gnu-build-system))
+      #:phases
+      #~(modify-phases %standard-phases
+          (replace 'configure gauche-configure))))
+   (inputs (list gauche-with-path))
+   (native-inputs (list mbedtls gauche-with-path))))