aboutsummaryrefslogtreecommitdiff
path: root/gnu/gnunet/utils/hat-let.scm
blob: a2304ce08a55745704b0038d128235d7966920ca (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
;;   Copyright (C) 2020, 2021 Maxime Devos <maximedevos@telenet.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

;; Author: Maxime Devos
;; Source: gnu/gnunet/utils/hat-let.scm
;; Brief: a combination of various binding constructs
;; Status: stable, exported, pure+assert

;; Mini changelog:
;;   * (1): Original version.
;;   * (2): (2021)
;;          Mark the behaviour of <- as a historical mistake.
;;          Suggest the new <-- instead.
;;          <- might eventually be removed or be replaced
;;          with <--.
;;   * (2 1): Refer to '_' as a symbol, not as the _ from
;;            (rnrs base)
;;   * (2 2): Make (! (procedure-name argument) code code* ...)
;;            usable.
;;   * (2 3): Allow dotted variable lists with <--.

(library (gnu gnunet utils hat-let (2 2))
  (export let^)
  ;; Avoid letting users of (gnu gnunet utils hat-let)
  ;; having to import _ from (rnrs base).
  (import (only (rnrs base)
		define-syntax syntax-rules let if begin
		lambda assert call-with-values ...))

  ;; 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 @code{(begin esc esc* ...)}
      ((: ((? x esc esc* ...) etc ...) code ...)
       (if x
	   (begin esc esc* ...)
	   (let^ (etc ...) code ...)))
      ;; Define a procedure
      ((: ((! (x . args) body ...) etc ...) code ...)
       (let ((x (lambda args body ...)))
	 (let^ (etc ...)
	       code ...)))
      ;; Bind y to x
      ((: ((! x y) etc ...) code ...)
       (let ((x y))
	 (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 (from a thunk).
      ;; This is a historical mistake, use <--
      ;; instead (see mini changelog).
      ((: ((<- (x ...) thunk) etc ...) code ...)
       (call-with-values thunk
	 (lambda (x ...)
	   (let^ (etc ...)
		 code ...))))
      ;; Assign multiple values.
      ((: ((<-- dotted-variable-list exp) etc ...) code ...)
       (call-with-values (lambda () exp)
	 (lambda dotted-variable-list
	   (let^ (etc ...) code ...))))
      ;; Tail-call into a generalised let
      ((: ((/o/ loop (x y) ...) etc ...) code ...)
       (let loop ((x y) ...)
	 (let^ (etc ...)
	       code ...))))))