From 408409c48cd27954b545adbf5ab88628d1ffa70b Mon Sep 17 00:00:00 2001
From: Lassi Kortela <lassi@lassi.io>
Date: Wed, 18 Aug 2021 19:02:24 +0300
Subject: [PATCH] Detect Gauche srfi-NNN libraries

---
 library-inspection.sld | 29 +++++++++++++++++++++++++----
 1 file changed, 25 insertions(+), 4 deletions(-)

diff --git a/library-inspection.sld b/library-inspection.sld
index a0acae8..a408f7f 100644
--- a/library-inspection.sld
+++ b/library-inspection.sld
@@ -31,6 +31,7 @@
     (begin
 
       (define (module-name->library-name module-name)
+
         (define (split-at char string)
           (let loop ((a 0) (b 0) (parts '()))
             (cond ((= a b (string-length string))
@@ -41,23 +42,43 @@
                    (loop (+ b 1) (+ b 1) (cons (substring string a b) parts)))
                   (else
                    (loop a (+ b 1) parts)))))
+
         (define (string->library-name-part string)
           (or (string->number string)
               (string->symbol string)))
-        (map string->library-name-part
-             (split-at #\. (symbol->string module-name))))
+
+        (define (srfi-number string)
+          (let ((srfi- "srfi-"))
+            (and (> (string-length string) (string-length srfi-))
+                 (string=? srfi- (substring string 0 (string-length srfi-)))
+                 (string->number (substring string (string-length srfi-)
+                                            (string-length string))))))
+
+        (let* ((string (symbol->string module-name))
+               (number (srfi-number string)))
+          (if number
+              `(srfi ,number)
+              (map string->library-name-part (split-at #\. string)))))
 
       (define (library-name->module-name library-name)
+
         (define (string-join strings delim)
           (if (null? strings) ""
               (let loop ((acc (car strings)) (strings (cdr strings)))
                 (if (null? strings) acc
                     (loop (string-append acc delim (car strings))
                           (cdr strings))))))
+
         (define (library-name-part->string part)
           (if (number? part) (number->string part) (symbol->string part)))
+
         (string->symbol
-         (string-join (map library-name-part->string library-name) ".")))
+         (if (and (= (length library-name) 2)
+                  (eq? 'srfi (car library-name))
+                  (number? (cadr library-name)))
+             (string-append "srfi-" (number->string (cadr library-name)))
+             (string-join (map library-name-part->string library-name)
+                          "."))))
 
       (define (library-list)
         (map (lambda (m) (module-name->library-name (module-name m)))
@@ -70,6 +91,6 @@
                 (loop (if (match? (car list)) acc (cons (car list) acc))
                       (cdr list)))))
         (let ((m (find-module (library-name->module-name library-name))))
-          (if m (remove (lambda (x) (memq x '(*1 *3+ *1+ *2+ *e *3 *history *2)))
+          (if m (remove (lambda (x) (memq x '(*1 *1+ *2 *2+ *3 *3+ *e *history)))
                         (module-exports m))
               (error "No such library" library-name))))))))