Add Gerbil sugar macros: awhen, aif, when-let, if-let, dotimes

ober

bee2bfd162b73fa6dff987aedd8ce85505a0e246

diff --git a/lib/std/sugar.sls b/lib/std/sugar.sls
index 2357a70..81f6090 100644
--- a/lib/std/sugar.sls
+++ b/lib/std/sugar.sls
@@ -13,7 +13,13 @@
     assert!
     with-lock
     with-catch
-    cut cute)
+    cut cute
+    ;; Anaphoric macros
+    awhen aif
+    ;; Binding macros
+    when-let if-let
+    ;; Iteration
+    dotimes)
   (import (except (chezscheme)
             make-hash-table hash-table? iota 1+ 1-)
           (jerboa core))
@@ -161,4 +167,55 @@
       [(_ (binds ...) (params ...) (args ...) expr . rest)
        (cute-aux (binds ... (t expr)) (params ...) (args ... t) . rest)]))
 
+  ;; awhen — anaphoric when: binds test result to `it`
+  ;; (awhen (find-thing) (use it)) → (let ((it (find-thing))) (when it (use it)))
+  (define-syntax awhen
+    (lambda (stx)
+      (syntax-case stx ()
+        [(k test body body* ...)
+         (with-syntax ([it (datum->syntax #'k 'it)])
+           #'(let ([it test])
+               (when it body body* ...)))])))
+
+  ;; aif — anaphoric if: binds test result to `it`
+  ;; (aif (lookup key) (use it) fallback)
+  (define-syntax aif
+    (lambda (stx)
+      (syntax-case stx ()
+        [(k test then else-expr)
+         (with-syntax ([it (datum->syntax #'k 'it)])
+           #'(let ([it test])
+               (if it then else-expr)))]
+        [(k test then)
+         (with-syntax ([it (datum->syntax #'k 'it)])
+           #'(let ([it test])
+               (when it then)))])))
+
+  ;; when-let — bind and test: execute body only if binding is truthy
+  ;; (when-let (x (get-thing)) (use x))
+  (define-syntax when-let
+    (syntax-rules ()
+      [(_ (var expr) body body* ...)
+       (let ([var expr])
+         (when var body body* ...))]))
+
+  ;; if-let — bind and branch: execute then if binding is truthy, else otherwise
+  ;; (if-let (x (get-thing)) (use x) fallback)
+  (define-syntax if-let
+    (syntax-rules ()
+      [(_ (var expr) then else-expr)
+       (let ([var expr])
+         (if var then else-expr))]))
+
+  ;; dotimes — iterate N times with counter variable
+  ;; (dotimes (i 10) (display i))
+  (define-syntax dotimes
+    (syntax-rules ()
+      [(_ (var count) body body* ...)
+       (let ([n count])
+         (let loop ([var 0])
+           (when (< var n)
+             body body* ...
+             (loop (+ var 1)))))]))
+
   ) ;; end library
diff --git a/tests/test-expanded-stdlib.ss b/tests/test-expanded-stdlib.ss
index 3b3ba71..de61a8d 100644
--- a/tests/test-expanded-stdlib.ss
+++ b/tests/test-expanded-stdlib.ss
@@ -28,6 +28,7 @@
         (std srfi srfi-19)
         (std pregexp)
         (std misc thread)
+        (std sugar)
         (std test))
 
 (define pass-count 0)
@@ -215,6 +216,18 @@
 
 ;;; ---- Summary ----
 (newline)
+;;; ---- std/sugar (awhen, aif, when-let, if-let, dotimes) ----
+(chk (awhen (+ 1 2) it) => 3)
+(chk (awhen #f 42) => (void))
+(chk (aif (+ 10 20) it 0) => 30)
+(chk (aif #f 42 99) => 99)
+(chk (when-let (x (+ 1 1)) (* x 3)) => 6)
+(chk (when-let (x #f) 42) => (void))
+(chk (if-let (x 10) (* x 2) 0) => 20)
+(chk (if-let (x #f) 42 99) => 99)
+(chk (let ((acc 0)) (dotimes (i 4) (set! acc (+ acc i))) acc) => 6)
+(chk (let ((acc 0)) (dotimes (i 0) (set! acc (+ acc 1))) acc) => 0)
+
 (display "Expanded stdlib tests: ")
 (display pass-count)
 (display " passed, ")