Use cond-expand to find the right match library.

2 files changed, 16 insertions, 79 deletions

diff --git a/.guix/run64-package.scm b/.guix/run64-package.scm
index 44a1380..fde9f6f 100644
--- a/.guix/run64-package.scm
+++ b/.guix/run64-package.scm
@@ -17,58 +17,13 @@
 ;;; along with run64.  If not, see <https://www.gnu.org/licenses/>.
 
 (define-module (run64-package)
-  #:use-module ((gnu packages base) #:select (gnu-make))
-  #:use-module ((gnu packages emacs) #:select (emacs-minimal))
-  #:use-module ((gnu packages guile) #:select (guile-3.0))
-  #:use-module ((gnu packages scheme) #:select (chibi-scheme))
   #:use-module (guix build-system gnu)
-  #:use-module (guix build-system guile)
   #:use-module (guix gexp)
   #:use-module (guix git-download)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix packages)
   #:use-module (guix utils))
 
-(define-public guile-chibi-match
-  (package
-    (name "guile-chibi-match")
-    (version (package-version chibi-scheme))
-    (source (package-source chibi-scheme))
-    (build-system guile-build-system)
-    (arguments
-     (list #:modules '((guix build guile-build-system)
-                       (guix build utils)
-                       (ice-9 ftw))
-           #:phases
-           #~(modify-phases %standard-phases
-               (add-after 'unpack 'rearrange-files
-                 (lambda _
-                   ;; Delete and rearrange files so that (chibi match)
-                   ;; is in the expected directory hierarchy.
-                   (chdir "lib/chibi")
-                   (rename-file "match" "chibi")
-                   (for-each (lambda (file)
-                               (unless (member file (list "." ".." "chibi"))
-                                 (delete-file-recursively file)))
-                             (scandir "."))
-                   (substitute* "chibi/match.scm"
-                     ((";; 2006/12/01[^\n]*" line)
-                      (string-append line
-                                     "\n(define-module (chibi match)
-#:export (match match-lambda match-lambda* match-let match-letrec match-let*))"))))))))
-    (inputs
-     (list guile-3.0))
-    (home-page "https://synthcode.com/scheme/chibi/lib/chibi/match.html")
-    (synopsis "Portable hygienic pattern matcher")
-    (description "@code{guile-chibi-match} is a portable hygienic
-pattern matcher for Scheme.  This is a full superset of the popular
-match package by Andrew Wright, written in fully portable syntax-rules
-and thus preserving hygiene.  The most notable extensions are the
-ability to use non-linear patterns---patterns in which the same
-identifier occurs multiple times, tail patterns after ellipsis, and
-the experimental tree patterns.")
-    (license (package-license chibi-scheme))))
-
 (define-public run64
   (package
     (name "run64")
@@ -81,29 +36,9 @@ the experimental tree patterns.")
     (build-system gnu-build-system)
     (arguments
      (list #:make-flags #~(list (string-append "prefix=" #$output))
-           #:modules `(((guix build guile-build-system)
-                        #:select (target-guile-effective-version))
-                       ,@%default-gnu-imported-modules)
            #:phases
-           (with-imported-modules `((guix build guile-build-system)
-                                    ,@%default-gnu-imported-modules)
-             #~(modify-phases %standard-phases
-                 (delete 'configure)
-                 (add-after 'install 'wrap
-                   (lambda* (#:key inputs outputs #:allow-other-keys)
-                     (let ((out (assoc-ref outputs "out"))
-                           (effective-version (target-guile-effective-version)))
-                       (wrap-program (string-append out "/bin/guile-run64")
-                         `("GUILE_LOAD_PATH" prefix
-                           (,(string-append out "/share/guile/site/" effective-version)
-                            ,(getenv "GUILE_LOAD_PATH")))
-                         `("GUILE_LOAD_COMPILED_PATH" prefix
-                           (,(string-append out "/lib/guile/"
-                                            effective-version "/site-ccache")
-                            ,(getenv "GUILE_LOAD_COMPILED_PATH")))))))))))
-    (inputs
-     (list guile-3.0
-           guile-chibi-match))
+           #~(modify-phases %standard-phases
+               (delete 'configure))))
     (home-page "https://run64.systemreboot.net")
     (synopsis "SRFI-64 test runner for Scheme")
     (description "run64 is a SRFI-64 test runner for Scheme.")
diff --git a/bin/run64 b/bin/run64
index c38682f..3c98ec0 100755
--- a/bin/run64
+++ b/bin/run64
@@ -22,12 +22,14 @@
         (rnrs programs)
         (rnrs records syntactic)
         (srfi srfi-1)
-        (srfi srfi-64)
-        ;; We prefix (chibi match) imports with chibi: so as to not
-        ;; conflict with match bindings provided by the
-        ;; implementation. We should find a better solution, if at all
-        ;; possible.
-        (prefix (chibi match) chibi:))
+        (srfi srfi-64))
+
+;; We prefix match imports with run64: so as to not conflict with match bindings
+;; provided by the implementation. We should find a better solution, if at all
+;; possible.
+(cond-expand
+ (guile (import (prefix (ice-9 match) run64:)))
+ (else (import (prefix (chibi match) run64:))))
 
 (define-record-type (<highlit> highlit highlit?)
   (fields (immutable contents highlit-contents)))
@@ -35,7 +37,7 @@
 (define-record-type (<nothing> nothing nothing?))
 
 (define (assq-ref alist key)
-  (chibi:match (assq key alist)
+  (run64:match (assq key alist)
     ((_ . value) value)
     (#f #f)))
 
@@ -125,7 +127,7 @@ given string in an ANSI escape code."
     ;; Open the list.
     (display opener)
     (let ((child-column (+ (string-length opener) column)))
-      (chibi:match lst
+      (run64:match lst
         ;; If an empty list, close without doing anything else.
         (()
          (display ")"))
@@ -207,11 +209,11 @@ given string in an ANSI escape code."
   "Like @code{map}, but does not stop when the end of the shortest list is reached.
 @var{proc} calls beyond the end of shorter lists are passed a @code{<nothing>}
 object instead of the list element."
-  (let ((heads (map (chibi:match-lambda
+  (let ((heads (map (run64:match-lambda
                      ((head _ ...) head)
                      (() (nothing)))
                     lists))
-        (tails (map (chibi:match-lambda
+        (tails (map (run64:match-lambda
                      ((_ tail ...) tail)
                      (() '()))
                     lists)))
@@ -251,7 +253,7 @@ object instead of the list element."
     (headline "test session starts" bold)
     (test-with-runner runner
       (for-each load
-                (chibi:match args
+                (run64:match args
                   ((_ files ...) files))))
     (newline)
     (unless (zero? (test-runner-fail-count runner))
@@ -260,7 +262,7 @@ object instead of the list element."
                   (let ((name (assq-ref failure 'test-name))
                         (file (assq-ref failure 'source-file))
                         (line (assq-ref failure 'source-line))
-                        (test-type (chibi:match (assq-ref failure 'source-form)
+                        (test-type (run64:match (assq-ref failure 'source-form)
                                      (('test-assert _ ...) 'assert)
                                      (('test-eq _ ...) 'eq)
                                      (('test-eqv _ ...) 'eqv)