From f50f97fb8e050cc050c33ccf0d851b2437def68c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 1 Mar 2022 03:57:53 +0100
Subject: Remove case*.

It has its uses, but like others, its extra weight.
---
 doc/ref/guile/util.texi   |  5 -----
 module/datetime.scm       | 22 ++++++++++------------
 module/hnh/util.scm       | 19 -------------------
 module/vulgar/termios.scm | 40 ++++++++++++++++++++--------------------
 4 files changed, 30 insertions(+), 56 deletions(-)

diff --git a/doc/ref/guile/util.texi b/doc/ref/guile/util.texi
index f7a0f77e..32df5fce 100644
--- a/doc/ref/guile/util.texi
+++ b/doc/ref/guile/util.texi
@@ -57,11 +57,6 @@ Only evaluates @var{expr} once.
 @math{swap (λ (x y) body ...) ⇔ λ (y x) body ...}
 @end defun
 
-@defmac case* clauses
-Like Scheme's regular @var{case}, but evaluates each symbol before
-checking against them.
-@end defmac
-
 @defmac set! key value ...
 @defmacx set! key = proc ...
 @defmacx set! key = (op args ...) ...
diff --git a/module/datetime.scm b/module/datetime.scm
index 81135d39..fce248e1 100644
--- a/module/datetime.scm
+++ b/module/datetime.scm
@@ -16,7 +16,6 @@
                         ->
                         ->>
                         swap
-                        case*
                         set
                         label
                         span-upto
@@ -365,17 +364,16 @@
            (not (zero? (remainder year 100))))))
 
 ;; Returns number of days month for a given date. Just looks at the year and month components.
-(define (days-in-month date)
-  (case* (month date)
-         ((jan mar may jul aug oct dec) 31)
-         ((apr jun sep nov) 30)
-         ((feb)
-          (if (leap-year? (year date))
-              29 28))
-         (else (scm-error 'out-of-range "days-in-month"
-                      "No month number ~a (~a)"
-                      (list (month date) date)
-                      #f))))
+(define-public (days-in-month date)
+  (define m (month date))
+  (cond ((memv m (list jan mar may jul aug oct dec)) 31)
+        ((memv m (list apr jun sep nov)) 30)
+        ((and (= m feb) (leap-year? (year date))) 29)
+        ((= m feb) 28)
+        (else (scm-error 'out-of-range "days-in-month"
+                         "No month number ~a (~a)"
+                         (list (month date) date)
+                         #f))))
 
 (define (days-in-year date)
   (if (leap-year? (year date))
diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index 46557e38..d2c0dd5f 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -11,7 +11,6 @@
            begin1
            print-and-return
            swap
-           case*
            set/r!
            label
            sort* sort*!
@@ -142,24 +141,6 @@
   (lambda args (apply f (reverse args))))
 
 
-(define-syntax case*%
-  (syntax-rules (else)
-    [(_ _ else)
-     #t]
-    [(_ invalue (value ...))
-     (memv invalue (list value ...))]
-    #;
-    [(_ invalue target)
-     (eq? invalue target)]))
-
-;; Like `case', but evals the case parameters
-(define-syntax case*
-  (syntax-rules (else)
-    [(_ invalue (cases body ...) ...)
-     (cond ((case*% invalue cases)
-            body ...)
-           ...)]))
-
 ;; Allow set to work on multiple values at once,
 ;; similar to Common Lisp's @var{setf}
 ;; @example
diff --git a/module/vulgar/termios.scm b/module/vulgar/termios.scm
index 3486e000..ddd8920f 100644
--- a/module/vulgar/termios.scm
+++ b/module/vulgar/termios.scm
@@ -69,26 +69,26 @@
   ((record-modifier <termios> 'ptr) t (make-c-struct struct-termios v)))
 
 (define (resolve-baud-speed n)
-  (case* n
-         ((B0) 0)
-         ((B50) 50)
-         ((B75) 75)
-         ((B110) 110)
-         ((B134) 134)
-         ((B150) 150)
-         ((B200) 200)
-         ((B300) 300)
-         ((B600) 600)
-         ((B1200) 1200)
-         ((B1800) 1800)
-         ((B2400) 2400)
-         ((B4800) 4800)
-         ((B9600) 9600)
-         ((B19200) 19200)
-         ((B38400) 38400)
-         ((B57600) 57600)
-         ((B115200) 115200)
-         ((B230400) 230400)))
+  (cond
+   ((= n B0) 0)
+   ((= n B50) 50)
+   ((= n B75) 75)
+   ((= n B110) 110)
+   ((= n B134) 134)
+   ((= n B150) 150)
+   ((= n B200) 200)
+   ((= n B300) 300)
+   ((= n B600) 600)
+   ((= n B1200) 1200)
+   ((= n B1800) 1800)
+   ((= n B2400) 2400)
+   ((= n B4800) 4800)
+   ((= n B9600) 9600)
+   ((= n B19200) 19200)
+   ((= n B38400) 38400)
+   ((= n B57600) 57600)
+   ((= n B115200) 115200)
+   ((= n B230400) 230400)))
 
 
 ;; TODO bit fields should display what their fields mean
-- 
cgit v1.2.3