Merge mod!:s functionality into set!

8 files changed, 38 insertions, 54 deletions

diff --git a/module/datetime.scm b/module/datetime.scm
index f20a6b8f..0a37f8df 100644
--- a/module/datetime.scm
+++ b/module/datetime.scm
@@ -1016,7 +1016,7 @@
   (let ((sum 0))
     (let ((time (fold (lambda (next done)
                         (let* ((next-time rem (time+% done next)))
-                          (mod! sum = (+ rem))
+                          (set! sum = (+ rem))
                           next-time))
                       base rest)))
       (values time sum))))
@@ -1066,7 +1066,7 @@
   (let ((sum 0))
     (let ((time (fold (lambda (next done)
                         (let* ((next-time rem (time-% done next)))
-                          (mod! sum = (+ rem))
+                          (set! sum = (+ rem))
                           next-time))
                       base rest)))
       (values time sum))))
diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index 9092d01b..52d34331 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -142,9 +142,9 @@
              (set! date (current-date)
                    cur-event 0))
             ((#\j #\J) (unless (= cur-event (1- (length events)))
-                         (mod! cur-event 1+)))
+                         (set! cur-event = (+ 1))))
             ((#\k #\K) (unless (= cur-event 0)
-                         (mod! cur-event 1-)))
+                         (set! cur-event = (- 1))))
             ((#\g) (set! cur-event 0))
             ((#\G) (set! cur-event (1- (length events)))))
 
diff --git a/module/text/flow.scm b/module/text/flow.scm
index 3d97bed6..75ef5ccf 100644
--- a/module/text/flow.scm
+++ b/module/text/flow.scm
@@ -20,7 +20,7 @@
     (string-concatenate/shared
      (merge words (map (lambda (n) (make-string n #\space))
                        space-list)
-            (let ((f #t)) (lambda _ (mod/r! f not)))))))
+            (let ((f #t)) (lambda _ (set/r! f = not)))))))
 
 
 
@@ -32,7 +32,7 @@
     (let* ((head tail (span
                        (let ((w 0))
                          (lambda (word)    ; Take words until we are above the limit.
-                           (< (mod/r! w = (+ 1 (true-string-length word)))
+                           (< (set/r! w = (+ 1 (true-string-length word)))
                               width)))
                        lst)))
       (cond ((null? tail) (list (unwords head))) ; Don't justify last line.
diff --git a/module/util.scm b/module/util.scm
index 62523167..04d13220 100644
--- a/module/util.scm
+++ b/module/util.scm
@@ -5,8 +5,8 @@
   #:use-module ((sxml fold) #:select (fold-values))
   #:use-module ((srfi srfi-9 gnu) #:select (set-fields))
   #:re-export (define*-public fold-values)
-  #:export (for mod! sort* sort*!
-                mod/r! set/r!
+  #:export (for sort* sort*!
+                set/r!
                 catch-multiple
                 quote?
                 re-export-modules
@@ -190,50 +190,30 @@
 ;; @end example
 ;; Still requires all variables to be defined beforehand.
 (define-syntax set!
-  (syntax-rules ()
+  (syntax-rules (=)
+    ((_ field = (op args ...) rest ...)
+     (set! field (op field args ...)
+           rest ...))
+    ((_ field = proc rest ...)
+     (set! field (proc field)
+           rest ...))
     ((_ field val)
      ((@ (guile) set!) field val))
     ((_ field val rest ...)
      (begin ((@ (guile) set!) field val)
             (set! rest ...)))))
 
-(define-syntax modf%
-  (syntax-rules (=)
-    ((_ field = (op args ...))
-     (set! field (op field args ...)))
-    ((_ field proc)
-     (set! field (proc field))))  )
-
-
-;; Like set!, but applies a transformer on the already present value.
-(define-syntax mod!
-  (syntax-rules (=)
-    ((_) *unspecified*)
-    ((_ field = proc)
-     (modf% field = proc))
-
-    ((_ field = proc rest ...)
-     (begin (modf% field = proc) (mod! rest ...)))
-
-    ((_ field proc)
-     (modf% field proc))
-
-    ((_ field proc rest ...)
-     (begin (modf% field proc) (mod! rest ...)))))
-
-(define-syntax-rule (set/r! args ... final)
-  (let ((val final))
-    (set! args ... val)
-    val))
-
-(define-syntax mod/r!
-  (syntax-rules (=)
-    ((_ args ... field = (proc pargs ...))
-     (begin (mod! args ...)
-            (set/r! field (proc field pargs ...))))
-    ((_  args ... ffield fproc)
-     (begin (mod! args ...)
-            (set/r! ffield (fproc ffield))))))
+;; only evaluates the final form once
+(define-syntax set/r!
+  (syntax-rules ()
+    ((_ args ... v = something)
+     (begin
+       (set! args ... v = something)
+       v))
+    ((_ args ... final)
+     (let ((val final))
+       (set! args ... val)
+       val))))
 
 
 (define-syntax define-many
@@ -481,8 +461,7 @@
      (->> (func obj) rest ...))))
 
 ;; Non-destructive set, syntax extension from set-fields from (srfi
-;; srfi-9 gnu). Also doubles as a non-destructive mod!, if the `='
-;; operator is used.
+;; srfi-9 gnu).
 (define-syntax set
   (syntax-rules (=)
     [(set (acc obj) value)
diff --git a/module/vulgar/termios.scm b/module/vulgar/termios.scm
index e3bbb99d..2e260e21 100644
--- a/module/vulgar/termios.scm
+++ b/module/vulgar/termios.scm
@@ -86,6 +86,7 @@
          ((B115200) 115200)
          ((B230400) 230400)))
 
+
 ;; TODO bit fields should display what their fields mean
 ((@ (srfi srfi-9 gnu) set-record-type-printer!)
  <termios>
diff --git a/tests/recurrence.scm b/tests/recurrence.scm
index a3720ce8..e73aa836 100644
--- a/tests/recurrence.scm
+++ b/tests/recurrence.scm
@@ -12,8 +12,7 @@
  ((vcomponent base) make-vcomponent prop prop* extract)
  ((datetime) parse-ics-datetime datetime time date
   datetime->string)
- ((util) -> mod!)
- ((guile) set!)
+ ((util) -> set!)
  ((srfi srfi-41) stream->list)
  ((srfi srfi-88) keyword->string))
 
@@ -51,7 +50,7 @@
             [else (cadr rem)]))
         ;; hack for multi valued fields
         (when (eq? symb 'EXDATE)
-          (mod! (prop* v symb) list)))
+          (set! (prop* v symb) = list)))
       (loop (cddr rem))))
 
   v)
diff --git a/tests/termios.scm b/tests/termios.scm
index f07d20a0..3fed5da3 100755
--- a/tests/termios.scm
+++ b/tests/termios.scm
@@ -7,7 +7,7 @@
 
 ;;; Code:
 
-(((util) mod!)
+(((util) set!)
  ((vulgar termios)
   make-termios copy-termios
   lflag
@@ -22,7 +22,7 @@
 (define tty (open-input-file "/dev/tty"))
 
 (define-syntax-rule (&= lvalue val)
-  (mod! lvalue (lambda (v) (& v val))))
+  (set! lvalue = ((lambda (v) (& v val)))))
 
 (define t (make-termios))
 
diff --git a/tests/util.scm b/tests/util.scm
index 33ebdcf6..6ad58a24 100644
--- a/tests/util.scm
+++ b/tests/util.scm
@@ -1,5 +1,10 @@
-(((util) filter-sorted))
+(((util) filter-sorted set/r!))
 
 (test-equal "Filter sorted"
   '(3 4 5)
   (filter-sorted (lambda (x) (<= 3 x 5)) (iota 10)))
+
+(test-equal "set/r! single"
+  #f
+  (let ((x #t))
+    (set/r! x = not)))