Define a new binding construct

1 files changed, 74 insertions, 0 deletions

diff --git a/gnu/gnunet/utils/hat-let.scm b/gnu/gnunet/utils/hat-let.scm
new file mode 100644
index 0000000..807dbab
--- /dev/null
+++ b/gnu/gnunet/utils/hat-let.scm
@@ -0,0 +1,74 @@
+;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
+;;   Copyright (C) 2003, 2004, 2005, 2006, 2008, 2009, 2010 GNUnet e.V.
+;;   Copyright (C) 2020 Maxime Devos <maxime.devos@student.kuleuven.be>
+;;
+;;   scheme-GNUnet is free software: you can redistribute it and/or modify it
+;;   under the terms of the GNU Affero General Public License as published
+;;   by the Free Software Foundation, either version 3 of the License,
+;;   or (at your option) any later version.
+;;
+;;   scheme-GNUnet is distributed in the hope that it will be useful, but
+;;   WITHOUT ANY WARRANTY; without even the implied warranty of
+;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;   Affero General Public License for more details.
+;;
+;;   You should have received a copy of the GNU Affero General Public License
+;;   along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;   SPDX-License-Identifier: AGPL-3.0-or-later
+;;
+;;   As a special exception to the GNU Affero General Public License,
+;;   the file may be relicensed under any license used for
+;;   most source code of GNUnet 0.13.1, or later versions, as published by
+;;   GNUnet e.V.
+
+;; Author: Maxime Devos
+;; Source: gnu/gnunet/utils/hat-let.scm
+;; Brief: a combination of various binding constructs
+;; Status: stable, exported, pure+assert
+
+(library (gnu gnunet utils hat-let (0))
+  (export let^)
+  (import (rnrs base))
+
+  ;; A generalisation of let*, and-let*, receive, begin,
+  ;; and generalised let for avoiding nesting.
+  (define-syntax let^
+    (syntax-rules (? ! !! _ <- /o/)
+      ((: () code ...)
+       (let () code ...))
+      ;; if x, then return @var{esc}
+      ((: ((? x esc) etc ...) code ...)
+       (if x
+           esc
+           (let^ (etc ...) code ...)))
+      ;; Bind y to x
+      ((: ((! x y) etc ...) code ...)
+       (let ((x y))
+         (let^ (etc ...) code ...)))
+      ;; Define a procedure
+      ((: ((! (x . args) body ...) etc ...) code ...)
+       (let ((x (lambda args body ...)))
+         (let^ (etc ...)
+               code ...)))
+      ;; Assert it is true!
+      ((: ((!! x) etc ...) code ...)
+       (begin
+         (assert x)
+         (let^ (etc ...) code ...)))
+      ;; Throw a result away
+      ((: ((_ x) etc ...) code ...)
+       (begin
+         x
+         (let^ (etc ...) code ...)))
+      ;; Assign multiple values
+      ((: ((<- (x ...) produce) etc ...) code ...)
+       (call-with-values produce
+         (lambda (x ...)
+           (let^ (etc ...)
+                 code ...))))
+      ;; Tail-call into a generalised let
+      ((: ((/o/ loop (x y) ...) etc ...) code ...)
+       (let loop ((x y) ...)
+         (let^ (etc ...)
+               code ...))))))