From 56594fd146e1662e22ed3fd8cc0f9a5a7d7e75e2 Mon Sep 17 00:00:00 2001
From: Dane Johnson <daneallenjohnson@protonmail.com>
Date: Fri, 1 Nov 2024 18:05:27 -0500
Subject: [PATCH] Add 'for' iterator and 'if-let' syntax

---
 d-.scm   | 30 ++++++++++++++++++++++++------
 test.scm | 13 +++++++++++++
 2 files changed, 37 insertions(+), 6 deletions(-)

diff --git a/d-.scm b/d-.scm
index 0479b88..7f73a01 100644
--- a/d-.scm
+++ b/d-.scm
@@ -5,21 +5,23 @@
    ~>>
    if-not
    when-not
+   if-let
+   for
    partial
    argmin
    make-generator))
 
 (define-syntax ~>
   (syntax-rules ()
-    [(_ v) v]
-    [(_ v (fn args ...) more ...) (~> (fn v args ...) more ...)]
-    [(_ v fn more ...) (~> (fn v) more ...)]))
+    [(~> v) v]
+    [(~> v (fn args ...) more ...) (~> (fn v args ...) more ...)]
+    [(~> v fn more ...) (~> (fn v) more ...)]))
 
 (define-syntax ~>>
   (syntax-rules ()
-    [(_ v) v]
-    [(_ v (fn args ...) more ...) (~>> (fn args ... v) more ...)]
-    [(_ v fn more ...) (~>> (fn v) more ...)]))
+    [(~>> v) v]
+    [(~>> v (fn args ...) more ...) (~>> (fn args ... v) more ...)]
+    [(~>> v fn more ...) (~>> (fn v) more ...)]))
 
 (define-syntax-rule (if-not pred body ...)
   (if (not pred) body ...))
@@ -27,6 +29,22 @@
 (define-syntax-rule (when-not pred body ...)
   (when (not pred) body ...))
 
+(define-syntax-rule (if-let ([ident test]) expr ...)
+  (let ([ident test])
+    (if ident
+	(begin expr ...)
+	#f)))
+
+(define-syntax for
+  (syntax-rules ()
+    [(for () expr ...) (list (begin expr ...))]
+    [(for ([ident lst] bindings ...) expr ...)
+     (let iter ([rest lst])
+       (if (pair? rest)
+	   (let ([ident (car rest)])
+	     (append (for (bindings ...) expr ...) (iter (cdr rest))))
+	   '()))]))
+
 (define (partial fn . args)
   (lambda x (apply fn (append args x))))
 
diff --git a/test.scm b/test.scm
index 2762241..d596ab0 100644
--- a/test.scm
+++ b/test.scm
@@ -32,6 +32,19 @@
   (negative-case
    (assert (unspecified? (when-not #t 'do-some-stuff 'return)))))
 
+(define-test for
+  (permutation
+   (define value (for ([i (iota 2)]
+		       [j (iota 2)])
+		      (cons i j)))
+   (assert (equal? value '((0 . 0) (0 . 1) (1 . 0) (1 . 1))))))
+
+(define-test if-let
+  (positive-case
+   (assert (= (if-let ([v (or #f 1)]) (+ v 1)) 2)))
+  (negative-case
+   (assert (not (if-let ([v (and #f 1)]) (+ v 1))))))
+
 (define-test partial
   (test
    (define value (partial / 2))