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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
;; This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
;; Copyright (C) 2006, 2007, 2008, 2009, 2013, 2020, 2021 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: Christian Grothoff (upstream, C)
;; Author: Maxime Devos (downstream, Scheme)
;; Brief: perform variable expansion.
(define-library (gnu gnunet config expand)
(export expand port-writer expand->string
&expansion-error expansion-error?
&expansion-loop-error make-expansion-loop-error
expansion-loop-error? expansion-loop-error-visited
&undefined-variable-error undefined-variable-error?
make-undefined-variable-error undefined-variable-line
undefined-variable-start undefined-variable-end)
(import (only (rnrs base)
define call-with-values let-syntax syntax-rules
cond assert begin lambda quote ... procedure?
cons vector values vector-ref
- for-each and)
(only (rnrs control)
case-lambda when)
(only (rnrs io ports)
put-string)
(only (rnrs exceptions)
raise)
(only (rnrs conditions)
define-condition-type &error)
(only (srfi :1) any)
(only (guile)
call-with-output-string)
(only (gnu gnunet config parser)
literal-position? expo:literal-start expo:literal-end
$-position? expo:$-name-start expo:$-name-end
#{${}-position?}# #{expo:${}-name-start}#
#{expo:${}-name-end}# #{${:-}-position?}#
#{expo:${:-}-name-start}# #{expo:${:-}-name-end}#
#{expo:${:-}-value-parts}#)
(only (gnu gnunet utils hat-let)
let^))
(begin
(define-condition-type &expansion-error &error
%make-expansion-error expansion-error?)
;; TODO perhaps more context information could be useful?
;; As in, a stack of variables we were expanding?
;; (The fields and constructor can change.)
(define-condition-type &undefined-variable-error &expansion-error
make-undefined-variable-error undefined-variable-error?
(line undefined-variable-line)
(start undefined-variable-start)
(end undefined-variable-end))
(define-condition-type &expansion-loop-error &expansion-error
make-expansion-loop-error expansion-loop-error?
;; A list (length >= 2) of #(line start end).
;; Each element represents a variable reference.
;; The variable references are ordered from deepest
;; to least deep. The first element is a variable
;; reference that occurred later.
(visited expansion-loop-error-visited))
;; The basic expansion code.
(define (expand write-region query region=? line expo-list)
"Expand @var{expo-list}, a list of expansions objects
(that is, a list of @code{<expo:...>} objects from the module
@code{(gnu gnunet config parser)}). The positions in @var{expo-list}
are relative to the line @var{line}.
The procedure @var{write-region} is called in-order with the
line, start (inclusive) and end (exclusive) position of a region of
text to write.
When a variable reference is encountered, the procedure @var{query}
is called with the line, start (inclusive) and end (exclusive) position
of the variable name, returning no value if the variable is undefined.
If the variable is defined, two values are returned: the line of the
variable definition, and a list of expansion objects
To ensure infinite recursion, the six-argument procedure @code{region=?}
can be called on two regions containing a variable reference, to test
if they refer to the same variable. In case a variable loop is encountered,
some text regions might already be written, and an appropriate
@code{&expansion-loop-error} is raised.
The condition @code{&undefined-variable-error} can also be raised. Other
expansion errors might be defined in the future; they will be
subtypes of @©ode{&expansion-error}.
Quotes are not removed from literal expansion objects.
No restrictions are set on what constitutes a line."
(assert (and (procedure? write-region)
(procedure? query)
(procedure? region=?)))
(expand* write-region query region=? line expo-list '()))
;; The variables we're expanding are accumulated in @var{visited}.
;;
;; It would be possible to use a parameter instead, but that wouldn't
;; behave nicely if the procedures @code{region=?}, @code{write-region}
;; or @code{query/basic} try to parse a GNUnet configuration file
;; -- I don't know *why* anyone would do that, but let's prevent
;; potential headaches anyway.
(define (expand* write-region query/basic region=? line expo-list visited)
(define (recurse line expo-list visited)
(expand* write-region query/basic region=? line expo-list visited))
;; Like @code{recurse}, but add a variable reference to the @code{visited}
;; list.
(define (recurse/visit new-line expo-list start end)
(recurse new-line expo-list (cons (vector line start end) visited)))
;; Like @code{query/basic}, but first make sure we are
;; not already expanding an equivalent variable reference.
(define (query line start end)
(when (any (lambda (x)
(region=? (vector-ref x 0) (vector-ref x 1)
(vector-ref x 2) line start end))
visited)
(raise (make-expansion-loop-error
(cons (vector line start end) visited))))
(query/basic line start end))
(define (query-required line start end)
(call-with-values (lambda () (query line start end))
(case-lambda
(() (raise (make-undefined-variable-error line start end)))
((line expo-list) (values line expo-list))
(e e))))
(define (expand expo)
(let-syntax ((type-cond
(syntax-rules ()
((_ (predicate exp) ...)
(cond ((predicate expo) exp)
...
(#t (assert #f)))))))
(type-cond
(literal-position?
(write-region line (expo:literal-start expo)
(expo:literal-end expo)))
($-position?
(let^ ((! start (expo:$-name-start expo))
(! end (expo:$-name-end expo))
(<-- (line expo-list)
(query-required line start end)))
(recurse/visit line expo-list start end)))
(#{${}-position?}#
(let^ ((! start (#{expo:${}-name-start}# expo))
(! end (#{expo:${}-name-end}# expo))
(<-- (line expo-list)
(query-required line start end)))
(recurse/visit line expo-list start end)))
(#{${:-}-position?}#
(let^ ((! start (#{expo:${:-}-name-start}# expo))
(! end (#{expo:${:-}-name-end}# expo)))
(call-with-values
(lambda () (query line start end))
(case-lambda
;; If this variable is undefined, use the default.
(()
(recurse line (#{expo:${:-}-value-parts}# expo) visited))
((line expo-list)
(recurse/visit line expo-list start end)))))))))
(for-each expand expo-list)
(values))
(define (port-writer port)
"Make a @code{write-region} procedure for @code{expand}
expecting lines to be strings, that writes text regions to the port
@var{port}."
(define (write-region line start end)
(put-string port line start (- end start)))
write-region)
(define (expand->string query region=? line expo-list)
"Like @code{expand}, but expect lines to be strings and return
the expanded text as a string. TODO something about interrupts,
query and continuations."
(call-with-output-string
(lambda (port)
(expand (port-writer port) query region=? line expo-list))))))
|
