From 80464ebe488af336a70c74061792650419c590c6 Mon Sep 17 00:00:00 2001
From: Linus <bjornstam.linus@fastmail.se>
Date: Mon, 9 Nov 2020 23:18:58 +0100
Subject: [PATCH] Added some simple versions of loop

loop/first loop/last loop/sum loop/product now added.
---
 goof.scm | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

diff --git a/goof.scm b/goof.scm
index 82b83a6..642a2a7 100644
--- a/goof.scm
+++ b/goof.scm
@@ -397,3 +397,33 @@
      (loop loop-name (clauses ...)
        => '()
        (cons (let () body ...) (loop-name))))))
+
+(define-syntax loop/sum
+  (syntax-rules ()
+    ((_ (clauses ...) body ...)
+     (loop (clauses ... (acc (summing (let () body ...)))) => acc))))
+
+(define-syntax loop/product
+  (syntax-rules ()
+    ((_ (clauses ...) body ...)
+     (loop (clauses ... (acc (multiplying (let () body ...)))) => acc))))
+
+(define sentinel (list 'unique))
+
+(define-syntax loop/first
+  (syntax-rules ()
+    ((_ (clauses ...) body ...)
+     (loop loop-name ((acc (folding sentinel)) clauses ... :break (not (eq? sentinel acc)))
+           => (if (eq? sentinel acc) #f acc)
+           (let ((result (let () body ...)))
+             (loop-name (=> acc result)))))))
+
+(define-syntax loop/last
+  (syntax-rules ()
+    ((_ (clauses ...) body ...)
+     (loop loop-name ((acc (folding sentinel)) clauses ...) => (if (eq? sentinel acc) #f acc)
+           (let ((result (let () body ...)))
+             (loop-name (=> acc result)))))))
+           
+
+