Use WHEN and UNLESS instead of one-armed IF.

Author: duncanmak

s48-packages.scm

@@ -33,6 +33,8 @@
                                   read-byte
                                   tty-info tty-info:output-speed
                                   uname uname:os-name
+                                  (when   :syntax)
+                                  (unless :syntax)
                                   (with-current-input-port  :syntax)
                                   (with-current-output-port :syntax))
   (open (modify ascii (rename (ascii->char integer->char)
@@ -47,6 +49,21 @@
         (subset util (unspecific)))
   (for-syntax (open scheme i/o-internal))
   (begin
+
+    (define-syntax unless
+      (syntax-rules ()
+        ((unless predicate action0 . actions)
+         (if predicate
+             #f
+             (begin action0 . actions)))))
+
+    (define-syntax when
+      (syntax-rules ()
+        ((when predicate action0 . actions)
+         (if predicate
+             (begin action0 . actions)
+             #f))))
+
     (define ignore (unspecific))
     (define (tty-info port) ignore)
     (define (uname) ignore)

scsh-packages.scm

@@ -15,6 +15,20 @@
                           (table-set! hash-table-set!)))
    threads)
   (begin
+    (define-syntax unless
+      (syntax-rules ()
+        ((unless predicate action0 . actions)
+         (if predicate
+             #f
+             (begin action0 . actions)))))
+
+    (define-syntax when
+      (syntax-rules ()
+        ((when predicate action0 . actions)
+         (if predicate
+             (begin action0 . actions)
+             #f))))
+
     (define (read-byte . args)
       (let-optionals args ((s (current-input-port)))
         (let ((value (read-char s)))

terminfo-capabilities.scm

@@ -6,11 +6,11 @@
 ;;; see tigetflag, tigetnum, tigetstr
 (define (terminal:capability terminal name)
   (let ((capability (hash-table-ref *capabilities* name)))
-    (if (or (null? terminal)
-            (not (terminal? terminal)))
-        (error "Invalid terminfo object"))
-    (if (null? capability)
-        (error "Capability does not exist:" name))
+    (when (or (null? terminal)
+              (not (terminal? terminal)))
+      (error "Invalid terminfo object"))
+    (when (null? capability)
+      (error "Capability does not exist:" name))
     (let* ((accessor (car capability))
            (index    (cdr capability))
            (table    (accessor terminal)))

terminfo.scm

@@ -49,14 +49,14 @@
 
 (define (open-terminfo-file name)
   (let loop ((dirs *terminfo-directories*))
-    (if (not (null? dirs))
-        (let* ((basedir (car dirs))
-               (initial (terminfo-directory-prefix name))
-               (file    (path-list->file-name (list basedir initial name))))
-          (cond ((file-not-exists? file)
-                 (error "Cannot find terminfo named " name))
-                ((file-readable? file) (open-input-file file))
-                (else (loop (cdr dirs))))))))
+    (unless (null? dirs)
+      (let* ((basedir (car dirs))
+             (initial (terminfo-directory-prefix name))
+             (file    (path-list->file-name (list basedir initial name))))
+        (cond ((file-not-exists? file)
+               (error "Cannot find terminfo named " name))
+              ((file-readable? file) (open-input-file file))
+              (else (loop (cdr dirs))))))))
 
 (define (read-short . args)
   (let-optionals args ((s (current-input-port)))
@@ -89,9 +89,9 @@
        (else (loop (+ 1 j)))))))
 
 (define (read-padding s lines)
-  (if (not (and (char=? #\$ (string-ref s 0))
-                (char=? #\< (string-ref s 1))))
-      (error "Invalid input"))
+  (unless (and (char=? #\$ (string-ref s 0))
+               (char=? #\< (string-ref s 1)))
+    (error "Invalid input"))
   (let loop ((time  0)
              (force #f)
              (i     2))
@@ -119,25 +119,25 @@
     (with-current-output-port output-port
         (let loop ((i 0)
                    (len (string-length s)))
-          (if (< i len)
-              (let ((c  (string-ref s i)))
-                (cond
-                 ((and (char=? c #\$) (number? (string-index s #\>)))
-                  (let ((substr (substring s i (+ 1 (string-index s #\>))))
-                        (rate   (baud-rate output-port)))
-                    (let-values (((time force)
-                                  (read-padding substr lines-affected)))
-                      (if (or force (eq? #t (xon-xoff)))
-                          (if (eq? #t (no-pad-char))
-                              (sleep (/ time 10000.0))
-                              (do ((i 0 (+ i 1)))
-                                  ((>= i (ceiling (/ (* rate time) 100000))))
-                                (write-char (char-padding))
-                                (loop (+ 1 i) len)))
-                          (loop (+ 1 i) len)))))
-                 (else (begin
-                         (write-char c)
-                         (loop (+ 1 i) len))))))))))
+          (when (< i len)
+            (let ((c  (string-ref s i)))
+              (cond
+               ((and (char=? c #\$) (number? (string-index s #\>)))
+                (let ((substr (substring s i (+ 1 (string-index s #\>))))
+                      (rate   (baud-rate output-port)))
+                  (let-values (((time force)
+                                (read-padding substr lines-affected)))
+                    (if (or force (eq? #t (xon-xoff)))
+                        (if (eq? #t (no-pad-char))
+                            (sleep (/ time 10000.0))
+                            (do ((i 0 (+ i 1)))
+                                ((>= i (ceiling (/ (* rate time) 100000))))
+                              (write-char (char-padding))
+                              (loop (+ 1 i) len)))
+                        (loop (+ 1 i) len)))))
+               (else (begin
+                       (write-char c)
+                       (loop (+ 1 i) len))))))))))
 
 ;;;
 ;;; See Table 7.3, _Unix_Curses_Explained_, p.101
@@ -377,26 +377,26 @@
              (numbers       (make-vector sznumbers -1))
              (strings       (make-vector szstrings -1))
              (stringtable   (make-string szstringtable)))
-        (if (not (= magic #o432))
-            (error "This is not well-formed"))
+        (unless (= magic #o432)
+          (error "This is not well-formed"))
         (do ((i 0 (+ i 1))) ((>= i szbooleans))
           (vector-set! booleans i (not (zero? (read-byte)))))
-        (if (odd? (+ sznames szbooleans))
-            (read-byte))
+        (when (odd? (+ sznames szbooleans))
+          (read-byte))
         (do ((i 0 (+ i 1))) ((>= i sznumbers))
           (vector-set! numbers i (read-short)))
         (do ((i 0 (+ i 1))) ((>= i szstrings))
           (vector-set! strings i (read-short)))
         (do ((i 0 (+ i 1))) ((>= i szstringtable))
           (string-set! stringtable i (read-char)))
         (do ((i 0 (+ i 1))) ((>= i szstrings))
-          (if (positive? (vector-ref strings i))
-              (let* ((start  (vector-ref strings i))
-                     (end    (string-index stringtable
-                                           (integer->char 0)
-                                           start szstringtable))
-                     (substr (substring stringtable start end)))
-                (vector-set! strings i substr))))
+          (when (positive? (vector-ref strings i))
+            (let* ((start  (vector-ref strings i))
+                   (end    (string-index stringtable
+                                         (integer->char 0)
+                                         start szstringtable))
+                   (substr (substring stringtable start end)))
+              (vector-set! strings i substr))))
         (make-terminal console-output-port names booleans numbers strings))))
 
 (define (setup-terminal . args)