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
93
94
95
96
97
98
99
100
101
102
103
|
;#!r6rs
;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
;; Copyright (C) 2020--2022 GNUnet e.V.
;;
;; 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 <--.
;; * (2 4): New: !^
;; * (2 5): Allow both RnRS _ and plain _.
(library (gnu gnunet utils hat-let (2 5))
(export let^)
(import (for (rnrs base) run expand)
(for (rnrs syntax-case) expand))
;; A generalisation of let*, and-let*, receive, begin,
;; and generalised let for avoiding nesting.
(define-syntax let^
(lambda (s)
(syntax-case s (? ! !! <- <-- /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 ...)))
;; Define a procedure, and let the body of the procedure be
;; a let^ form. @var{docstring} is assumed to be a literal string.
((: ((!^ (x . args) docstring bindings body ...) etc ...) code ...)
#'(let^ ((! (x . args)
docstring
(let^ bindings body ...))
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. Allow both RnRS _ and unbound _. We used to
;; write two cases here for the RnRS _ and unbound _, but Racket Scheme
;; forbids using _ as a literal, so do some syntax-case tricks instead.
((: ((underscore x) etc ...) code ...)
(eq? (syntax->datum #'underscore) '_)
#'(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 ...)))))))
|
